prepare for 3.17

just increase the sample size.

.github/workflows/format.yml

@@ -0,0 +1,28 @@
+name: format
+
+on:
+  push:
+    branches:
+      - main
+  pull_request:
+
+jobs:
+  format:
+    name: format
+    strategy:
+      matrix:
+        ocaml-compiler:
+            - '5.3'
+    runs-on: 'ubuntu-latest'
+    steps:
+      - uses: actions/checkout@main
+      - name: Use OCaml ${{ matrix.ocaml-compiler }}
+        uses: ocaml/setup-ocaml@v3
+        with:
+          ocaml-compiler: ${{ matrix.ocaml-compiler }}
+          dune-cache: true
+          allow-prerelease-opam: true
+
+      - run: opam install ocamlformat.0.27.0
+      - run: opam exec -- make format-check
+

.github/workflows/gh-pages.yml

@@ -0,0 +1,33 @@
+name: github pages
+
+on:
+  push:
+    branches:
+      - master  # Set a branch name to trigger deployment
+
+jobs:
+  deploy:
+    name: Deploy doc
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@main
+
+      - name: Use OCaml
+        uses: ocaml/setup-ocaml@v3
+        with:
+          ocaml-compiler: '5.2'
+          dune-cache: false
+
+      - name: Deps
+        run: opam install odig containers containers-data
+
+      - name: Build
+        run: opam exec -- odig odoc --cache-dir=_doc/ containers containers-data
+
+      - name: Deploy
+        uses: peaceiris/actions-gh-pages@v3
+        with:
+          github_token: ${{ secrets.GITHUB_TOKEN }}
+          publish_dir: ./_doc/html/
+          destination_dir: dev
+          enable_jekyll: true

.github/workflows/main.yml

@@ -0,0 +1,64 @@
+name: Build and Test
+
+on:
+  push:
+    branches:
+      - main
+  pull_request:
+
+jobs:
+  run:
+    name: build
+    timeout-minutes: 15
+    strategy:
+      fail-fast: true
+      matrix:
+        os:
+            - ubuntu-latest
+        ocaml-compiler:
+            - '4.08'
+            - '4.10'
+            - '4.14'
+            - '5.3'
+            - 'ocaml-variants.5.0.0+options,ocaml-option-bytecode-only'
+
+    runs-on: ${{ matrix.os }}
+    steps:
+      - uses: actions/checkout@main
+      - name: Use OCaml ${{ matrix.ocaml-compiler }}
+        uses: ocaml/setup-ocaml@v3
+        with:
+          ocaml-compiler: ${{ matrix.ocaml-compiler }}
+          dune-cache: true
+          allow-prerelease-opam: true
+      - run: opam install -t containers containers-data --deps-only
+      - run: opam exec -- dune build '@install'
+      - run: opam exec -- dune runtest --force --profile=release
+
+  compat:
+    name: build
+    timeout-minutes: 15
+    strategy:
+      fail-fast: true
+      matrix:
+        os:
+            - macos-latest
+            - ubuntu-latest
+              #- windows-latest
+        ocaml-compiler:
+            - '5.1'
+
+    runs-on: ${{ matrix.os }}
+    steps:
+      - uses: actions/checkout@main
+      - name: Use OCaml ${{ matrix.ocaml-compiler }}
+        uses: ocaml/setup-ocaml@v3
+        with:
+          ocaml-compiler: ${{ matrix.ocaml-compiler }}
+          dune-cache: true
+          allow-prerelease-opam: true
+      - run: |
+          opam install -t containers --deps-only ;
+          opam install containers-data --deps-only  # no test deps
+      - run: opam exec -- dune build '@install'
+      - run: opam exec -- dune runtest -j 1 -p containers --profile=release # test only core on non-ubuntu platform

.gitignore

@@ -4,8 +4,15 @@ _build
 *.native
 *.byte
 .session
-TAGS
 *.docdir
 setup.*
-qtest*
 *.html
+.merlin
+*.install
+.ignore
+_opam
+*.exe
+fuzz-*-input
+fuzz-*-output
+fuzz-logs/
+doc/papers

.merlin

@@ -1,21 +0,0 @@
-S src/core
-S src/data/
-S src/iter/
-S src/sexp/
-S src/threads/
-S src/string
-S benchs
-S examples
-S tests
-B _build/src/**
-B _build/benchs
-B _build/examples
-B _build/tests
-PKG oUnit
-PKG benchmark
-PKG result
-PKG threads
-PKG threads.posix
-PKG lwt
-PKG qcheck
-FLG -w +a-4-44-48-60@8

.ocamlformat

@@ -0,0 +1,15 @@
+version = 0.27.0
+profile=conventional
+margin=80
+if-then-else=k-r
+parens-ite=true
+parens-tuple=multi-line-only
+sequence-style=terminator
+type-decl=sparse
+break-cases=toplevel
+cases-exp-indent=2
+field-space=tight-decl
+leading-nested-match-parens=true
+module-item-spacing=compact
+quiet=true
+parse-docstrings=false

.ocamlinit

@@ -1,23 +0,0 @@
-#use "topfind";;
-#thread
-#require "result";;
-#require "unix";;
-#require "sequence";;
-#directory "_build/src/core";;
-#directory "_build/src/unix";;
-#directory "_build/src/iter";;
-#directory "_build/src/data";;
-#directory "_build/src/sexp";;
-#directory "_build/src/threads";;
-#directory "_build/src/top/";;
-#load "containers.cma";;
-#load "containers_iter.cma";;
-#load "containers_data.cma";;
-#load "containers_unix.cma";;
-#load "containers_sexp.cma";;
-#load "containers_string.cma";;
-#load "containers_top.cma";;
-#thread;;
-#load "containers_thread.cma";;
-(* vim:syntax=ocaml:
-*)

.ocp-indent

@@ -1,2 +0,0 @@
-match_clause=2
-with=2

.travis.yml

@@ -1,37 +0,0 @@
-language: c
-env:
-  - OCAML_VERSION=4.01.0
-  - OCAML_VERSION=4.02.3
-  - OCAML_VERSION=4.04.2
-  - OCAML_VERSION=4.05.0
-  - OCAML_VERSION=4.05.0+flambda
-  - OCAML_VERSION=4.06.0
-addons:
-  apt:
-    sources:
-      - avsm
-    packages:
-      - opam
-# Caching may take a lot of space with so many ocaml versions
-#cache:
-#  directories:
-#    - $HOME/.opam
-before_install:
-  # Some opam boilerplate
-  - export OPAMYES=1
-  - export OPAMVERBOSE=1
-  - opam init
-  - opam switch ${OCAML_VERSION}
-  - eval `opam config env`
-install:
-  # Install dependencies
-  - opam pin add --no-action containers .
-  - opam install oasis
-  - opam install --deps-only containers
-script:
-  - ./configure --enable-unix --enable-thread --disable-tests --disable-bench
-  - make build
-  - opam install sequence qcheck qtest gen
-  - ./configure --enable-unix --enable-thread --enable-tests --enable-docs --disable-bench
-  - make test
-  - make doc

AUTHORS.adoc

@@ -1,26 +0,0 @@
-= Authors and contributors
-
-- Simon Cruanes (`companion_cube`)
-- Drup (Gabriel Radanne)
-- Jacques-Pascal Deplaix
-- Nicolas Braud-Santoni
-- Whitequark (Peter Zotov)
-- hcarty (Hezekiah M. Carty)
-- struktured (Carmelo Piccione)
-- Bernardo da Costa
-- Vincent Bernardoff (vbmithr)
-- Emmanuel Surleau (emm)
-- Guillaume Bury (guigui)
-- JP Rodi
-- Florian Angeletti (@octachron)
-- Johannes Kloos
-- Geoff Gole (@gsg)
-- Roma Sokolov (@little-arhat)
-- Malcolm Matalka (`orbitz`)
-- David Sheets (@dsheets)
-- Glenn Slotte (glennsl)
-- @LemonBoy
-- Leonid Rozenberg (@rleonid)
-- Bikal Gurung (@bikalgurung)
-- Fabian Hemmer (copy)
-- Maciej Woś (@lostman)

CHANGELOG.md

@@ -1,6 +1,561 @@
-= Changelog
 
-== 1.5
+
+## 3.17
+
+- feat: add `CCAtomic.update_cas`
+- feat: add `Pvec.flat_map`
+- faster `List.take_drop` thanks to a trick by nojb
+
+- move to ocamlformat 0.27, format code
+- test: enrich pvec test
+- Patch CBor roundtrip property to hold for nan's too (thanks @jmid)
+
+## 3.16
+
+
+- breaking: Renamed predicate parameter of `take_while`, `rtake_while` from `p` to `f`, aligining it with pre-existing `drop_while`.
+
+- feat: add `containers.leb128` library
+- feat: add `CCFun.with_return`
+- Added functions to the `Char` module to check common character properties.
+- feat: add `CCVector.findi`
+
+
+- fix: compat with OCaml 5.4
+- fix: oob(!!) in CCHash.bytes
+
+## 3.15
+
+- Add `CCList.split_result` (#459)
+- pretty printer in MultiSet
+- `CCHeap`: building a heap from an almost-sorted sequence
+- perf: `CCHeap`: building a heap from n elements is now in time O(n)
+  instead of O(n log n)
+- perf: `CCHeap`: `filter` and `delete_all` are now in time O(n)
+  instead of O(n log n), and they ensure physical equality
+  (for `delete_all` this is a bugfix)
+
+## 3.14
+
+
+- predicate combinators: `and_pred` and `or_pred`
+- feat `pp`: add a bunch of extensions
+- Kleisli Composition Operator and Apply_or for option/result/fun (#455)
+- add `CCByte_buffer.to_slice`
+- add a byte slice type `CCByte_slice`
+- add `cons_when` to `CCListLabels`
+- add `(|||>)` and `||>` to `CCFun`
+- `CCVector`: Add function foldi
+- add `containers.pvec`, a persistent vector type.
+
+- perf: use a monomorphic impl for `CCMonomorphic.{min,max}`
+
+## 3.13.1
+
+- list: TRMC was in 4.14, we can use it earlier
+- fix insidious bug in CCList.flat_map linked to unspecified
+    evaluation order
+- perf: use `concat_map` for `CCList.flat_map` on >= 5.1
+    (this also re-fixes the same bug in `CCList.flat_map` anyway)
+
+## 3.13
+
+- breaking: delete containers-thread (which was deprecated)
+- breaking: pp: modify `Ext.t` so it takes surrounding value
+- breaking: remove CCShims
+- CCMultiMap: Rename functions find_left and find_right in the bidirectional multimap
+    to find_left_iter and find_right_iter respectively to reflect their usage,
+    and add new functions to replace the old find_left and find_right
+    that return a list of values rather than an iterator,
+    to make the signatures of CCMultiMap.S and CCMultiMap.BIDIR cohere.
+    Additionally, change the return type of
+    `S.find_iter` from `t -> key -> (value -> unit) -> unit` to `t -> key -> value iter`.
+
+- CCList: add `unfold`
+- CCBool: Add functions if_then and if_then_else
+- CCList: remove some functions that are subsumed by the stdlib
+- CCList: use TRMC for many functions on 5.1
+- feat CCFunvec: add `fold_rev`
+- add `Containers_pp.newline_or_spaces`
+- cleanup: remove stubs for code always present on 4.08, rely on
+    newer functions in 5.1
+
+- perf: accelerate `List.append` and `List.flat_map` on 5.1
+
+- more warnings, more tests, cleanup dead code
+- change COC to ocaml-coc
+
+## 3.12
+
+- add `containers.pp` sublibrary, with Wadler-style pretty printing combinators
+- add `CCArray.{max,argmax,min,argmin}` and their _exn counterparts
+- add `CCParse.take_until_success`
+- add `Option.flat_map_l`
+- add `CCSet.{find_first_map,find_last_map}`
+- `CCHash`: native FNV hash for int64/int32
+
+- fix bugs in CCParse related to `recurse` and `Slice`
+- fix: fix Set.find_last_map on OCaml 4.03
+- fix: make sure `Vector.to_{seq,gen}` captures the length initially
+
+## 3.11
+
+- official OCaml 5 support
+- add `CCFun.(let@)` (if OCaml >= 4.08)
+- add `CCHet.Tbl.{clear,reset}`
+
+- fix(CCVector): concurrent modification safety in `resize_with`
+- fix(CCVector): always obtain a copy of array before using unsafe_{set,get}
+- CI: add ocaml 5.0.x
+
+## 3.10
+
+- `CCArray`: add `mapi_inplace`
+- add sublibrary `containers.scc` for strongly connected components
+- `CCSeq`: add `concat_map`
+- `CCSeq`: add some missing function from 4.14
+- add `CCInt64.{hash,hash_to_int64}`
+- `Ref`: add `protect` function
+
+- fix: include `Seq` in `CCSeq` for ocaml >= 4.07
+
+## 3.9
+
+- feat: add `Containers_cbor` module
+- feat(CCInt32): add popcount function
+- feat(CCInt64): add `popcount` operation
+- CCBV:
+  * more extensive test suite
+  * use `bytes` underneath, not an array of integers
+- add `containers_testlib`, removing qtest and ounit.
+- `cbor`: use int64 as main int type
+
+- fix: handle uppercase in string/hex
+
+## 3.8
+
+- add `Containers_bencode` for lightweight (de)ser
+- perf(CCHash): improve a bit commutative hashing of arrays/lists
+- perf(CCHash): only hash prefix of string/bytes
+- feat(CCList): Add `Assoc.{keys,values,map_values}`
+- feat(CCArray): add `CCArray.map_inplace`
+- add `CCString.{to_hex,of_hex}`
+
+- fix(Atomic): prevent race conditions under flambda, for now
+
+## 3.7
+
+- add `Format.styling`
+- make `Format` compatible with OCaml 5.0, using Stag for colors
+- new preprocessor, compatible with merlin, using `[@@@ifge 4.12]`-style pragmas
+- feat: add `Byte_buf`, a byte buffer.
+- add `CCSeq.{zip_i,of_string}`
+- add `CCResult.opt_map` to simplify result function application over optionals (#397)
+- add shims for Atomic and Unit
+- expose `CCParse.pos` to get current pos; improve perf
+- add `CCVector.resize_with` and `CCVector.resize_with_init`, tests and doc (#389)
+- add `CCVector.insert`
+- update dune to 1.10, condition some rules to unix
+
+- perf: reduce allocations in `CCSeq.to_array`
+
+- fix asymptotic behavior of resize functions in `CCVector`
+- fix: rely on `either` compatibility library
+
+## 3.6.1
+
+- use `either` compatibility library instead of shims
+
+## 3.6
+
+- rename `CCOpt` to `CCOption` and deprecate `CCOpt`
+- add iterator functions to `CCIO`
+- `CCOrd`: add `poly`, deprecate `compare`
+- add `CCIO.File.walk_iter`
+- `CCParse`: heavy refactoring, many new functions
+  * backtracking by default
+  * add `slice` and the ability to recurse on them
+  * expose Position module, add `or_`, `both`, `lookahead`, `U.bool`
+  * example Sexpr parser, and a test
+  * example and test of an IRC log parser
+- fix bug in `CCIO.read_lines_seq`
+
+## 3.5.1
+
+- fix bug in `CCIO.read_lines_seq` (backported from 3.6)
+
+## 3.5
+
+- add `CCHash.map` and `CCHash.bytes`
+- CCIO: add many `Seq.t` based functions
+- CCUtf8string: add `{make,empty,of_uchar}`
+- add `CCFormat.{const_string,opaque}`
+- add `CCOpt.{some,none}`
+- CCFormat: expose `ANSI_codes` module
+- CCBV: add `equal`, refactor for performance and readability
+- CCList: add `{sorted_diff_uniq,sorted_mem,sorted_diff,sorted_remove}`
+
+- fix(bv): index error in union
+- test: add some property tests on `Csexp/Canonical_sexp`
+- bv: add more tests, including regression for #370
+
+## 3.4
+
+- Add `CCOpt.get_exn_or` and deprecate `CCOpt.get_exn`
+- CCRAL: add `get_and_remove_exn` operation
+- CCString: add `CCString.uniq`
+- refactor `CCHash` to use FNV in many combinators
+- CCInt: improve perf by using a single implementation of popcount using int64
+
+- fix: CCRAL.remove does not always remove
+- fix(sexp): re-export the `loc` type to the functor's argument's type
+- refactor and clarify `cutoff` in `String.edit_distance`
+- fix(CCInt): make sure hash is always positive
+
+- big upgrade to CI thanks to @Fardale
+
+## 3.3
+
+- feat: add code-generator for optimal bitfields; add tests
+- new Canonical sexpr module with printer and parser
+
+- CCSeq: Add `for_all` and `exists`
+- feat(sexp): expose last location in decoder
+- feat(CCChar): add CCChar.Infix
+- feat(CCString): add CCString.foldi
+- feat(CCFormat): add `string_lines` combinator
+- feat(CCList): update with regards to `partition_map`
+- add `CCList.cons'`
+- implement {of,add}_*_with family of function in `CCMap` with update (#352)
+- add `CCMap.of_{list,iter,seq}_with` functions
+- add `CCHashtbl.{of,add}_{list,seq,iter}_with`
+
+- Fix integer overflow warning on jsoo (#346)
+- updated fuzzer scripts
+
+### Containers-thread
+
+- refactor(pool): less locking, fix deadlock, more parallelism
+- feat(pool): keep one idle thread
+- small optim in `Pool.sequence_a`
+
+## 3.2
+
+- add CCEither module
+- add `CCList.chunks`
+- add iter/seq functions to `CCString`
+- add `CCList.reduce` (resolves #305)
+- fix: in `CCInt` pick popcount at runtime on 64 bits
+- fix: in shims, use configurator properly to determine int size
+- in `CCFormat`, add `append`, `append_l`, infix `++` for sequencing,
+  `space`, `break`, `cut`
+- fix: in `CCSexp`, handle non-ascii escapes in strings
+- `CCUtf8_string`: add and expose `uchar_to_bytes`
+
+- enable auto deploy of doc
+- improve CI: test core on non ubuntu platform, test all on ubuntu
+- update readme
+- CCImmutArray: add tests (#344)
+- add fuzzing (#339)
+- add stronger test to compare with uutf in ccutf8string
+
+## 3.1
+
+- add `List.combine_chop` and corresponding `(and&)` synchronized product
+- chore: remove travis to use github CI instead
+- add `CCList.mguard` function for list comprehensions
+- add some basic tests to CCMutHeap
+- un-specify order of elements in `CCMap.to_list`
+- Move definition of `CCMap.update` so that it is shadowed by Stdlib.Map.update
+- fix(intmap): order of arguments for the HO param should be stable
+
+- feat(containers-data): add `CCMutHeap` mutable heap with increase/decrease
+
+## 3.0.1
+
+- fix build on 32 bits architectures
+
+## 3.0
+
+### Breaking changes
+
+see https://github.com/c-cube/ocaml-containers/issues/290 for a summary of
+a subset of these changes.
+
+packaging:
+
+- split the library into separate packages
+  `containers`, `containers-data`, and `containers-thread`.
+- delete `containers.iter` and merge parts of it into `containers-data`;
+- move `CCSexp` into the core library, remove `containers.sexp`.
+
+api:
+
+- remove slice APIs in string and array.
+- change pp functions to take unit printer for sep/stop/start (#295)
+- CCPair: use more standard name for some map functions (#316)
+- add CCSeq module, mostly adapted from `CCKlist`
+- remove `CCKlist` from everywhere
+- CCGraph: remove deprecated module and function
+- rename `<op>_std_seq` to `<op>_seq`, making `Seq.t` the standard everywhere;
+  remove the old `<op>_seq` that were previously
+  deprecated in favor of `<op>_iter`.
+- CCVector: rename `shrink` into `truncate`
+- CCVector: rename `remove to CCVector.remove_unordered`
+- CCList: make mem compatible with the Stdlib by making `?eq` optional
+- CCVector: rename `filter'` into `filter_in_place`
+
+### Other changes
+
+- CI: add github actions in addition to travis
+- feat: add infix operators to `String`
+- feat: add opt.bind
+- CCResult: add `<$>` operator
+- CCResult: add `get_lazy`
+- put infix operators in `Infix` module, then include it
+- ccnativeint: complete CCNativeint with regards to CCInt
+- Int64: complete CCInt64 with regards to CCInt
+- CCInt32: complete CCInt32 with regards to CCInt
+- implement `CCInt.sign` using `CCInt.compare`
+- CCInt: include module Int for ocaml >= 4.08
+- CCInt: add `of_float`
+- CCInt: add `of_string_exn`
+- add `CCResult.get_lazy`
+- add `Int.popcount` operator
+- CCFloat: add `pi`
+- CCFloat: add `of_string_opt`
+- fix: expose `always_eq`/`never_eq` in `CCEqual`
+- string: add optional `cutoff` arg on `String.edit_distance`
+- CCVector: add `remove_and_shift`
+- CCArray: add optional argument eq to mem
+- CCSexp: Escape empty atoms
+- substitute 'Pervasives' with 'Stdlib'
+- CCFormat: add `exn` combinator
+- IO: add `copy_into` for transferring data between channels
+
+- Extend benchmark: `to_array`, cons and `cons_fold`
+- Extend benchmark: Sek, iter and pop
+- benchmark for memory usage of data structures
+
+And many, many bugfixes.
+
+## 2.8.1
+
+- add missing `CCVector.of_iter`
+
+## 2.8
+
+### Breaking:
+
+- bump minimum version of OCaml to 4.03, drop deps `{result,uchar}`
+- deprecate `{of,to}_seq` a bit everywhere
+- deprecate `CCKList` as it's subsumed by `Seq`
+
+- feat: on `>= 4.08`, support let+ and let* operators
+- feat(list): add indexed functions and `fold_on_map`
+- refactor: also port `CCGraph` to iter
+- feat: add `{to,of,add}_{iter,std_seq}` where relevant
+- feat(unix): add `ensure_session_leader` and add some docs
+- feat(pool): add infix operators on futures
+- fix(pp): improve printing of hashtables
+- feat: add `monoid_product` to Array and Vector
+- improved gc behavior for `CCvector`
+- deprecate `CCVector.fill_empty_slots_with`
+- `CCVector.shrink_to_fit` to limit memory usage
+- add `CCVector.clear_and_reset`
+- feat(sexp): expose `parse_string_list` and the list decoder
+- add `CCUnix.with_temp_dir` function
+- deprecate `CCOpt.to_seq`, provide `to_iter` instead
+- add `CCOpt.value` to improve compat with `Stdlib.Option`
+- add `CCVector.mapi`
+
+- fix: restore `CCSexp.atom` and `list` which was lost in 2.7
+- fix(sexp): set location properly when parsing a file
+- fix: properly alias to `CCChar` in containers.ml
+
+- use older dune dialect
+- remove unlabel, remove all traces of Result
+- require dune configurator explicitly in opam
+- Re-enable mdx tests
+- fix benchs so they don't depend on clarity and they compile again
+
+## 2.7
+
+- deprecate CCKList in favor of the standard Seq
+- CCIO: add `_gen` suffixes to some functions
+- ccsexp: provide ability to annotate parsed S-exprs with their position
+- ccsexp: functorize the parser/printer
+- ccsexp: support `#;` for commenting a sexp
+- fix: remove dep from vec to list
+- add `to_string` to many modules (#270)
+- add `CCDeque.{remove_*;update_*}`,` CCDeque.{*_opt}`
+- add `CCDeque.{filter,filter_map}`
+- add `CCDeque.filter_in_place`
+- add `CCBool.{to,of}_int`
+- add `Result.flatten_l` to turn a list of results into a result of list
+- refactor: remove stdlib's code, simple reimplementation of `Stdlib.Fun`
+- add `CCArray.Infix`
+- Document behaviour of `Fun.finally` when finaliser raises
+
+- travis: test on OCaml 4.09, too.
+- more docs for IO
+
+## 2.6.1
+
+bugfix release:
+
+- fix(parse): error in `many`
+- chore: add 4.08 to travis
+- fix `Containers.Stdlib` on OCaml 4.07
+
+## 2.6
+
+- introduce shim modules for 4.08 compat
+- remove reference to sequence, use `iter` instead for tests
+- add `remove` function to het map/tbl
+- missing type annotation for specializing int.compare
+
+- doc: fix bad example in CCIO
+- use `iter`, not `sequence`, in tests
+- fix: use same evaluation order as stdlib for `CCList.init`
+- fix: make `Array.random_choose` fail on empty array at creation time
+- breaking: make `Array.random_choose` raise invalid_arg instead of not_found
+- migrate readme to .md, using mdx to test it
+
+## 2.5
+
+- perf: annotate types in monomorphic/float/int to help specialize builtins
+- use GADT to discard impossible case on `CCFQueue` (@dinosaure).
+- fix(funvec): expose `pop`, fix off by one error
+
+## 2.4.1
+
+- revert some compatibility-breaking changes in label modules
+
+## 2.4
+
+### breaking:
+
+- rename `Random.sample_without_{replacement,duplicates}`
+
+### Features
+
+- add `CCResult.iter_err`
+- add `CCEqual.{always,never}_eq`
+- add `containersLabels.ml`, generate unlabelled interfaces from labelled ones
+- add `CCEqualLabels`
+- add `CCArray_sliceLabels`
+- add `CCStringLabels`
+- add `CCResult.get_or_failwith`
+- add `CCInt.( ** )` for integer exponentiation
+- add `List.counts`, related to `List.count` (#230)
+
+- migrate to dune
+- migrate to opam2
+- add CODE_OF_CONDUCT.md
+
+### Fixes
+
+- #235: release memory in vector/ringbuffer (thanks to @copy)
+- remove spurious `Labels` module
+- doc: fix small inaccuracy in comments and API
+- test: improve perf by changing random gens
+
+## 2.3
+
+- feat(vector): add `Vector.{filter,filter_map}_in_place`
+- perf(hashtrie): use int64 for 64-bits branching factor and popcount
+- feat(intmap): add `CCIntMap.{filter,filter_map,merge,is_empty}`
+- Add `CCHeap.Make_from_compare` (#225)
+- add relational ops `CCList.{group_by,join,join_by,join_all_by,group_join_by}`
+
+- fix(float): make `Float.{min,max}` compliant with revised IEEE754
+- fix(build): remove `[@inline]` attributes since they break on 4.02.3
+- Fix Int32 and Int64 operators that are not visible (#224)
+
+- some performance tweaks in Vector
+- test(float): add some tests for FP min/max
+
+## 2.2
+
+- Improving comments presentation
+- Add `CCOpt.return_if`
+- Add `CCOpt.flatten`
+- Add `CCString.{,r}drop_while`
+- add many missing functions to `CCListLabels`
+- test: consistency `CCList{,Labels}`
+
+- fix(arrayLabels): compatibility with 4.07
+- fix: compatibility for CCArrayLabels
+- test: add compatibility checks between `CCArray{,Labels}`
+
+## 2.1
+
+- make `CCInt64` compatible with `Int64` (breaking!) (closes #192)
+
+- Add `CCBijection` in containers.data
+- feat(mono): add dotted comparison operators for floats
+- add `?margin` parameter to `CCFormat.ksprintf`
+- add `CCUtf8_string` with basic encoding and decoding functionalities
+- Add `CCLazy_list.<|>`
+- Adding `CCNativeint`
+- enrich `CCInt.Infix` to get a uniform interface with `CCInt{32,64}`
+- add `CCInt{32,64}.Infix`
+- Adding CCInt32 module
+- add `CCHash.combine{5,6}`
+- Add infix operators to CCFloat
+- feat(list): add `{interleave,intersperse}` (closes #191)
+- add missing signatures of `CCArrayLabels` (closes #193)
+- Add CCFun.iterate
+- add experimental `CCFun_vec` data structure for fast functional vectors
+
+- fix: strong type aliases in Random (closes #210)
+- use standard `List.sort_uniq`
+- remove explicit dep on `bytes` in jbuild files
+- update printers names in containers.top (closes #201)
+- Enable support for Travis CI and Appveyor
+- test deps are required when we run tests
+- point to JST's blog post on poly compare
+
+## 2.0
+
+### breaking
+
+- move to jbuilder (closes #165), requiring at least OCaml 4.02
+- become defensive w.r.t polymorphic operators:
+  * Internally shadow polymorphic operators and functions from Pervasives
+    by `include CCMonomorphic` in `Containers` module
+  * Shadow the physical equality operator
+  * Shadow polymorphic functions in `CCList`
+- rename `print` to `pp` for Format printers (closes #153, #181)
+- remove `CCFlatHashtbl`
+
+### others
+
+- many typos and style fixes  (from Fourchaux)
+- Add `CCList.iteri2` and `CCList.foldi2`
+- remove `PARAM.min_size` in `CCPool`
+- Add `CCEqual.physical`
+- Avoid uses of the polymorphic operators
+- Add a `CCMonomorphic` module shipped into a `containers.monomorphic` library
+- make complexity of `Array.lookup` explicit (closes #174)
+- add `CCFormat.lazy_{or,force}` for printing thunks
+- now that ocaml >= 4.02 is required, use `Format.pp_print_text` directly
+- add `CCHeap.delete_{one,all}`
+- add `CCList.tail_opt`
+
+
+- remove qtest makefile and use a script instead
+- add many tests
+- fix bug in `CCRAL.drop` (see #184)
+- `CCFormat`: fix support of unrecognized styles
+- fix bug: don't reverse twice in `CCList.repeat`
+
+## 1.5.1, 1.5.2
+
+- re-export `Format` types and functions in `CCFormat`
+
+## 1.5
 
 - have `CCList.{get,insert,set}_at_idx` work with negative indices
 - Add CCCache.add
@@ -22,7 +577,7 @@
 - update doc of `CCList.cartesian_product`, which returns results in unspecified order (close #154)
 - fix containers.top (closes #155)
 
-== 1.4
+## 1.4
 
 - add `CCMap.union`
 - add `CCRef.swap`
@@ -42,7 +597,7 @@
 - More tests for CCVector.append and CCVector.append_array
 - assertions and cleanup in `CCPool`
 
-== 1.3
+## 1.3
 
 - deprecate `CCBool.negate`
 - add `CCString.compare_natural` (closes #146)
@@ -60,7 +615,7 @@
 - cleanup and refactor of `CCRingBuffer` (see #126). Add strong tests.
 - add rich testsuite to `CCIntMap`, based on @jmid's work
 
-== 1.2
+## 1.2
 
 - make many modules extensions of stdlib (close #109)
   the modules are: `String List ListLabels Array ArrayLabels Char Random`
@@ -94,9 +649,9 @@
 - build unix support by default
 - bugfix and test for `CCZipper.is_focused` (closes #102)
 - use boxes in `CCFormat.Dump` for tuples
-- update header, and use more `(==)` in `CCIntMap`
+- update header, and use more `(##)` in `CCIntMap`
 
-== 1.1
+## 1.1
 
 **bugfixes**:
 
@@ -117,7 +672,7 @@
 - remove CCError from tutorial
 - merge tutorial into readme, cleanup
 
-== 1.0
+## 1.0
 
 See https://github.com/c-cube/ocaml-containers/issues/84 for an overview.
 
@@ -180,14 +735,14 @@ See https://github.com/c-cube/ocaml-containers/issues/84 for an overview.
 - add doc for `of_list` in relevant modules (close #85)
 - bugfix: do not use `Sequence.flatMap` (close #90)
 
-== 0.22
+## 0.22
 
 - threads/CCLock: add `try_with_lock` to wrap `Mutex.try_lock`
 - Add `CCMultiSet.remove_all`
 - document errors in `CCIO` (close #86)
 - use the new qtest/qcheck
 
-== 0.21
+## 0.21
 
 - (breaking) make default `start`/`stop` arguments empty in printers (#82)
 
@@ -196,13 +751,13 @@ See https://github.com/c-cube/ocaml-containers/issues/84 for an overview.
 - add `CCArray.Sub.to_list`
 - add `CCArray.{sorted,sort_indices,sort_ranking}` (closes #81)
 
-- handle '\r` in CCSexpM (fixes #83)
+- handle `\r` in CCSexpM (fixes #83)
 - add alias `Containers.IO`
 - bugfixes in `CCArray.Sub`
 - bugfix + tests for `CCArray.Sub.sub`
 - disable parallel build to support cygwin
 
-== 0.20
+## 0.20
 
 - bugfix in `CCArray.equal`
 - fix `CCString.*_ascii`; add `CCChar.{upper,lower}case_ascii`
@@ -216,7 +771,7 @@ See https://github.com/c-cube/ocaml-containers/issues/84 for an overview.
 - more general types for `CCArray.{for_all2,exists2}`
 - more general type for `CCResult.map_or`
 
-== 0.19
+## 0.19
 
 - add regression test for #75
 - Fix `CCString.Split.{left,right}` (#75)
@@ -228,7 +783,7 @@ See https://github.com/c-cube/ocaml-containers/issues/84 for an overview.
 - add `CCstring.of_char`
 - update headers
 
-== 0.18
+## 0.18
 
 - update implem of `CCVector.equal`
 - add `CCOpt.get_or` with label, deprecates `get`
@@ -239,13 +794,13 @@ See https://github.com/c-cube/ocaml-containers/issues/84 for an overview.
 - add `Lazy_list.filter`
 - add `CCList.range_by`
 
-== 0.17
+## 0.17
 
-=== potentially breaking
+### potentially breaking
 
 - change the semantics of `CCString.find_all` (allow overlaps)
 
-=== Additions
+### Additions
 
 - add `CCString.pad` for more webscale
 - add `(--^)` to CCRAl, CCFQueue, CCKlist (closes #56); add `CCKList.Infix`
@@ -274,7 +829,7 @@ See https://github.com/c-cube/ocaml-containers/issues/84 for an overview.
 - add `CCImmutArray` into containers.data
 - add `CCList.Assoc.remove`
 
-=== Fixes, misc
+### Fixes, misc
 
 - Make `CCPersistentHashtbl.S.merge` more general.
 - optimize KMP search in `CCString.Find` (hand-specialize code)
@@ -292,9 +847,9 @@ others:
 - add an `IO` section to the tutorial
 - enable `-j 0` for ocamlbuild
 
-== 0.16
+## 0.16
 
-=== breaking
+### breaking
 
 - change the signature of `CCHeap.{of_gen,of_seq,of_klist}`
 - change the API of `CCMixmap`
@@ -302,18 +857,18 @@ others:
 - optional argument `~eq` to `CCGraph.Dot.pp`
 - rename `CCFuture` into `CCPool`
 
-=== deprecations
+### deprecations
 
 - deprecate `containers.bigarray`
 - deprecate `CCHashtbl.{Counter,Default}` tables
 - deprecate `CCLinq` in favor of standalone `OLinq` (to be released)
 
-=== bugfixes
+### bugfixes
 
 - fix wrong signature of `CCHashtbl.Make.{keys,values}_list`
 - missing constraint in `CCSexpM.ID_MONAD`
 
-=== new features
+### new features
 
 - add a tutorial file
 - add a printer into CCHeap
@@ -348,14 +903,14 @@ others:
 - update `examples/id_sexp` so it can read on stdin
 - add `CCList.fold_map2`
 
-== 0.15
+## 0.15
 
-=== breaking changes
+### breaking changes
 
 - remove deprecated `CCFloat.sign`
 - remove deprecated `CCSexpStream`
 
-=== other changes
+### other changes
 
 - basic color handling in `CCFormat`, using tags and ANSI codes
 - add `CCVector.ro_vector` as a convenience alias
@@ -371,22 +926,22 @@ others:
 
 - bugfix: forgot to export `{Set.Map}.OrderedType` in `Containers`
 
-== 0.14
+## 0.14
 
-=== breaking changes
+### breaking changes
 
 - change the type `'a CCParse.t` with continuations
 - add labels on `CCParse.parse_*` functions
 - change semantics of `CCList.Zipper.is_empty`
 
-=== other changes
+### other changes
 
 - deprecate `CCVector.rev'`, renamed into `CCVector.rev_in_place`
 - deprecate `CCVector.flat_map'`, renamed `flat_map_seq`
 
 - add `CCMap.add_{list,seqe`
 - add `CCSet.add_{list,seq}`
-- fix small uglyness in `Map.print` and `Set.print`
+- fix small ugliness in `Map.print` and `Set.print`
 - add `CCFormat.{ksprintf,string_quoted}`
 - add `CCArray.sort_generic` for sorting over array-like structures in place
 - add `CCHashtbl.add` mimicking the stdlib `Hashtbl.add`
@@ -426,9 +981,9 @@ others:
 - bugfix in hashtable printing
 - bugfix in `CCKList.take`, it was slightly too eager
 
-== 0.13
+## 0.13
 
-=== Breaking changes
+### Breaking changes
 
 - big refactoring of `CCLinq` (now simpler and cleaner)
 - changed the types `input` and `ParseError`  in `CCParse`
@@ -436,12 +991,12 @@ others:
 - change the exceptions in `CCVector`
 - change signature of `CCDeque.of_seq`
 
-=== Other changes
+### Other changes
 
 - add module `CCWBTree`, a weight-balanced tree, in `containers.data`.
 - add module `CCBloom` in `containers.data`, a bloom filter
 - new module `CCHashTrie` in `containers.data`, HAMT-like associative map
-- add module `CCBitField` in `containers.data`, a safe abstraction for bitfields of < 62 bits
+- add module `CCBitField` in `containers.data`, a safe abstraction for bitfields of `< 62 bits`
 - add module `CCHashSet` into `containers.data`, a mutable set
 - add module `CCInt64`
 - move module `RAL` into `containers.data` as `CCRAL`
@@ -488,14 +1043,14 @@ others:
 - new implementation for `CCDeque`, more efficient
 - update makefile (target devel)
 
-== 0.12
+## 0.12
 
-=== breaking
+### breaking
 
 - change type of `CCString.blit` so it writes into `Bytes.t`
 - better default opening flags for `CCIO.with_{in, out}`
 
-=== non-breaking
+### non-breaking
 
 NOTE: use of `containers.io` is deprecated (its only module has moved to `containers`)
 
@@ -516,7 +1071,7 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
 - fix: use the proper array module in `CCRingBuffer`
 - bugfix: `CCRandom.float_range`
 
-== 0.11
+## 0.11
 
 - add `CCList.{remove,is_empty}`
 - add `CCOpt.is_none`
@@ -538,7 +1093,7 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
 - add `CCList.Set.{add,remove}`
 - fix doc of `CCstring.Split.list_`
 
-== 0.10
+## 0.10
 
 - add `containers.misc.Puf.iter`
 - add `CCString.{lines,unlines,concat_gen}`
@@ -553,7 +1108,7 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
 - remove `containers.pervasives`, add the module `Containers` to core
 - bugfix in `CCFormat.to_file`
 
-== 0.9
+## 0.9
 
 - add `Float`, `Ref`, `Set`, `Format` to `CCPervasives`
 - `CCRingBuffer.append` (simple implementation)
@@ -573,7 +1128,7 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
 - add `CCSet` module in core/
 - add `CCRef` module in core/
 
-== 0.8
+## 0.8
 
 - add `@Emm` to authors
 - refactored heavily `CCFuture` (much simpler, cleaner, basic API and thread pool)
@@ -581,7 +1136,7 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
 - merged `test_levenshtein` with other tests
 - Add experimental rose tree in `Containers_misc.RoseTree`.
 - remove a lot of stuff from `containers.misc` (see `_oasis` for details)
-- `make devel` command, activating most flags, for developpers (see #27)
+- `make devel` command, activating most flags, for developers (see #27)
 - use benchmark 1.4, with the upstreamed tree system
 - test `ccvector.iteri`
 - add `CCFormat` into core/
@@ -596,9 +1151,9 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
 - `CCHashtbl.{keys,values}_list`
 - more accurate type for `CCHashtbl.Make`
 
-== 0.7
+## 0.7
 
-=== breaking
+### breaking
 
 - remove `cgi`/
 - removed useless Lwt-related module
@@ -606,11 +1161,11 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
 - split the library into smaller pieces (with `containers.io`, `containers.iter`,
     `containers.sexp`, `containers.data`)
 
-=== other changes
+### other changes
 
 - cleanup: move sub-libraries to their own subdir each; mv everything into `src/`
 - `sexp`:
-    * `CCSexp` now splitted into `CCSexp` (manipulating expressions) and `CCSexpStream`
+    * `CCSexp` now split into `CCSexp` (manipulating expressions) and `CCSexpStream`
     * add `CCSexpM` for a simpler, monadic parser of S-expressions (deprecating `CCSexpStream`)
 - `core`:
     * `CCString.fold`
@@ -626,7 +1181,7 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
     * bugfix in `CCIO.read_all` and `CCIO.read_chunks`
 - use `-no-alias-deps`
 
-== 0.6.1
+## 0.6.1
 
 - use subtree `gen/` for `CCGen` (symlink) rather than a copy.
 - Add benchmarks for the function `iter` of iterators.
@@ -634,14 +1189,14 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
 - `CCOpt.get_lazy` convenience function
 - introduce `CCFloat`, add float functions to `CCRandom` (thanks to @struktured)
 
-== 0.6
+## 0.6
 
-=== breaking changes
+### breaking changes
 
 - new `CCIO` module, much simpler, but incompatible interface
 - renamed `CCIO` to `advanced.CCMonadIO`
 
-=== other changes
+### other changes
 
 - `CCMultiSet.{add_mult,remove_mult,update}`
 - `CCVector.{top,top_exn}`
@@ -659,9 +1214,9 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
   are now tailrec
 
 
-== 0.5
+## 0.5
 
-=== breaking changes
+### breaking changes
 
 - dependency on `cppo` (thanks to @whitequark, see `AUTHORS.md`) and `bytes`
 - `CCError`:
@@ -670,7 +1225,7 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
 - `CCPervasives.Opt` -> `CCPervasives.Option`
 - `Levenshtein.Index.remove` changed signature (useless param removed)
 
-=== other changes
+### other changes
 
 - stronger inlining for `CCVector` (so that e.g. push is inline)
 - more tests for `CCVector`
@@ -685,7 +1240,7 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
 - add Format printers to `CCString`
 - `AUTHORS.md`
 
-== 0.4.1
+## 0.4.1
 
 - `CCOpt.get`
 - new functions in `CCSexp.Traverse`
@@ -694,7 +1249,7 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
 - update of readme
 - generate doc for `containers.advanced`
 
-== 0.4
+## 0.4
 
 - `core/CCSexp` for fast and lightweight S-expressions parsing/printing
 - moved `CCLinq`, `CCBatch` and `CCat` from core/ to advanced/
@@ -709,7 +1264,7 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
 - `CCPervasives` module, replacing modules of the standard library
 - removed type alias `CCString.t` (duplicate of String.t which already exists)
 
-== 0.3.4
+## 0.3.4
 
 - subtree for `sequence` repo
 - `CCSequence` is now a copy of `sequence`
@@ -719,7 +1274,7 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
 - specialize some comparison functions
 - `CCOrd.map`
 
-== 0.3.3
+## 0.3.3
 
 - readme: add ci hook (to http://ci.cedeela.fr)
 - `CCIO`: monad for IO actions-as-values
@@ -739,7 +1294,7 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
 - `CCString.init`
 - `CCError.fail_printf`
 
-== 0.3.2
+## 0.3.2
 
 - small change in makefile
 - conversions for `CCString`
@@ -764,7 +1319,7 @@ NOTE: use of `containers.io` is deprecated (its only module has moved to `contai
 - `CCError.map2`
 - more combinators in `CCError`
 
-== 0.3.1
+## 0.3.1
 
 - test for `CCArray.shuffle`
 - bugfix in `CCArray.shuffle`

CODE_OF_CONDUCT.md

@@ -0,0 +1,9 @@
+# Code of Conduct
+
+This project has adopted the [OCaml Code of Conduct](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md).
+
+# Enforcement
+
+This project follows the OCaml Code of Conduct
+[enforcement policy](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md#enforcement).
+To report any violations, please contact @c-cube

HOWTO.adoc

@@ -1,32 +0,0 @@
-= HOWTO
-
-== Make a release
-
-Beforehand, check `grep deprecated -r src` to see whether some functions
-can be removed.
-
-. `make test`
-. update version in `_oasis`
-. `make update_next_tag` (to update `@since` comments; be careful not to change symlinks)
-. check status of modules (`{b status: foo}`) and update if required;
-   removed deprecated functions, etc.
-. update `CHANGELOG.adoc` (see its end to find the right git command)
-. commit the changes
-. `git checkout stable`
-. `git merge master`
-. `oasis setup; make test doc`
-. update `opam` (the version field; remove `oasis` in deps)
-. tag, and push both to github
-. `opam pin add containers https://github.com/c-cube/ocaml-containers.git#<release>`
-. new opam package: `opam publish prepare; opam publish submit`
-. re-generate doc: `make doc push_doc`
-
-== List Authors
-
-  `git log --format='%aN' | sort -u`
-
-== Subtree
-
-If gen is https://github.com/c-cube/gen.git[this remote]:
-
-  git subtree pull --prefix gen gen master --squash

Makefile

@@ -1,145 +1,44 @@
-# OASIS_START
+PACKAGES=containers,containers-data
-# DO NOT EDIT (digest: 4c293511860bb966e727ba6f0ecc8197)
 
-SETUP = ./setup.exe
+all: build test
 
-build: setup.data $(SETUP)
+build:
-	$(SETUP) -build $(BUILDFLAGS)
+	dune build @install -p $(PACKAGES)
 
-doc: setup.data $(SETUP) build
+test: build
-	$(SETUP) -doc $(DOCFLAGS)
+	# run tests in release mode to expose bug in #454
+	dune runtest --display=quiet --cache=disabled --no-buffer --force --profile=release
 
-test: setup.data $(SETUP) build
+clean:
-	$(SETUP) -test $(TESTFLAGS)
+	dune clean
 
-all: $(SETUP)
+doc:
-	$(SETUP) -all $(ALLFLAGS)
+	dune build @doc
 
-install: setup.data $(SETUP)
+examples:
-	$(SETUP) -install $(INSTALLFLAGS)
+	dune build examples/id_sexp.exe
 
-uninstall: setup.data $(SETUP)
+format:
-	$(SETUP) -uninstall $(UNINSTALLFLAGS)
+	@dune build $(DUNE_OPTS) @fmt --auto-promote
 
-reinstall: setup.data $(SETUP)
+format-check:
-	$(SETUP) -reinstall $(REINSTALLFLAGS)
+	@dune build $(DUNE_OPTS) @fmt --display=quiet
 
-clean: $(SETUP)
-	$(SETUP) -clean $(CLEANFLAGS)
 
-distclean: $(SETUP)
+VERSION=$(shell awk '/^version:/ {print $$2}' containers.opam)
-	$(SETUP) -distclean $(DISTCLEANFLAGS)
-	$(RM) $(SETUP)
-
-setup.data: $(SETUP)
-	$(SETUP) -configure $(CONFIGUREFLAGS)
-
-configure: $(SETUP)
-	$(SETUP) -configure $(CONFIGUREFLAGS)
-
-setup.exe: setup.ml _oasis
-	ocamlfind ocamlopt -o $@ -linkpkg -package oasis.dynrun setup.ml || ocamlfind ocamlc -o $@ -linkpkg -package oasis.dynrun setup.ml || true
-	$(RM) setup.cmi setup.cmo setup.cmx setup.o
-
-.PHONY: build doc test all install uninstall reinstall clean distclean configure
-
-# OASIS_STOP
-
-EXAMPLES = examples/mem_size.native examples/collatz.native \
-	examples/bencode_write.native # examples/crawl.native
-OPTIONS = -use-ocamlfind -I _build
-
-examples: all
-	ocamlbuild $(OPTIONS) -package unix -I . $(EXAMPLES)
-
-push_doc: doc
-	rsync -tavu containers.docdir/* cedeela.fr:~/simon/root/software/containers/
-
-push_doc_gh: doc
-	git checkout gh-pages && \
-	  rm -rf dev/ && \
-	  mkdir -p dev && \
-	  cp -r containers.docdir/* dev/ && \
-	  git add --all dev
-
-DONTTEST=myocamlbuild.ml setup.ml $(wildcard src/**/*.cppo.*) $(wildcard src/**/*Labels*)
-QTESTABLE=$(filter-out $(DONTTEST), \
-	$(wildcard src/core/*.ml) \
-	$(wildcard src/core/*.mli) \
-	$(wildcard src/data/*.ml) \
-	$(wildcard src/data/*.mli) \
-	$(wildcard src/string/*.ml) \
-	$(wildcard src/string/*.mli) \
-	$(wildcard src/unix/*.ml) \
-	$(wildcard src/unix/*.mli) \
-	$(wildcard src/sexp/*.ml) \
-	$(wildcard src/sexp/*.mli) \
-	$(wildcard src/iter/*.ml) \
-	$(wildcard src/iter/*.mli) \
-	$(wildcard src/bigarray/*.ml) \
-	$(wildcard src/bigarray/*.mli) \
-	$(wildcard src/threads/*.ml) \
-	$(wildcard src/threads/*.mli) \
-	)
-
-qtest-clean:
-	@rm -rf qtest/
-
-QTEST_PREAMBLE='open CCFun;; '
-
-#qtest-build: qtest-clean build
-#	@mkdir -p qtest
-#	@qtest extract --preamble $(QTEST_PREAMBLE) \
-#		-o qtest/qtest_all.ml \
-#		$(QTESTABLE) 2> /dev/null
-#	@ocamlbuild $(OPTIONS) -pkg oUnit,QTest2Lib,ocamlbuildlib \
-#		-I core -I misc -I string \
-#		qtest/qtest_all.native
-
-qtest-gen:
-	@mkdir -p qtest
-	@if which qtest > /dev/null ; then \
-		qtest extract --preamble $(QTEST_PREAMBLE) \
-			-o qtest/run_qtest.ml \
-			$(QTESTABLE) 2> /dev/null ; \
-	else touch qtest/run_qtest.ml ; \
-	fi
-
-push-stable:
-	git checkout stable
-	git merge master -m 'merge from master'
-	oasis setup
-	git commit -a -m 'oasis files'
-	git push origin
-	git checkout master
-
-clean-generated:
-	rm **/*.{mldylib,mlpack,mllib} myocamlbuild.ml -f
-
-tags:
-	otags *.ml *.mli
-
-VERSION=$(shell awk '/^Version:/ {print $$2}' _oasis)
 
 update_next_tag:
 	@echo "update version to $(VERSION)..."
-	zsh -c 'sed -i "s/NEXT_VERSION/$(VERSION)/g" **/*.ml **/*.mli'
+	sed -i "s/NEXT_VERSION/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli)
-	zsh -c 'sed -i "s/NEXT_RELEASE/$(VERSION)/g" **/*.ml **/*.mli'
+	sed -i "s/NEXT_RELEASE/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli)
-
-devel:
-	./configure --enable-bench --enable-tests --enable-unix \
-		--enable-thread
-	make all
 
+WATCH?=@src/check @tests/runtest
 watch:
-	while find src/ benchs/ -print0 | xargs -0 inotifywait -e delete_self -e modify ; do \
+	@dune build $(WATCH) -w
-		echo "============ at `date` ==========" ; \
-		make all; \
-	done
 
 reindent:
 	@which ocp-indent || ( echo "require ocp-indent" ; exit 1 )
 	@find src '(' -name '*.ml' -or -name '*.mli' ')' -type f -print0 | xargs -0 echo "reindenting: "
 	@find src '(' -name '*.ml' -or -name '*.mli' ')' -type f -print0 | xargs -0 ocp-indent -i
 
-.PHONY: examples push_doc tags qtest-gen qtest-clean devel update_next_tag
+.PHONY: all test clean build doc update_next_tag watch examples

README.adoc

@@ -1,478 +0,0 @@
-= OCaml-containers =
-:toc: macro
-:source-highlighter: pygments
-
-A modular, clean and powerful extension of the OCaml standard library.
-
-https://c-cube.github.io/ocaml-containers/last/[(Jump to the current API documentation)].
-
-Containers is an extension of OCaml's standard library (under BSD license)
-focused on data structures, combinators and iterators, without dependencies on
-unix, str or num. Every module is independent and is prefixed with 'CC' in the
-global namespace. Some modules extend the stdlib (e.g. CCList provides safe
-map/fold_right/append, and additional functions on lists).
-Alternatively, `open Containers` will bring enhanced versions of the standard
-modules into scope.
-
-image::https://travis-ci.org/c-cube/ocaml-containers.svg?branch=master[alt="Build Status", link="https://travis-ci.org/c-cube/ocaml-containers"]
-
-toc::[]
-
-== Quick Summary
-
-Containers is:
-
-- A usable, reasonably well-designed library that extends OCaml's standard
-  library (in 'src/core/', packaged under `containers` in ocamlfind. Modules
-  are totally independent and are prefixed with `CC` (for "containers-core"
-  or "companion-cube" because I'm a megalomaniac). This part should be
-  usable and should work. For instance, `CCList` contains functions and
-  lists including safe versions of `map` and `append`. It also
-  provides a drop-in replacement to the standard library, in the module
-  `Containers` (intended to be opened, replaces some stdlib modules
-  with extended ones).
-- Several small additional libraries that complement it:
-  * `containers.data` with additional data structures that don't have an
-    equivalent in the standard library;
-  * `containers.iter` with list-like and tree-like iterators;
-- Utilities around the `unix` library in `containers.unix` (mainly to spawn
-  sub-processes easily and deal with resources safely)
-- A lightweight S-expression printer and streaming parser in `containers.sexp`
-- A library for threaded programming in `containers.thread`,
-  including a blocking queue, semaphores, an extension of `Mutex`, and
-  thread-pool based futures.
-
-Some of the modules have been moved to their own repository (e.g. `sequence`,
-`gen`, `qcheck`) and are on opam for great fun and profit.
-
-== Change Log
-
-See link:CHANGELOG.adoc[this file].
-
-== Finding help
-
-- http://lists.ocaml.org/listinfo/containers-users[Mailing List]
-  the address is mailto:containers-users@lists.ocaml.org[]
-- the https://github.com/c-cube/ocaml-containers/wiki[github wiki]
-- on IRC, ask `companion_cube` on `#ocaml@freenode.net`
-- image:https://badges.gitter.im/Join%20Chat.svg[alt="Gitter", link="https://gitter.im/c-cube/ocaml-containers?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge"]
-
-== Use
-
-You might start with the <<tutorial>> to get a picture of how to use the library.
-
-You can either build and install the library (see <<build>>), or just copy
-files to your own project. The last solution has the benefits that you
-don't have additional dependencies nor build complications (and it may enable
-more inlining). Since modules have a friendly license and are mostly
-independent, both options are easy.
-
-In a toplevel, using ocamlfind:
-
-[source,OCaml]
-----
-# #use "topfind";;
-# #require "containers";;
-# CCList.flat_map;;
-- : ('a -> 'b list) -> 'a list -> 'b list = <fun>
-# open Containers;;  (* optional *)
-# List.flat_map ;;
-- : ('a -> 'b list) -> 'a list -> 'b list = <fun>
-----
-
-If you have comments, requests, or bugfixes, please share them! :-)
-
-== License
-
-This code is free, under the BSD license.
-
-== Contents
-
-See http://c-cube.github.io/ocaml-containers/[the documentation]
-and <<tutorial,the tutorial below>> for a gentle introduction.
-
-== Documentation
-
-In general, see http://c-cube.github.io/ocaml-containers/last/ or
-http://cedeela.fr/~simon/software/containers for the **API documentation**.
-
-Some examples can be found link:doc/containers.adoc[there],
-per-version doc http://c-cube.github.io/ocaml-containers/[there].
-
-[[build]]
-== Build
-
-You will need OCaml `>=` 4.01.0.
-
-=== Via opam
-
-The prefered way to install is through http://opam.ocaml.org/[opam].
-
-    $ opam install containers
-
-=== From Sources
-
-On the branch `master` you will need `oasis` to build the library. On the
-branch `stable` it is not necessary.
-
-    $ make
-
-To build and run tests (requires `oUnit` and https://github.com/vincent-hugot/iTeML[qtest]):
-
-    $ opam install oUnit qtest
-    $ ./configure --enable-tests --enable-unix
-    $ make test
-
-To build the small benchmarking suite (requires https://github.com/chris00/ocaml-benchmark[benchmark]):
-
-    $ opam install benchmark
-    $ make bench
-    $ ./benchs.native
-
-== Contributing
-
-PRs on github are very welcome (patches by email too, if you prefer so).
-
-[[first-time-contribute]]
-=== First-Time Contributors
-
-Assuming your are in a clone of the repository:
-
-. Some dependencies are required, you'll need
-  `opam install benchmark qcheck qtest sequence`. 
-. run `make devel` to enable everything (including tests).
-. make your changes, commit, push, and open a PR.
-. use `make test` without moderation! It must pass before a PR
-  is merged.  There are around 900 tests right now, and new
-  features should come with their own tests.
-
-If you feel like writing new tests, that is totally worth a PR
-(and my gratefulness).
-
-=== General Guidelines
-
-A few guidelines to follow the philosophy of containers:
-
-- no dependencies between basic modules (even just for signatures);
-- add `@since` tags for new functions;
-- add tests if possible (using https://github.com/vincent-hugot/iTeML/[qtest]). There are numerous inline tests already,
-to see what it looks like search for comments starting with `(*$`
-in source files.
-
-=== For Total Beginners
-
-Thanks for wanting to contribute!
-To contribute a change, here are the steps (roughly):
-
-. click "fork" on https://github.com/c-cube/ocaml-containers on the top right of the page. This will create a copy of the repository on your own github account.
-. click the big green "clone or download" button, with "SSH". Copy the URL (which should look like `git@github.com:<your username>/ocaml-containers.git`) into a terminal to enter the command:
-+
-[source,sh]
-----
-$ git clone git@github.com:<your username>/ocaml-containers.git
-----
-+
-. then, `cd` into the newly created directory.
-. make the changes you want. See <<first-time-contribute>> for
-  more details about what to do in particular.
-. use `git add` and `git commit` to commit these changes.
-. `git push origin master` to push the new change(s) onto your
-  copy of the repository
-. on github, open a "pull request" (PR). Et voilà !
-
-[[tutorial]]
-== Tutorial
-
-This tutorial contains a few examples to illustrate the features and
-usage of containers. We assume containers is installed and that
-the library is loaded, e.g. with:
-
-[source,OCaml]
-----
-#require "containers";;
-----
-
-=== Basics
-
-We will start with a few list helpers, then look at other parts of
-the library, including printers, maps, etc.
-
-[source,OCaml]
-----
-
-(* quick reminder of this awesome standard operator *)
-# (|>) ;;
-- : 'a -> ('a -> 'b) -> 'b = <fun>
-
-# open CCList.Infix;;
-
-# let l = 1 -- 100;;
-val l : int list = [1; 2; .....]
-
-# l
-  |> CCList.filter_map
-     (fun x-> if x mod 3=0 then Some (float x) else None)
-  |> CCList.take 5 ;;
-- : float list = [3.; 6.; 9.; 12.; 15.]
-
-# let l2 = l |> CCList.take_while (fun x -> x<10) ;;
-val l2 : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9]
-
-(* an extension of Map.Make, compatible with Map.Make(CCInt) *)
-# module IntMap = CCMap.Make(CCInt);;
-
-(* conversions using the "sequence" type, fast iterators that are
-   pervasively used in containers. Combinators can be found
-   in the opam library "sequence". *)
-# let map =
-    l2
-    |> List.map (fun x -> x, string_of_int x)
-    |> CCList.to_seq
-    |> IntMap.of_seq;;
-val map : string CCIntMap.t = <abstr>
-
-(* check the type *)
-# CCList.to_seq ;;
-- : 'a list -> 'a sequence = <fun>
-# IntMap.of_seq ;;
-- : (int * 'a) CCMap.sequence -> 'a IntMap.t = <fun>
-
-(* we can print, too *)
-# Format.printf "@[<2>map =@ @[<hov>%a@]@]@."
-    (IntMap.print CCFormat.int CCFormat.string_quoted)
-    map;;
-map =
-  [1 --> "1", 2 --> "2", 3 --> "3", 4 --> "4", 5 --> "5", 6 --> "6",
-   7 --> "7", 8 --> "8", 9 --> "9"]
-- : unit = ()
-
-(* options are good *)
-# IntMap.get 3 map |> CCOpt.map (fun s->s ^ s);;
-- : string option = Some "33"
-
-----
-
-=== New types: `CCVector`, `CCHeap`, `CCResult`
-
-Containers also contains (!) a few datatypes that are not from the standard
-library but that are useful in a lot of situations:
-
-CCVector::
-  A resizable array, with a mutability parameter. A value of type
-  `('a, CCVector.ro) CCVector.t` is an immutable vector of values of type `'a`,
-  whereas a `('a, CCVector.rw) CCVector.t` is a mutable vector that
-  can be modified. This way, vectors can be used in a quite functional
-  way, using operations such as `map` or `flat_map`, or in a more
-  imperative way.
-CCHeap::
-  A priority queue (currently, leftist heaps) functorized over
-  a module `sig val t val leq : t -> t -> bool` that provides a type `t`
-  and a partial order `leq` on `t`.
-CCResult::
-  An error type for making error handling more explicit (an error monad,
-  really, if you're not afraid of the "M"-word).
-  Subsumes and replaces the old `CCError`.
-  It uses the new `result` type from the standard library (or from
-  the retrocompatibility package on opam) and provides
-  many combinators for dealing with `result`.
-
-Now for a few examples:
-
-[source,OCaml]
-----
-
-(* create a new empty vector. It is mutable, for otherwise it would
-   not be very useful. *)
-# CCVector.create;;
-- : unit -> ('a, CCVector.rw) CCVector.t = <fun>
-
-(* init, similar to Array.init, can be used to produce a
-   vector that is mutable OR immutable (see the 'mut parameter?) *)
-# CCVector.init ;;
-- : int -> (int -> 'a) -> ('a, 'mut) CCVector.t = <fun>c
-
-(* use the infix (--) operator for creating a range. Notice
-   that v is a vector of integer but its mutability is not
-   decided yet. *)
-# let v = CCVector.(1 -- 10);;
-val v : (int, '_a) CCVector.t = <abstr>
-
-# Format.printf "v = @[%a@]@." (CCVector.print CCInt.print) v;;
-v = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
-
-(* now let's mutate v *)
-# CCVector.push v 42;;
-- : unit = ()
-
-(* now v is a mutable vector *)
-# v;;
-- : (int, CCVector.rw) CCVector.t = <abstr>
-
-(* functional combinators! *)
-# let v2 = v
-  |> CCVector.map (fun x-> x+1)
-  |> CCVector.filter (fun x-> x mod 2=0)
-  |> CCVector.rev ;;
-val v2 : (int, '_a) CCVector.t = <abstr>
-
-# Format.printf "v2 = @[%a@]@." (CCVector.print CCInt.print) v2;;
-v2 = [10, 8, 6, 4, 2]
-
-(* let's transfer to a heap *)
-# module IntHeap = CCHeap.Make(struct type t = int let leq = (<=) end);;
-
-# let h = v2 |> CCVector.to_seq |> IntHeap.of_seq ;;
-val h : IntHeap.t = <abstr>
-
-(* We can print the content of h
-  (printing is not necessarily in order, though) *)
-# Format.printf "h = [@[%a@]]@." (IntHeap.print CCInt.print) h;;
-h = [2,4,6,8,10]
-
-(* we can remove the first element, which also returns a new heap
-   that does not contain it — CCHeap is a functional data structure *)
-# IntHeap.take h;;
-- : (IntHeap.t * int) option = Some (<abstr>, 2)
-
-# let h', x = IntHeap.take_exn h ;;
-val h' : IntHeap.t = <abstr>
-val x : int = 2
-
-(* see, 2 is removed *)
-# IntHeap.to_list h' ;;
-- : int list = [4; 6; 8; 10]
-
-----
-
-=== IO helpers
-
-The core library contains a module called `CCIO` that provides useful
-functions for reading and writing files. It provides functions that
-make resource handling easy, following
-the pattern `with_resource : resource -> (access -> 'a) -> 'a` where
-the type `access` is a temporary handle to the resource (e.g.,
-imagine `resource` is a file name and `access` a file descriptor).
-Calling `with_resource r f` will access `r`, give the  result to `f`,
-compute the result of `f` and, whether `f` succeeds or raises an
-error, it will free the resource.
-
-Consider for instance:
-
-[source,OCaml]
-----
-# CCIO.with_out "/tmp/foobar"
-    (fun out_channel ->
-      CCIO.write_lines_l out_channel ["hello"; "world"]);;
-- : unit = ()
-----
-
-This just opened the file '/tmp/foobar', creating it if it didn't exist,
-and wrote two lines in it. We did not have to close the file descriptor
-because `with_out` took care of it. By the way, the type signatures are:
-
-[source,OCaml]
-----
-val with_out :
-  ?mode:int -> ?flags:open_flag list ->
-  string -> (out_channel -> 'a) -> 'a
-
-val write_lines_l : out_channel -> string list -> unit
-----
-
-So we see the pattern for `with_out` (which opens a function in write
-mode and gives its functional argument the corresponding file descriptor).
-
-NOTE: you should never let the resource escape the
-scope of the `with_resource` call, because it will not be valid outside.
-OCaml's type system doesn't make it easy to forbid that so we rely
-on convention here (it would be possible, but cumbersome, using
-a record with an explicitely quantified function type).
-
-Now we can read the file again:
-
-[source,OCaml]
-----
-# let lines = CCIO.with_in "/tmp/foobar" CCIO.read_lines_l ;;
-val lines : string list = ["hello"; "world"]
-----
-
-There are some other functions in `CCIO` that return _generators_
-instead of lists. The type of generators in containers
-is `type 'a gen = unit -> 'a option` (combinators can be
-found in the opam library called "gen"). A generator is to be called
-to obtain successive values, until it returns `None` (which means it
-has been exhausted). In particular, python users might recognize
-the function
-
-[source,OCaml]
-----
-# CCIO.File.walk ;;
-- : string -> walk_item gen = <fun>;;
-----
-
-where `type walk_item = [ `Dir | `File ] * string` is a path
-paired with a flag distinguishing files from directories.
-
-
-=== To go further: containers.data
-
-There is also a sub-library called `containers.data`, with lots of
-more specialized data-structures.
-The documentation contains the API for all the modules
-(see link:README.adoc[the readme]); they also provide
-interface to `sequence` and, as the rest of containers, minimize
-dependencies over other modules. To use `containers.data` you need to link it,
-either in your build system or by `#require containers.data;;`
-
-A quick example based on purely functional double-ended queues:
-
-[source,OCaml]
-----
-# #require "containers.data";;
-# #install_printer CCFQueue.print;;  (* better printing of queues! *)
-
-# let q = CCFQueue.of_list [2;3;4] ;;
-val q : int CCFQueue.t = queue {2; 3; 4}
-
-# let q2 = q |> CCFQueue.cons 1 |> CCFQueue.cons 0 ;;
-val q2 : int CCFQueue.t = queue {0; 1; 2; 3; 4}
-
-(* remove first element *)
-# CCFQueue.take_front q2;;
-- : (int * int CCFQueue.t) option = Some (0, queue {1; 2; 3; 4})
-
-(* q was not changed *)
-# CCFQueue.take_front q;;
-- : (int * int CCFQueue.t) option = Some (2, queue {3; 4})
-
-(* take works on both ends of the queue *)
-# CCFQueue.take_back_l 2 q2;;
-- : int CCFQueue.t * int list = (queue {0; 1; 2}, [3; 4])
-
-----
-
-=== Common Type Definitions
-
-Some structural types are used throughout the library:
-
-gen:: `'a gen = unit -> 'a option` is an iterator type. Many combinators
-  are defined in the opam library https://github.com/c-cube/gen[gen]
-sequence:: `'a sequence = (unit -> 'a) -> unit` is also an iterator type.
-  It is easier to define on data structures than `gen`, but it a bit less
-  powerful.  The opam library https://github.com/c-cube/sequence[sequence]
-  can be used to consume and produce values of this type.
-error:: `'a or_error = ('a, string) result = Error of string | Ok of 'a`
-  using the standard `result` type, supported in `CCResult`.
-klist:: `'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]` is a lazy list
-  without memoization, used as a persistent iterator. The reference
-  module is `CCKList` (in `containers.iter`).
-printer:: `'a printer = Format.formatter -> 'a -> unit` is a pretty-printer
-  to be used with the standard module `Format`. In particular, in many cases,
-  `"foo: %a" Foo.print foo` will type-check.
-
-=== Extended Documentation
-
-See link:doc/containers.adoc[the extended documentation] for more examples.
-
-Powered by image:http://oasis.forge.ocamlcore.org/oasis-badge.png[alt="OASIS", style="border: none;", link="http://oasis.forge.ocamlcore.org/"]
-

README.md

@@ -0,0 +1,699 @@
+# OCaml-containers 📦 [![Build and test](https://github.com/c-cube/ocaml-containers/actions/workflows/main.yml/badge.svg)](https://github.com/c-cube/ocaml-containers/actions/workflows/main.yml)
+
+A modular, clean and powerful extension of the OCaml standard library.
+
+[(Jump to the current API documentation)](https://c-cube.github.io/ocaml-containers/)
+
+Containers is an extension of OCaml's standard library (under BSD license)
+focused on data structures, combinators and iterators, without dependencies on
+unix, str or num. Every module is independent and is prefixed with 'CC' in the
+global namespace. Some modules extend the stdlib (e.g. `CCList` provides safe
+`map`/`fold_right`/`append`, and additional functions on lists).
+Alternatively, `open Containers` will bring enhanced versions of the standard
+modules into scope.
+
+## Quick Summary
+
+Containers is:
+
+- A usable, reasonably well-designed library that extends OCaml's standard
+  library (in 'src/core/', packaged under `containers` in ocamlfind. Modules
+  are totally independent and are prefixed with `CC` (for "containers-core"
+  or "companion-cube" because I'm a megalomaniac). This part should be
+  usable and should work. For instance, `CCList` contains functions and
+  lists including safe versions of `map` and `append`. It also
+  provides a drop-in replacement to the standard library, in the module
+  `Containers` (intended to be opened, replaces some stdlib modules
+  with extended ones), and a small S-expression printer and parser
+  that can be functorized over the representation of values.
+- Some sub-libraries with a specific focus each:
+  * Utilities around the `unix` library in `containers.unix` (mainly to spawn
+    sub-processes easily and deal with resources safely)
+  * A bencode codec in `containers.bencode`. This is a tiny json-like
+    serialization format that is extremely simple. It comes from bittorrent files.
+  * A [CBOR](https://cbor.io) codec in `containers.cbor`. This is a
+    compact binary serialization format.
+  * The [Strongly Connected Component](https://en.wikipedia.org/wiki/Strongly_connected_component)
+    algorithm, functorized, in `containers.scc`
+- A separate library `containers-data` with additional
+  data structures that don't have an equivalent in the standard library,
+  typically not as thoroughly maintained. This is now in its own package
+  since 3.0.
+
+Some of the modules have been moved to their own repository (e.g. `sequence` (now `iter`),
+`gen`, `qcheck`) and are on opam for great fun and profit.
+
+Containers-thread has been removed in favor of [Moonpool](https://github.com/c-cube/moonpool/).
+
+## Migration Guide
+
+### To 3.0
+
+The [changelog's breaking section](CHANGELOG.md) contains a list of the breaking
+changes in this release.
+
+1. The biggest change is that some sub-libraries have been either turned into
+  their own packages (`containers-data`),
+  deleted (`containers.iter`),or merged elsewhere (`containers.sexp`).
+  This means that if use these libraries you will have to edit your
+  `dune`/`_oasis`/`opam` files.
+
+  - if you use `containers.sexp` (i.e. the `CCSexp` module), it now lives in
+    `containers` itself.
+  - if you used anything in `containers.data`, you need to depend on the
+    `containers-data` package now.
+
+2. Another large change is the removal (at last!) of functions deprecated
+  in 2.8, related to the spread of `Seq.t` as the standard iterator type.
+  Functions like `CCVector.of_seq` now operate on this standard `Seq.t` type,
+  and old-time iteration based on [iter](https://github.com/c-cube/iter)
+  is now named `of_iter`, `to_iter`, etc.
+
+  Here you need to change your code, possibly using search and replace.
+  Thankfully, the typechecker should guide you.
+
+3. `Array_slice` and `String.Sub` have been removed to simplify the
+  code and `String` more lightweight. There is no replacement at the moment.
+  Please tell us if you need this to be turned into a sub-library.
+
+4. Renaming of some functions into more explicit/clear names.
+  Examples:
+
+  * `CCVector.shrink` is now `CCVector.truncate`
+  * `CCVector.remove` is now `CCVector.remove_unordered`, to be
+    contrasted with the new `CCVector.remove_and_shift`.
+  * `CCPair.map_fst` and `map_snd` now transform a tuple into another tuple
+    by modify the first (resp. second) element.
+
+5. All the collection pretty-printers now take their separator/start/stop
+  optional arguments as `unit printer` (i.e. `Format.formatter -> unit -> unit`
+  functions) rather than strings. This gives the caller better control
+  over the formatting of lists, arrays, queues, tables, etc.
+
+6. Removal of many deprecated functions.
+
+
+### To 2.0
+
+- The type system should detect issues related to `print` renamed into `pp` easily.
+  If you are lucky, a call to `sed -i 's/print/pp/g'` on the concerned files
+  might help rename all the calls
+  properly.
+
+- many optional arguments have become mandatory, because their default value
+  would be a polymorphic "magic" operator such as `(=)` or `(>=)`.
+  Now these have to be specified explicitly, but during the transition
+  you can use `Stdlib.(=)` and `Stdlib.(>=)` as explicit arguments.
+
+- if your code contains `open Containers`, the biggest hurdle you face
+  might be that operators have become monomorphic by default.
+  We believe this is a useful change that prevents many subtle bugs.
+  However, during migration and until you use proper combinators for
+  equality (`CCEqual`), comparison (`CCOrd`), and hashing (`CCHash`),
+  you might want to add `open Stdlib` just after the `open Containers`.
+  See [the section on monomorphic operators](#monomorphic-operators-why-and-how) for more details.
+
+## Monomorphic operators: why, and how?
+
+### Why shadow polymorphic operators by default?
+
+To quote @bluddy in [#196](https://github.com/c-cube/ocaml-containers/issues/196):
+
+The main problem with polymorphic comparison is that many data structures will
+give one result for structural comparison, and a different result for semantic
+comparison. The classic example is comparing maps. If you have a list of maps
+and try to use comparison to sort them, you'll get the wrong result: multiple
+map structures can represent the same semantic mapping from key to value, and
+comparing them in terms of structure is simply wrong. A far more pernicious bug
+occurs with hashtables. Identical hashtables will seem to be identical for a
+while, as before they've had a key clash, the outer array is likely to be the
+same. Once you get a key clash though, you start getting lists inside the
+arrays (or maps inside the arrays if you try to make a smarter hashtable) and
+that will cause comparison errors ie. identical hashtables will be seen as
+different or vice versa.
+
+Every time you use a polymorphic comparison where you're using a data type
+where structural comparison != semantic comparison, it's a bug. And every time
+you use polymorphic comparison where the type of data being compared may vary
+(e.g. it's an int now, but it may be a map later), you're planting a bug for
+the future.
+
+See also:
+
+- https://blog.janestreet.com/the-perils-of-polymorphic-compare/
+- https://blog.janestreet.com/building-a-better-compare/
+
+### Sometimes polymorphic operators still make sense!
+
+If you just want to use polymorphic operators, it's fine! You can access them
+easily by using `Stdlib.(=)`, `Stdlib.max`, etc.
+
+When migrating a module, you can add `open Stdlib` on top of it to restore
+the default behavior. It is, however, recommended to export an `equal` function
+(and `compare`, and `hash`) for all the public types, even if their internal
+definition is just the corresponding polymorphic operator.
+This way, other modules can refer to `Foo.equal` and will not have to be
+updated the day `Foo.equal` is no longer just polymorphic equality.
+Another bonus is that `Hashtbl.Make(Foo)` or `Map.Make(Foo)` will just work™.
+
+### Further discussions
+
+See issues
+[#196](https://github.com/c-cube/ocaml-containers/issues/196),
+[#197](https://github.com/c-cube/ocaml-containers/issues/197)
+
+## Debugging with `ocamldebug`
+
+To print values with types defined in `containers` in the bytecode debugger,
+you first have to load the appropriate bytecode archives. After starting a
+session, e.g. `ocamldebug your_program.bc`,
+
+```ocaml non-deterministic=command
+# #load_printer containers_monomorphic.cma;;
+# #load_printer containers.cma;;
+```
+
+For these archives to be found, you may have to `run` the program first. Now
+printing functions that have the appropriate type `Format.formatter -> 'a ->
+unit` can be installed. For example,
+
+```ocaml non-deterministic=command
+# #install_printer Containers.Int.pp;;
+```
+
+However, printer combinators are not easily handled by `ocamldebug`. For
+instance `# install_printer Containers.(List.pp Int.pp)` will *not* work out of
+the box. You can make this work by writing a short module which defines
+ready-made combined printing functions, and loading that in ocamldebug. For
+instance
+
+```ocaml non-deterministic=command
+module M = struct
+	let pp_int_list = Containers.(List.pp Int.pp)
+end;;
+```
+
+loaded via `# load_printer m.cmo` and installed as `# install_printer
+M.pp_int_list`.
+
+
+## Change Log
+
+See [this file](./CHANGELOG.md).
+
+## Finding help
+
+- [Mailing List](http://lists.ocaml.org/listinfo/containers-users)
+  the address is <mailto:containers-users@lists.ocaml.org>
+- the [github wiki](https://github.com/c-cube/ocaml-containers/wiki)
+- on IRC, ask `companion_cube` on `#ocaml@irc.libera.chat`
+- there is a `#containers` channel on OCaml's discord server.
+
+## Use
+
+You might start with the [tutorial](#tutorial) to get a picture of how to use the library.
+
+You can either build and install the library (see [build](#build)), or just copy
+files to your own project. The last solution has the benefits that you
+don't have additional dependencies nor build complications (and it may enable
+more inlining). Since modules have a friendly license and are mostly
+independent, both options are easy.
+
+In a toplevel, using ocamlfind:
+
+```ocaml
+# #use "topfind";;
+...
+# #require "containers";;
+# #require "containers-data";;
+# CCList.flat_map;;
+- : ('a -> 'b list) -> 'a list -> 'b list = <fun>
+# open Containers (* optional *);;
+# List.flat_map ;;
+- : ('a -> 'b list) -> 'a list -> 'b list = <fun>
+```
+
+If you have comments, requests, or bugfixes, please share them! :-)
+
+## License
+
+This code is free, under the BSD license.
+
+## Contents
+
+See [the documentation](http://c-cube.github.io/ocaml-containers/)
+and [the tutorial below](#tutorial) for a gentle introduction.
+
+## Documentation
+
+In general, see http://c-cube.github.io/ocaml-containers/last/ for the **API documentation**.
+
+Some examples can be found [there](doc/containers.md),
+per-version doc [there](http://c-cube.github.io/ocaml-containers/).
+
+## Build
+
+You will need OCaml `>=` 4.03.0.
+
+### Via opam
+
+The preferred way to install is through [opam](http://opam.ocaml.org/).
+
+```
+$ opam install containers
+```
+
+### From Sources
+
+<details>
+
+You need dune (formerly jbuilder).
+
+```
+$ make
+```
+
+To build and run tests (requires `qcheck-core`, `gen`, `iter`):
+
+```
+$ opam install qcheck-core
+$ make test
+```
+
+To build the small benchmarking suite (requires [benchmark](https://github.com/chris00/ocaml-benchmark)):
+
+```
+$ opam install benchmark batteries
+$ make bench
+$ ./benchs/run_benchs.sh
+```
+
+</details>
+
+## Contributing
+
+PRs on github are very welcome (patches by email too, if you prefer so).
+
+<details>
+<summary>how to contribute (click to unfold)</summary>
+
+### List of authors
+
+The list of contributors can be seen [on github](https://github.com/c-cube/ocaml-containers/graphs/contributors).
+
+Alternatively, `git authors` from git-extras can be invoked from within the repo
+to list authors based on the git commits.
+
+### First-Time Contributors
+
+Assuming your are in a clone of the repository:
+
+1. Some dependencies are required, you'll need
+  `opam install benchmark qcheck-core iter gen mdx uutf yojson`.
+2. run `make all` to enable everything (including tests).
+3. make your changes, commit, push, and open a PR.
+4. use `make test` without moderation! It must pass before a PR
+  is merged.  There are around 1150 tests right now, and new
+  features should come with their own tests.
+
+If you feel like writing new tests, that is totally worth a PR
+(and my gratefulness).
+
+### General Guidelines
+
+A few guidelines to follow the philosophy of containers:
+
+- no dependencies between basic modules (even just for signatures);
+- add `@since` tags for new functions;
+- add tests if possible (see `tests/` dir)
+  There are numerous inline tests already,
+  to see what it looks like search for comments starting with `(*$`
+  in source files.
+
+### For Total Beginners
+
+Thanks for wanting to contribute!
+To contribute a change, here are the steps (roughly):
+
+1. click "fork" on https://github.com/c-cube/ocaml-containers on the top right of the page. This will create a copy of the repository on your own github account.
+2. click the big green "clone or download" button, with "SSH". Copy the URL (which should look like `git@github.com:<your username>/ocaml-containers.git`) into a terminal to enter the command:
+
+    ```
+    $ git clone git@github.com:<your username>/ocaml-containers.git
+    ```
+
+3. then, `cd` into the newly created directory.
+4. make the changes you want. See <#first-time-contributors> for
+  more details about what to do in particular.
+5. use `git add` and `git commit` to commit these changes.
+6. `git push origin master` to push the new change(s) onto your
+  copy of the repository
+7. on github, open a "pull request" (PR). Et voilà !
+
+</details>
+
+## Tutorial
+
+This tutorial contains a few examples to illustrate the features and
+usage of containers.
+
+
+<details>
+<summary>an introduction to containers (click to unfold)</summary>
+
+We assume containers is installed and that
+the library is loaded, e.g. with:
+
+```ocaml
+# #require "containers";;
+# Format.set_margin 50 (* for readability here *);;
+- : unit = ()
+```
+
+### Basics
+
+We will start with a few list helpers, then look at other parts of
+the library, including printers, maps, etc.
+
+```ocaml
+# (|>) (* quick reminder of this awesome standard operator *);;
+- : 'a -> ('a -> 'b) -> 'b = <fun>
+# 10 |> succ;;
+- : int = 11
+
+# open CCList.Infix;;
+
+# let l = 1 -- 100;;
+val l : int list =
+  [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; 26; 27; 28; 29; 30; 31; 32; 33; 34; 35; 36; 37; 38; 39;
+   40; 41; 42; 43; 44; 45; 46; 47; 48; 49; 50; 51; 52; 53; 54; 55; 56; 57;
+   58; 59; 60; 61; 62; 63; 64; 65; 66; 67; 68; 69; 70; 71; 72; 73; 74; 75;
+   76; 77; 78; 79; 80; 81; 82; 83; 84; 85; 86; 87; 88; 89; 90; 91; 92; 93;
+   94; 95; 96; 97; 98; 99; 100]
+
+# (* transform a list, dropping some elements *)
+  l
+  |> CCList.filter_map
+     (fun x-> if x mod 3=0 then Some (float x) else None)
+  |> CCList.take 5 ;;
+- : float list = [3.; 6.; 9.; 12.; 15.]
+
+# let l2 = l |> CCList.take_while (fun x -> x<10) ;;
+val l2 : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9]
+```
+
+```ocaml
+(* an extension of Map.Make, compatible with Map.Make(CCInt) *)
+module IntMap = CCMap.Make(CCInt);;
+```
+
+```ocaml
+# (* conversions using the "iter" type, fast iterators that are
+   pervasively used in containers. Combinators can be found
+   in the opam library "iter". *)
+  let map : string IntMap.t =
+    l2
+    |> List.map (fun x -> x, string_of_int x)
+    |> CCList.to_iter
+    |> IntMap.of_iter;;
+val map : string IntMap.t = <abstr>
+
+# CCList.to_iter (* check the type *);;
+- : 'a list -> 'a CCList.iter = <fun>
+# IntMap.of_iter ;;
+- : (int * 'a) CCMap.iter -> 'a IntMap.t = <fun>
+
+# (* we can print, too *)
+  Format.printf "@[<2>map =@ @[<hov>%a@]@]@."
+    (IntMap.pp CCFormat.int CCFormat.string_quoted)
+    map;;
+map =
+  1 -> "1", 2 -> "2", 3 -> "3", 4 -> "4", 5
+  -> "5", 6 -> "6", 7 -> "7", 8 -> "8", 9 -> "9"
+- : unit = ()
+
+# (* options are good *)
+  IntMap.get 3 map |> CCOption.map (fun s->s ^ s);;
+- : string option = Some "33"
+```
+
+### New types: `CCVector`, `CCHeap`, `CCResult`, `CCSexp`, `CCByte_buffer`
+
+Containers also contains (!) a few datatypes that are not from the standard
+library but that are useful in a lot of situations:
+
+- `CCVector`:
+  A resizable array, with a mutability parameter. A value of type
+  `('a, CCVector.ro) CCVector.t` is an immutable vector of values of type `'a`,
+  whereas a `('a, CCVector.rw) CCVector.t` is a mutable vector that
+  can be modified. This way, vectors can be used in a quite functional
+  way, using operations such as `map` or `flat_map`, or in a more
+  imperative way.
+- `CCHeap`:
+  A priority queue (currently, leftist heaps) functorized over
+  a module `sig val t val leq : t -> t -> bool` that provides a type `t`
+  and a partial order `leq` on `t`.
+- `CCResult`
+  An error type for making error handling more explicit (an error monad,
+  really, if you're not afraid of the "M"-word).
+  Subsumes and replaces the old `CCError`.
+  It uses the new `result` type from the standard library (or from
+  the retrocompatibility package on opam) and provides
+  many combinators for dealing with `result`.
+- `CCSexp` and `CCCanonical_sexp`:
+  functorized printer and parser for S-expressions, respectively as
+  actual S-expressions (like `sexplib`) and as canonical binary-safe
+  S-expressions (like `csexp`)
+- `CCByte_buffer`: a better version of the standard `Buffer.t` which cannot be
+  extended and prevents access to its internal byte array. This type is
+  designed for (blocking) IOs and to produce complex strings incrementally
+  in an efficient way.
+
+Now for a few examples:
+
+```ocaml
+# (* create a new empty vector. It is mutable, for otherwise it would
+   not be very useful. *)
+  CCVector.create;;
+- : unit -> ('a, CCVector.rw) CCVector.t = <fun>
+
+# (* init, similar to Array.init, can be used to produce a
+   vector that is mutable OR immutable (see the 'mut parameter?) *)
+  CCVector.init ;;
+- : int -> (int -> 'a) -> ('a, 'mut) CCVector.t = <fun>
+```
+
+```ocaml non-deterministic=output
+# (* use the infix (--) operator for creating a range. Notice
+   that v is a vector of integer but its mutability is not
+   decided yet. *)
+  let v = CCVector.(1 -- 10);;
+val v : (int, '_a) CCVector.t = <abstr>
+```
+
+```ocaml
+# Format.printf "v = @[%a@]@." (CCVector.pp CCInt.pp) v;;
+v = 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
+- : unit = ()
+# CCVector.push v 42;;
+- : unit = ()
+
+# v (* now v is a mutable vector *);;
+- : (int, CCVector.rw) CCVector.t = <abstr>
+
+# (* functional combinators! *)
+  let v2 : _ CCVector.ro_vector = v
+  |> CCVector.map (fun x-> x+1)
+  |> CCVector.filter (fun x-> x mod 2=0)
+  |> CCVector.rev ;;
+val v2 : int CCVector.ro_vector = <abstr>
+
+# Format.printf "v2 = @[%a@]@." (CCVector.pp CCInt.pp) v2;;
+v2 = 10, 8, 6, 4, 2
+- : unit = ()
+```
+
+```ocaml
+(* let's transfer to a heap *)
+module IntHeap = CCHeap.Make(struct type t = int let leq = (<=) end);;
+```
+
+```ocaml
+# let h = v2 |> CCVector.to_iter |> IntHeap.of_iter ;;
+val h : IntHeap.t = <abstr>
+
+# (* We can print the content of h
+  (printing is not necessarily in order, though) *)
+  Format.printf "h = [@[%a@]]@." (IntHeap.pp CCInt.pp) h;;
+h = [2,4,6,8,10]
+- : unit = ()
+
+# (* we can remove the first element, which also returns a new heap
+   that does not contain it — CCHeap is a functional data structure *)
+  IntHeap.take h;;
+- : (IntHeap.t * int) option = Some (<abstr>, 2)
+
+# let h', x = IntHeap.take_exn h ;;
+val h' : IntHeap.t = <abstr>
+val x : int = 2
+
+# IntHeap.to_list h' (* see, 2 is removed *);;
+- : int list = [4; 8; 10; 6]
+```
+
+### IO helpers
+
+The core library contains a module called `CCIO` that provides useful
+functions for reading and writing files. It provides functions that
+make resource handling easy, following
+the pattern `with_resource : resource -> (access -> 'a) -> 'a` where
+the type `access` is a temporary handle to the resource (e.g.,
+imagine `resource` is a file name and `access` a file descriptor).
+Calling `with_resource r f` will access `r`, give the  result to `f`,
+compute the result of `f` and, whether `f` succeeds or raises an
+error, it will free the resource.
+
+Consider for instance:
+
+```ocaml
+# CCIO.with_out "./foobar"
+    (fun out_channel ->
+      CCIO.write_lines_l out_channel ["hello"; "world"]);;
+- : unit = ()
+```
+
+This just opened the file 'foobar', creating it if it didn't exist,
+and wrote two lines in it. We did not have to close the file descriptor
+because `with_out` took care of it. By the way, the type signatures are:
+
+```ocaml non-deterministic=command
+val with_out :
+  ?mode:int -> ?flags:open_flag list ->
+  string -> (out_channel -> 'a) -> 'a
+
+val write_lines_l : out_channel -> string list -> unit
+```
+
+So we see the pattern for `with_out` (which opens a function in write
+mode and gives its functional argument the corresponding file descriptor).
+
+NOTE: you should never let the resource escape the
+scope of the `with_resource` call, because it will not be valid outside.
+OCaml's type system doesn't make it easy to forbid that so we rely
+on convention here (it would be possible, but cumbersome, using
+a record with an explicitly quantified function type).
+
+Now we can read the file again:
+
+```ocaml
+# let lines : string list = CCIO.with_in "./foobar" CCIO.read_lines_l ;;
+val lines : string list = ["hello"; "world"]
+```
+
+There are some other functions in `CCIO` that return _generators_
+instead of lists. The type of generators in containers
+is `type 'a gen = unit -> 'a option` (combinators can be
+found in the opam library called "gen"). A generator is to be called
+to obtain successive values, until it returns `None` (which means it
+has been exhausted). In particular, python users might recognize
+the function
+
+```ocaml non-deterministic=command
+# CCIO.File.walk ;;
+- : string -> walk_item gen = <fun>;;
+```
+
+where `type walk_item = [ ``Dir | ``File ] * string` is a path
+paired with a flag distinguishing files from directories.
+
+
+### To go further: `containers-data`
+
+There is also a library called `containers-data`, with lots of
+more specialized data-structures.
+The documentation contains the API for all the modules; they also provide
+interface to `iter` and, as the rest of containers, minimize
+dependencies over other modules. To use `containers-data` you need to link it,
+either in your build system or by `#require containers-data;;`
+
+A quick example based on purely functional double-ended queues:
+
+```ocaml
+# #require "containers-data";;
+# #install_printer CCFQueue.pp  (* better printing of queues! *);;
+
+# let q = CCFQueue.of_list [2;3;4] ;;
+val q : int CCFQueue.t = queue {2; 3; 4}
+
+# let q2 = q |> CCFQueue.cons 1 |> CCFQueue.cons 0 ;;
+val q2 : int CCFQueue.t = queue {0; 1; 2; 3; 4}
+
+# (* remove first element *)
+  CCFQueue.take_front q2;;
+- : (int * int CCFQueue.t) option = Some (0, queue {1; 2; 3; 4})
+
+# (* q was not changed *)
+  CCFQueue.take_front q;;
+- : (int * int CCFQueue.t) option = Some (2, queue {3; 4})
+
+# (* take works on both ends of the queue *)
+  CCFQueue.take_back_l 2 q2;;
+- : int CCFQueue.t * int list = (queue {0; 1; 2}, [3; 4])
+```
+
+### Common Type Definitions
+
+Some structural types are used throughout the library:
+
+- `gen`: `'a gen = unit -> 'a option` is an iterator type. Many combinators
+  are defined in the opam library [gen](https://github.com/c-cube/gen)
+- `iter`: `'a iter = (unit -> 'a) -> unit` is also an iterator type, formerly
+  named `sequence`.
+  It is easier to define on data structures than `gen`, but it a bit less
+  powerful. The opam library [iter](https://github.com/c-cube/iter)
+  can be used to consume and produce values of this type.
+
+  It was renamed
+  from `'a sequence` to `'a iter` to distinguish it better from `Core.Sequence`
+  and the standard `seq`.
+- `error`: `'a or_error = ('a, string) result = Error of string | Ok of 'a`
+  using the standard `result` type, supported in `CCResult`.
+- `printer`: `'a printer = Format.formatter -> 'a -> unit` is a pretty-printer
+  to be used with the standard module `Format`. In particular, in many cases,
+  `"foo: %a" Foo.print foo` will type-check.
+
+### Extended Documentation
+
+See [the extended documentation](doc/containers.md) for more examples.
+
+</details>
+
+## HOWTO (for contributors)
+
+<details>
+
+### Make a release
+
+Beforehand, check `grep deprecated -r src` to see whether some functions
+can be removed.
+
+- `make all`
+- update version in `containers.opam`
+- `make update_next_tag` (to update `@since` comments; be careful not to change symlinks)
+- check status of modules (`{b status: foo}`) and update if required;
+   removed deprecated functions, etc.
+- update `CHANGELOG.md` (see its end to find the right git command)
+- commit the changes
+- `make test doc`
+- `export VERSION=<tag here>; git tag -f $VERSION; git push origin :$VERSION; git push origin $VERSION`
+- new opam package: `opam publish https://github.com/c-cube/ocaml-containers/archive/<tag>.tar.gz`
+- re-generate doc: `make doc` and put it into `gh-pages`
+
+### List Authors
+
+```
+git log --format='%aN' | sort -u
+```
+
+</details>

_oasis

@@ -1,161 +0,0 @@
-OASISFormat: 0.4
-Name:        containers
-Version:     1.5
-Homepage:    https://github.com/c-cube/ocaml-containers
-Authors:     Simon Cruanes
-License:     BSD-2-clause
-LicenseFile: LICENSE
-Plugins:     META (0.3), DevFiles (0.3)
-OCamlVersion: >= 4.00.1
-BuildTools:  ocamlbuild
-AlphaFeatures: compiled_setup_ml, ocamlbuild_more_args
-
-# cygwin fails with anything else
-XOCamlbuildExtraArgs: "-j 1"
-
-Synopsis:    A modular standard library focused on data structures.
-Description:
-    Containers is a standard library (BSD license) focused on data structures,
-    combinators and iterators, without dependencies on unix. Every module is
-    independent and is prefixed with 'CC' in the global namespace. Some modules
-    extend the stdlib (e.g. CCList provides safe map/fold_right/append, and
-    additional functions on lists).
-
-    It also features optional libraries for dealing with strings, and
-    helpers for unix and threads.
-
-Flag "unix"
-  Description:  Build the containers.unix library (depends on Unix)
-  Default:      true
-
-Flag "thread"
-  Description:  Build modules that depend on threads
-  Default:      true
-
-Flag "bench"
-  Description:  Build and run benchmarks
-  Default:      true
-
-Library "containers"
-  Path:             src/core
-  Modules:          CCVector, CCHeap, CCList, CCOpt, CCPair,
-                    CCFun, CCHash, CCInt, CCBool, CCFloat, CCArray, CCRef, CCSet,
-                    CCOrd, CCRandom, CCString, CCHashtbl, CCMap, CCFormat, CCIO,
-                    CCInt64, CCChar, CCResult, CCParse, CCArray_slice,
-                    CCListLabels, CCArrayLabels, CCEqual,
-                    Containers
-  BuildDepends:     bytes, result
-  # BuildDepends:     bytes, bisect_ppx
-
-Library "containers_unix"
-  Path:             src/unix
-  Modules:          CCUnix
-  BuildDepends:     bytes, result, unix
-  FindlibParent:    containers
-  FindlibName:      unix
-
-Library "containers_sexp"
-  Path:             src/sexp
-  Modules:          CCSexp, CCSexp_lex
-  BuildDepends:     bytes, result
-  FindlibParent:    containers
-  FindlibName:      sexp
-
-Library "containers_data"
-  Path:             src/data
-  Modules:          CCMultiMap, CCMultiSet, CCTrie, CCFlatHashtbl, CCCache,
-                    CCPersistentHashtbl, CCDeque, CCFQueue, CCBV, CCMixtbl,
-                    CCMixmap, CCRingBuffer, CCIntMap, CCPersistentArray,
-                    CCMixset, CCGraph, CCHashSet, CCBitField,
-                    CCHashTrie, CCWBTree, CCRAL, CCSimple_queue,
-                    CCImmutArray, CCHet, CCZipper
-  BuildDepends:     bytes
-  # BuildDepends:     bytes, bisect_ppx
-  FindlibParent:    containers
-  FindlibName:      data
-
-Library "containers_iter"
-  Path:             src/iter
-  Modules:          CCKTree, CCKList, CCLazy_list
-  FindlibParent:    containers
-  FindlibName:      iter
-
-Library "containers_thread"
-  Path:             src/threads/
-  Modules:          CCPool, CCLock, CCSemaphore, CCThread, CCBlockingQueue,
-                    CCTimer
-  FindlibName:      thread
-  FindlibParent:    containers
-  Build$:           flag(thread)
-  Install$:         flag(thread)
-  BuildDepends:     containers, threads
-  XMETARequires:    containers, threads
-
-Library "containers_top"
-  Path:             src/top/
-  Modules:          Containers_top
-  FindlibName:      top
-  FindlibParent:    containers
-  BuildDepends:     compiler-libs.common, containers, containers.data,
-                    containers.unix, containers.sexp, containers.iter
-
-Document containers
-  Title:                Containers docs
-  Type:                 ocamlbuild (0.3)
-  BuildTools+:          ocamldoc
-  Build$:               flag(docs) && flag(unix)
-  Install:              true
-  XOCamlbuildPath:      .
-  XOCamlbuildExtraArgs:
-    "-docflags '-colorize-code -short-functors -charset utf-8'"
-  XOCamlbuildLibraries:
-    containers, containers.iter, containers.data,
-    containers.thread, containers.unix, containers.sexp
-
-Executable run_benchs
-  Path:             benchs/
-  Install:          false
-  CompiledObject:   best
-  Build$:           flag(bench)
-  MainIs:           run_benchs.ml
-  BuildDepends:     containers, qcheck,
-                    containers.data, containers.iter, containers.thread,
-                    sequence, gen, benchmark
-
-Executable run_bench_hash
-  Path: benchs/
-  Install: false
-  CompiledObject: best
-  Build$: flag(bench)
-  MainIs: run_bench_hash.ml
-  BuildDepends: containers
-
-PreBuildCommand: make qtest-gen
-
-Executable run_qtest
-  Path:             qtest/
-  Install:          false
-  CompiledObject:   best
-  MainIs:           run_qtest.ml
-  Build$:           flag(tests) && flag(unix)
-  BuildDepends:     containers, containers.iter,
-                    containers.sexp, containers.unix, containers.thread,
-                    containers.data,
-                    sequence, gen, unix, oUnit, qcheck
-
-Test all
-  Command:      ./run_qtest.native
-  TestTools:    run_qtest
-  Run$:         flag(tests) && flag(unix)
-
-Executable id_sexp
-  Path:             examples/
-  Install:          false
-  CompiledObject:   best
-  MainIs:           id_sexp.ml
-  BuildDepends:     containers.sexp
-
-SourceRepository head
-  Type: git
-  Location: https://github.com/c-cube/ocaml-containers
-  Browser: https://github.com/c-cube/ocaml-containers/tree/master/src

_tags

@@ -1,163 +0,0 @@
-# OASIS_START
-# DO NOT EDIT (digest: 1681c391580688c2463b8457d464cf03)
-# Ignore VCS directories, you can use the same kind of rule outside
-# OASIS_START/STOP if you want to exclude directories that contains
-# useless stuff for the build process
-true: annot, bin_annot
-<**/.svn>: -traverse
-<**/.svn>: not_hygienic
-".bzr": -traverse
-".bzr": not_hygienic
-".hg": -traverse
-".hg": not_hygienic
-".git": -traverse
-".git": not_hygienic
-"_darcs": -traverse
-"_darcs": not_hygienic
-# Library containers
-"src/core/containers.cmxs": use_containers
-<src/core/*.ml{,i,y}>: package(bytes)
-<src/core/*.ml{,i,y}>: package(result)
-# Library containers_io
-"src/io/containers_io.cmxs": use_containers_io
-<src/io/*.ml{,i,y}>: package(bytes)
-# Library containers_unix
-"src/unix/containers_unix.cmxs": use_containers_unix
-<src/unix/*.ml{,i,y}>: package(bytes)
-<src/unix/*.ml{,i,y}>: package(unix)
-# Library containers_sexp
-"src/sexp/containers_sexp.cmxs": use_containers_sexp
-<src/sexp/*.ml{,i,y}>: package(bytes)
-# Library containers_data
-"src/data/containers_data.cmxs": use_containers_data
-<src/data/*.ml{,i,y}>: package(bytes)
-# Library containers_iter
-"src/iter/containers_iter.cmxs": use_containers_iter
-# Library containers_string
-"src/string/containers_string.cmxs": use_containers_string
-<src/string/*.ml{,i,y}>: package(bytes)
-# Library containers_advanced
-"src/advanced/containers_advanced.cmxs": use_containers_advanced
-<src/advanced/*.ml{,i,y}>: package(bytes)
-<src/advanced/*.ml{,i,y}>: package(result)
-<src/advanced/*.ml{,i,y}>: package(sequence)
-<src/advanced/*.ml{,i,y}>: use_containers
-# Library containers_bigarray
-"src/bigarray/containers_bigarray.cmxs": use_containers_bigarray
-<src/bigarray/*.ml{,i,y}>: package(bigarray)
-<src/bigarray/*.ml{,i,y}>: package(bytes)
-<src/bigarray/*.ml{,i,y}>: package(result)
-<src/bigarray/*.ml{,i,y}>: use_containers
-# Library containers_thread
-"src/threads/containers_thread.cmxs": use_containers_thread
-<src/threads/*.ml{,i,y}>: package(bytes)
-<src/threads/*.ml{,i,y}>: package(result)
-<src/threads/*.ml{,i,y}>: package(threads)
-<src/threads/*.ml{,i,y}>: use_containers
-# Library containers_top
-"src/top/containers_top.cmxs": use_containers_top
-<src/top/*.ml{,i,y}>: package(bigarray)
-<src/top/*.ml{,i,y}>: package(bytes)
-<src/top/*.ml{,i,y}>: package(compiler-libs.common)
-<src/top/*.ml{,i,y}>: package(result)
-<src/top/*.ml{,i,y}>: package(unix)
-<src/top/*.ml{,i,y}>: use_containers
-<src/top/*.ml{,i,y}>: use_containers_bigarray
-<src/top/*.ml{,i,y}>: use_containers_data
-<src/top/*.ml{,i,y}>: use_containers_iter
-<src/top/*.ml{,i,y}>: use_containers_sexp
-<src/top/*.ml{,i,y}>: use_containers_string
-<src/top/*.ml{,i,y}>: use_containers_unix
-# Executable run_benchs
-<benchs/run_benchs.{native,byte}>: package(benchmark)
-<benchs/run_benchs.{native,byte}>: package(bytes)
-<benchs/run_benchs.{native,byte}>: package(gen)
-<benchs/run_benchs.{native,byte}>: package(hamt)
-<benchs/run_benchs.{native,byte}>: package(result)
-<benchs/run_benchs.{native,byte}>: package(sequence)
-<benchs/run_benchs.{native,byte}>: package(threads)
-<benchs/run_benchs.{native,byte}>: use_containers
-<benchs/run_benchs.{native,byte}>: use_containers_advanced
-<benchs/run_benchs.{native,byte}>: use_containers_data
-<benchs/run_benchs.{native,byte}>: use_containers_iter
-<benchs/run_benchs.{native,byte}>: use_containers_string
-<benchs/run_benchs.{native,byte}>: use_containers_thread
-<benchs/*.ml{,i,y}>: package(benchmark)
-<benchs/*.ml{,i,y}>: package(gen)
-<benchs/*.ml{,i,y}>: package(threads)
-<benchs/*.ml{,i,y}>: use_containers_advanced
-<benchs/*.ml{,i,y}>: use_containers_iter
-<benchs/*.ml{,i,y}>: use_containers_string
-<benchs/*.ml{,i,y}>: use_containers_thread
-# Executable run_bench_hash
-<benchs/run_bench_hash.{native,byte}>: package(bytes)
-<benchs/run_bench_hash.{native,byte}>: package(result)
-<benchs/run_bench_hash.{native,byte}>: use_containers
-# Executable run_qtest
-<qtest/run_qtest.{native,byte}>: package(QTest2Lib)
-<qtest/run_qtest.{native,byte}>: package(bigarray)
-<qtest/run_qtest.{native,byte}>: package(bytes)
-<qtest/run_qtest.{native,byte}>: package(gen)
-<qtest/run_qtest.{native,byte}>: package(oUnit)
-<qtest/run_qtest.{native,byte}>: package(result)
-<qtest/run_qtest.{native,byte}>: package(sequence)
-<qtest/run_qtest.{native,byte}>: package(threads)
-<qtest/run_qtest.{native,byte}>: package(unix)
-<qtest/run_qtest.{native,byte}>: use_containers
-<qtest/run_qtest.{native,byte}>: use_containers_advanced
-<qtest/run_qtest.{native,byte}>: use_containers_bigarray
-<qtest/run_qtest.{native,byte}>: use_containers_data
-<qtest/run_qtest.{native,byte}>: use_containers_io
-<qtest/run_qtest.{native,byte}>: use_containers_iter
-<qtest/run_qtest.{native,byte}>: use_containers_sexp
-<qtest/run_qtest.{native,byte}>: use_containers_string
-<qtest/run_qtest.{native,byte}>: use_containers_thread
-<qtest/run_qtest.{native,byte}>: use_containers_unix
-<qtest/*.ml{,i,y}>: package(QTest2Lib)
-<qtest/*.ml{,i,y}>: package(bigarray)
-<qtest/*.ml{,i,y}>: package(bytes)
-<qtest/*.ml{,i,y}>: package(gen)
-<qtest/*.ml{,i,y}>: package(oUnit)
-<qtest/*.ml{,i,y}>: package(result)
-<qtest/*.ml{,i,y}>: package(sequence)
-<qtest/*.ml{,i,y}>: package(threads)
-<qtest/*.ml{,i,y}>: package(unix)
-<qtest/*.ml{,i,y}>: use_containers
-<qtest/*.ml{,i,y}>: use_containers_advanced
-<qtest/*.ml{,i,y}>: use_containers_bigarray
-<qtest/*.ml{,i,y}>: use_containers_data
-<qtest/*.ml{,i,y}>: use_containers_io
-<qtest/*.ml{,i,y}>: use_containers_iter
-<qtest/*.ml{,i,y}>: use_containers_sexp
-<qtest/*.ml{,i,y}>: use_containers_string
-<qtest/*.ml{,i,y}>: use_containers_thread
-<qtest/*.ml{,i,y}>: use_containers_unix
-# Executable mem_measure
-"benchs/mem_measure.native": package(bytes)
-"benchs/mem_measure.native": package(hamt)
-"benchs/mem_measure.native": package(result)
-"benchs/mem_measure.native": package(sequence)
-"benchs/mem_measure.native": package(unix)
-"benchs/mem_measure.native": use_containers
-"benchs/mem_measure.native": use_containers_data
-<benchs/*.ml{,i,y}>: package(bytes)
-<benchs/*.ml{,i,y}>: package(hamt)
-<benchs/*.ml{,i,y}>: package(result)
-<benchs/*.ml{,i,y}>: package(sequence)
-<benchs/*.ml{,i,y}>: package(unix)
-<benchs/*.ml{,i,y}>: use_containers
-<benchs/*.ml{,i,y}>: use_containers_data
-# Executable id_sexp
-<examples/id_sexp.{native,byte}>: package(bytes)
-<examples/id_sexp.{native,byte}>: use_containers_sexp
-<examples/*.ml{,i,y}>: package(bytes)
-<examples/*.ml{,i,y}>: use_containers_sexp
-# OASIS_STOP
-<tests/*.ml{,i}>: thread
-<src/threads/*.ml{,i}>: thread
-<src/core/CCVector.cmx> or <src/core/CCString.cmx>: inline(25)
-<src/data/CCFlatHashtbl.cm*> or <src/data/CCHashTrie.cm*> or <src/data/CCPersistent*>: inline(15)
-<src/core/CCMap.*> or <src/core/CCSet.*> or <src/core/CCList.*>: warn(-32)
-<src/**/*.ml> and not <src/misc/*.ml>: warn(+a-4-44-58-60@8)
-true: no_alias_deps, safe_string, short_paths, color(always)
-<src/**/*Labels.cm*>: nolabels

benchs/dune

@@ -0,0 +1,24 @@
+(executables
+ (names run_benchs run_bench_hash run_objsize)
+ (libraries
+  containers
+  containers_pvec
+  containers-data
+  benchmark
+  gen
+  iter
+  qcheck
+  oseq
+  batteries
+  base
+  sek)
+ (flags :standard -warn-error -3-5 -w -60 -safe-string -color always)
+ (optional)
+ (ocamlopt_flags
+  :standard
+  -O3
+  -color
+  always
+  -unbox-closures
+  -unbox-closures-factor
+  20))

benchs/objsize.ml

@@ -22,50 +22,52 @@ open Obj
 (*s Pointers already visited are stored in a hash-table, where
     comparisons are done using physical equality. *)
 
-module H = Hashtbl.Make(
+module H = Hashtbl.Make (struct
-  struct 
+  type t = Obj.t
-    type t = Obj.t 
+
-    let equal = (==) 
+  let equal = ( == )
-    let hash o = Hashtbl.hash (magic o : int)
+  let hash o = Hashtbl.hash (magic o : int)
-  end)
+end)
-	     
+
 let node_table = (H.create 257 : unit H.t)
 
-let in_table o = try H.find node_table o; true with Not_found -> false
+let in_table o =
+  try
+    H.find node_table o;
+    true
+  with Not_found -> false
 
 let add_in_table o = H.add node_table o ()
-
 let reset_table () = H.clear node_table
 
 (*s Objects are traversed recursively, as soon as their tags are less than
     [no_scan_tag]. [count] records the numbers of words already visited. *)
 
 let size_of_double = size (repr 1.0)
-
 let count = ref 0
 
 let rec traverse t =
-  if not (in_table t) then begin
+  if not (in_table t) then (
     add_in_table t;
-    if is_block t then begin
+    if is_block t then (
       let n = size t in
       let tag = tag t in
-      if tag < no_scan_tag then begin
+      if tag < no_scan_tag then (
-	count := !count + 1 + n;
+        count := !count + 1 + n;
-	for i = 0 to n - 1 do
+        for i = 0 to n - 1 do
-      	  let f = field t i in 
+          let f = field t i in
-	  if is_block f then traverse f
+          if is_block f then traverse f
-	done
+        done
-      end else if tag = string_tag then
+      ) else if tag = string_tag then
-	count := !count + 1 + n 
+        count := !count + 1 + n
       else if tag = double_tag then
-	count := !count + size_of_double
+        count := !count + size_of_double
       else if tag = double_array_tag then
-	count := !count + 1 + size_of_double * n 
+        count := !count + 1 + (size_of_double * n)
       else
-	incr count
+        incr count
-    end
+    )
-  end
+  )
 
 (*s Sizes of objects in words and in bytes. The size in bytes is computed
     system-independently according to [Sys.word_size]. *)
@@ -76,8 +78,5 @@ let size_w o =
   traverse (repr o);
   !count
 
-let size_b o = (size_w o) * (Sys.word_size / 8)
+let size_b o = size_w o * (Sys.word_size / 8)
-
+let size_kb o = size_w o / (8192 / Sys.word_size)
-let size_kb o = (size_w o) / (8192 / Sys.word_size)
-
-

benchs/ref_impl.ml

@@ -1,58 +1,55 @@
-
 (* reference implementations for some structures, for comparison purpose *)
 
-module PersistentHashtbl(H : Hashtbl.HashedType) = struct
+module PersistentHashtbl (H : Hashtbl.HashedType) = struct
-  module Table = Hashtbl.Make(H)
+  module Table = Hashtbl.Make (H)
-    (** Imperative hashtable *)
+  (** Imperative hashtable *)
 
   type key = H.t
+
   type 'a t = 'a zipper ref
+
   and 'a zipper =
-    | Table of 'a Table.t         (** Concrete table *)
+    | Table of 'a Table.t  (** Concrete table *)
-    | Add of key * 'a * 'a t      (** Add key *)
+    | Add of key * 'a * 'a t  (** Add key *)
     | Replace of key * 'a * 'a t  (** Replace key by value *)
-    | Remove of key * 'a t        (** As the table, but without given key *)
+    | Remove of key * 'a t  (** As the table, but without given key *)
-
-  let create i =
-    ref (Table (Table.create i))
 
+  let create i = ref (Table (Table.create i))
   let empty () = create 11
 
   (* pass continuation to get a tailrec rerooting *)
-  let rec _reroot t k = match !t with
+  let rec _reroot t k =
-  | Table tbl -> k tbl  (* done *)
+    match !t with
-  | Add (key, v, t') ->
+    | Table tbl -> k tbl (* done *)
-    _reroot t'
+    | Add (key, v, t') ->
-      (fun tbl ->
+      _reroot t' (fun tbl ->
-        t' := Remove (key, t);
+          t' := Remove (key, t);
-        Table.add tbl key v;
+          Table.add tbl key v;
-        t := Table tbl;
+          t := Table tbl;
-        k tbl)
+          k tbl)
-  | Replace (key, v, t') ->
+    | Replace (key, v, t') ->
-    _reroot t'
+      _reroot t' (fun tbl ->
-      (fun tbl ->
+          let v' = Table.find tbl key in
-        let v' = Table.find tbl key in
+          t' := Replace (key, v', t);
-        t' := Replace (key, v', t);
+          t := Table tbl;
-        t := Table tbl;
+          Table.replace tbl key v;
-        Table.replace tbl key v;
+          k tbl)
-        k tbl)
+    | Remove (key, t') ->
-  | Remove (key, t') ->
+      _reroot t' (fun tbl ->
-    _reroot t'
+          let v = Table.find tbl key in
-      (fun tbl ->
+          t' := Add (key, v, t);
-        let v = Table.find tbl key in
+          t := Table tbl;
-        t' := Add (key, v, t);
+          Table.remove tbl key;
-        t := Table tbl;
+          k tbl)
-        Table.remove tbl key;
-        k tbl)
 
   (* Reroot: modify the zipper so that the current node is a proper
      hashtable, and return the hashtable *)
-  let reroot t = match !t with
+  let reroot t =
+    match !t with
     | Table tbl -> tbl
     | _ -> _reroot t (fun x -> x)
 
   let is_empty t = Table.length (reroot t) = 0
-
   let find t k = Table.find (reroot t) k
 
   (*$R
@@ -91,13 +88,8 @@ module PersistentHashtbl(H : Hashtbl.HashedType) = struct
   *)
 
   let get_exn k t = find t k
-
+  let get k t = try Some (find t k) with Not_found -> None
-  let get k t =
-    try Some (find t k)
-    with Not_found -> None
-
   let mem t k = Table.mem (reroot t) k
-
   let length t = Table.length (reroot t)
 
   (*$R
@@ -120,11 +112,9 @@ module PersistentHashtbl(H : Hashtbl.HashedType) = struct
     let t' = ref (Table tbl) in
     (* update [t] to point to the new hashtable *)
     (try
-      let v' = Table.find tbl k in
+       let v' = Table.find tbl k in
-      t := Replace (k, v', t')
+       t := Replace (k, v', t')
-    with Not_found ->
+     with Not_found -> t := Remove (k, t'));
-      t := Remove (k, t')
-    );
     (* modify the underlying hashtable *)
     Table.replace tbl k v;
     t'
@@ -170,12 +160,12 @@ module PersistentHashtbl(H : Hashtbl.HashedType) = struct
       let h = H.of_list l in
       let h = List.fold_left (fun h (k,_) -> H.remove h k) h l in
       H.is_empty h)
-    *)
+  *)
 
   let update t k f =
     let v = get k t in
     match v, f v with
-    | None, None -> t  (* no change *)
+    | None, None -> t (* no change *)
     | Some _, None -> remove t k
     | _, Some v' -> replace t k v'
 
@@ -209,10 +199,11 @@ module PersistentHashtbl(H : Hashtbl.HashedType) = struct
     let tbl = reroot t in
     let res = Table.create (Table.length tbl) in
     Table.iter
-      (fun k v -> match f k v with
+      (fun k v ->
+        match f k v with
         | None -> ()
-        | Some v' -> Table.replace res k v'
+        | Some v' -> Table.replace res k v')
-      ) tbl;
+      tbl;
     ref (Table res)
 
   exception ExitPTbl
@@ -231,17 +222,17 @@ module PersistentHashtbl(H : Hashtbl.HashedType) = struct
 
   let merge f t1 t2 =
     let tbl = Table.create (max (length t1) (length t2)) in
-    iter t1
+    iter t1 (fun k v1 ->
-      (fun k v1 ->
         let v2 = try Some (find t2 k) with Not_found -> None in
         match f k (Some v1) v2 with
         | None -> ()
         | Some v' -> Table.replace tbl k v');
-    iter t2
+    iter t2 (fun k v2 ->
-      (fun k v2 ->
+        if not (mem t1 k) then (
-        if not (mem t1 k) then match f k None (Some v2) with
+          match f k None (Some v2) with
           | None -> ()
-          | Some _ -> Table.replace tbl k v2);
+          | Some _ -> Table.replace tbl k v2
+        ));
     ref (Table tbl)
 
   (*$R
@@ -262,13 +253,11 @@ module PersistentHashtbl(H : Hashtbl.HashedType) = struct
 
   let add_seq init seq =
     let tbl = ref init in
-    seq (fun (k,v) -> tbl := replace !tbl k v);
+    seq (fun (k, v) -> tbl := replace !tbl k v);
     !tbl
 
   let of_seq seq = add_seq (empty ()) seq
-
+  let add_list init l = add_seq init (fun k -> List.iter k l)
-  let add_list init l =
-    add_seq init (fun k -> List.iter k l)
 
   (*$QR
     _list_int_int (fun l ->
@@ -293,7 +282,7 @@ module PersistentHashtbl(H : Hashtbl.HashedType) = struct
 
   let to_list t =
     let tbl = reroot t in
-    let bindings = Table.fold (fun k v acc -> (k,v)::acc) tbl [] in
+    let bindings = Table.fold (fun k v acc -> (k, v) :: acc) tbl [] in
     bindings
 
   (*$R
@@ -302,10 +291,9 @@ module PersistentHashtbl(H : Hashtbl.HashedType) = struct
     OUnit.assert_equal my_list (List.sort compare l)
   *)
 
-  let to_seq t =
+  let to_seq t k =
-    fun k ->
+    let tbl = reroot t in
-      let tbl = reroot t in
+    Table.iter (fun x y -> k (x, y)) tbl
-      Table.iter (fun x y -> k (x,y)) tbl
 
   (*$R
     let h = H.of_seq my_seq in
@@ -316,31 +304,34 @@ module PersistentHashtbl(H : Hashtbl.HashedType) = struct
 
   let equal eq t1 t2 =
     length t1 = length t2
-    &&
+    && for_all
-    for_all
+         (fun k v ->
-      (fun k v -> match get k t2 with
+           match get k t2 with
-        | None -> false
+           | None -> false
-        | Some v' -> eq v v'
+           | Some v' -> eq v v')
-      ) t1
+         t1
 
   let pp pp_k pp_v buf t =
     Buffer.add_string buf "{";
     let first = ref true in
-    iter t
+    iter t (fun k v ->
-      (fun k v ->
+        if !first then
-        if !first then first:=false else Buffer.add_string buf ", ";
+          first := false
-        Printf.bprintf buf "%a -> %a" pp_k k pp_v v
+        else
-      );
+          Buffer.add_string buf ", ";
+        Printf.bprintf buf "%a -> %a" pp_k k pp_v v);
     Buffer.add_string buf "}"
 
   let print pp_k pp_v fmt t =
     Format.pp_print_string fmt "{";
     let first = ref true in
-    iter t
+    iter t (fun k v ->
-      (fun k v ->
+        if !first then
-        if !first then first:=false
+          first := false
-        else (Format.pp_print_string fmt ", "; Format.pp_print_cut fmt ());
+        else (
-        Format.fprintf fmt "%a -> %a" pp_k k pp_v v
+          Format.pp_print_string fmt ", ";
-      );
+          Format.pp_print_cut fmt ()
+        );
+        Format.fprintf fmt "%a -> %a" pp_k k pp_v v);
     Format.pp_print_string fmt "}"
 end

benchs/run_bench_hash.ml

@@ -4,46 +4,39 @@ type tree =
   | Empty
   | Node of int * tree list
 
-let mk_node i l = Node (i,l)
+let mk_node i l = Node (i, l)
 
 let random_tree =
-  CCRandom.(fix
-    ~base:(return Empty)
-    ~subn:[int 10, (fun sublist -> pure mk_node <*> small_int <*> sublist)]
-    (int_range 15 150)
-  )
-
-let random_list =
   CCRandom.(
-    int 5 >>= fun len ->
+    fix ~base:(return Empty)
-    CCList.random_len len random_tree
+      ~subn:[ (int 10, fun sublist -> pure mk_node <*> small_int <*> sublist) ]
-  )
+      (int_range 15 150))
 
-let rec eq t1 t2 = match t1, t2 with
+let rec eq t1 t2 =
+  match t1, t2 with
   | Empty, Empty -> true
-  | Node(i1,l1), Node (i2,l2) -> i1=i2 && CCList.equal eq l1 l2
+  | Node (i1, l1), Node (i2, l2) -> i1 = i2 && CCList.equal eq l1 l2
-  | Node _, _
+  | Node _, _ | _, Node _ -> false
-  | _, Node _ -> false
 
-let rec hash_tree t = match t with
+let rec hash_tree t =
+  match t with
   | Empty -> CCHash.string "empty"
-  | Node (i, l) ->
+  | Node (i, l) -> CCHash.(combine2 (int i) (list hash_tree l))
-    CCHash.(combine2 (int i) (list hash_tree l))
 
-module H = Hashtbl.Make(struct
+module H = Hashtbl.Make (struct
   type t = tree
+
   let equal = eq
   let hash = hash_tree
 end)
 
 let print_hashcons_stats st =
   let open Hashtbl in
-    Format.printf
+  Format.printf "tbl stats: %d elements, num buckets: %d, max bucket: %d@."
-      "tbl stats: %d elements, num buckets: %d, max bucket: %d@."
+    st.num_bindings st.num_buckets st.max_bucket_length;
-      st.num_bindings st.num_buckets st.max_bucket_length;
+  Array.iteri
-    Array.iteri
+    (fun i n -> Format.printf "  %d\t buckets have length %d@." n i)
-      (fun i n -> Format.printf "  %d\t buckets have length %d@." n i)
+    st.bucket_histogram
-      st.bucket_histogram
 
 let () =
   let st = Random.State.make_self_init () in
@@ -61,4 +54,3 @@ let () =
   List.iter (fun t -> Hashtbl.replace tbl' t ()) l;
   print_hashcons_stats (Hashtbl.stats tbl');
   ()
-

benchs/run_benchs.sh

@@ -0,0 +1,3 @@
+#!/bin/sh
+
+exec dune exec --profile=release benchs/run_benchs.exe -- $@

benchs/run_objsize.ml

@@ -0,0 +1,94 @@
+(* module Deque = Core_kernel.Deque *)
+module Int_map = CCMap.Make (CCInt)
+module Int_set = CCSet.Make (CCInt)
+
+let dup = CCPair.dup
+let id = CCFun.id
+let ns n = List.init n CCFun.id
+let iter_range n f = List.iter f (ns n)
+
+let gen_cons x xs =
+  let saw_x = ref false in
+  fun () ->
+    if !saw_x then (
+      saw_x := true;
+      Some x
+    ) else
+      xs ()
+
+let front = Sek.front
+let dummy = 0
+
+let types =
+  [
+    ("Stdlib.List", fun n -> Obj.magic @@ ns n);
+    ("Stdlib.Array", fun n -> Obj.magic @@ Array.init n id);
+    ( "Stdlib.Hashtbl",
+      fun n -> Obj.magic @@ CCHashtbl.of_iter Iter.(init dup |> take n) );
+    ( "Base.Hashtbl",
+      fun n -> Obj.magic @@ Base.Hashtbl.Poly.of_alist_exn (List.init n dup) );
+    ( "Stdlib.Map",
+      fun n -> Obj.magic @@ Int_map.of_iter Iter.(init dup |> take n) );
+    ( "Stdlib.Set",
+      fun n -> Obj.magic @@ Int_set.of_iter Iter.(init id |> take n) );
+    ("CCFun_vec", fun n -> Obj.magic @@ CCFun_vec.of_list (ns n));
+    ("CCRAL", fun n -> Obj.magic @@ CCRAL.of_list (ns n));
+    ("BatVect", fun n -> Obj.magic @@ BatVect.of_list (ns n));
+    ( "Sek.Persistent",
+      fun n ->
+        Obj.magic
+        @@ List.fold_left
+             (Sek.Persistent.push front)
+             (Sek.Persistent.create dummy)
+             (ns n) );
+    ( "Sek.Ephemeral",
+      fun n ->
+        Obj.magic
+        @@
+        let c = Sek.Ephemeral.create dummy in
+        iter_range n (Sek.Ephemeral.push front c);
+        c );
+    ( "CCVector",
+      fun n ->
+        Obj.magic
+        @@
+        let c = CCVector.create () in
+        iter_range n (CCVector.push c);
+        c );
+    (* "Core_kernel.Deque", (fun n -> Obj.magic @@ let c = Deque.create () in iter_range n (Deque.enqueue_back c); c); *)
+    ( "Base.Queue",
+      fun n ->
+        Obj.magic
+        @@
+        let c = Base.Queue.create () in
+        iter_range n (Base.Queue.enqueue c);
+        c );
+    ( "Stdlib.Queue",
+      fun n ->
+        Obj.magic
+        @@
+        let q = Queue.create () in
+        iter_range n (fun x -> Queue.push x q);
+        q );
+    ("CCQueue", fun n -> Obj.magic @@ CCDeque.of_list (ns n));
+    ("Iter", fun n -> Obj.magic @@ List.fold_right Iter.cons (ns n) Iter.empty);
+    ("Gen", fun n -> Obj.magic @@ List.fold_right gen_cons (ns n) Gen.empty);
+    ( "Stdlib.Seq",
+      fun n -> Obj.magic @@ List.fold_right OSeq.cons (ns n) OSeq.empty );
+  ]
+
+let () =
+  let sizes = [ 0; 1; 10; 100; 1000; 10000 ] in
+  Printf.printf "%-20s  " "";
+  sizes |> List.iter (fun n -> Printf.printf "%6d " n);
+  Printf.printf "\n";
+  types
+  |> List.iter (fun (name, create) ->
+         Printf.printf "%-20s: " name;
+         sizes
+         |> List.iter (fun n ->
+                let obj = create n in
+                let size = Objsize.size_w obj in
+                (* let size = Obj.reachable_words (Obj.repr obj) in *)
+                Printf.printf "%6d " size);
+         Printf.printf "\n")

configure

@@ -1,31 +0,0 @@
-#!/bin/sh
-
-# OASIS_START
-# DO NOT EDIT (digest: 7577949ceda6f9dbd4983aea8db9275b)
-set -e
-
-FST=true
-for i in "$@"; do
-  if $FST; then
-    set --
-    FST=false
-  fi
-
-  case $i in
-    --*=*)
-      ARG=${i%%=*}
-      VAL=${i##*=}
-      set -- "$@" "$ARG" "$VAL"
-      ;;
-    *)
-      set -- "$@" "$i"
-      ;;
-  esac
-done
-
-if [ ! -e setup.exe ] || [ _oasis -nt setup.exe ] || [ setup.ml -nt setup.exe ] || [ configure -nt setup.exe ]; then
-  ocamlfind ocamlopt -o setup.exe -linkpkg -package oasis.dynrun setup.ml || ocamlfind ocamlc -o setup.exe -linkpkg -package oasis.dynrun setup.ml || exit 1
-  rm -f setup.cmi setup.cmo setup.cmx setup.o
-fi
-./setup.exe -configure "$@"
-# OASIS_STOP

containers-data.opam

@@ -0,0 +1,26 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+version: "3.17"
+synopsis: "A set of advanced datatypes for containers"
+maintainer: ["c-cube"]
+authors: ["c-cube"]
+license: "BSD-2-Clause"
+tags: ["containers" "RAL" "function" "vector" "okasaki"]
+homepage: "https://github.com/c-cube/ocaml-containers/"
+bug-reports: "https://github.com/c-cube/ocaml-containers/issues"
+depends: [
+  "dune" {>= "3.0"}
+  "ocaml" {>= "4.08"}
+  "containers" {= version}
+  "qcheck-core" {>= "0.18" & with-test}
+  "iter" {with-test}
+  "gen" {with-test}
+  "mdx" {with-test}
+  "odoc" {with-doc}
+]
+dev-repo: "git+https://github.com/c-cube/ocaml-containers.git"
+build: [
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "build" "@doc" "-p" name ] {with-doc}
+  ["dune" "runtest" "-p" name "-j" jobs] {with-test & arch != "x86_32" & arch != "arm32"}
+]

containers-data.opam.template

@@ -0,0 +1,5 @@
+build: [
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "build" "@doc" "-p" name ] {with-doc}
+  ["dune" "runtest" "-p" name "-j" jobs] {with-test & arch != "x86_32" & arch != "arm32"}
+]

containers.opam

@@ -0,0 +1,31 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+version: "3.17"
+synopsis:
+  "A modular, clean and powerful extension of the OCaml standard library"
+maintainer: ["c-cube"]
+authors: ["c-cube"]
+license: "BSD-2-Clause"
+tags: ["stdlib" "containers" "iterators" "list" "heap" "queue"]
+homepage: "https://github.com/c-cube/ocaml-containers/"
+bug-reports: "https://github.com/c-cube/ocaml-containers/issues"
+depends: [
+  "dune" {>= "3.0"}
+  "ocaml" {>= "4.08"}
+  "either"
+  "dune-configurator"
+  "qcheck-core" {>= "0.18" & with-test}
+  "yojson" {with-test}
+  "iter" {with-test}
+  "gen" {with-test}
+  "csexp" {with-test}
+  "uutf" {with-test}
+  "odoc" {with-doc}
+]
+depopts: ["base-unix" "base-threads"]
+dev-repo: "git+https://github.com/c-cube/ocaml-containers.git"
+build: [
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "build" "@doc" "-p" name ] {with-doc}
+  ["dune" "runtest" "-p" name "-j" jobs] {with-test & arch != "x86_32" & arch != "arm32"}
+]

containers.opam.template

@@ -0,0 +1,5 @@
+build: [
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "build" "@doc" "-p" name ] {with-doc}
+  ["dune" "runtest" "-p" name "-j" jobs] {with-test & arch != "x86_32" & arch != "arm32"}
+]

doc/build_deps.ml

@@ -1,32 +0,0 @@
-#!/usr/bin/env ocaml
-
-(* note: this requires to generate documentation first, so that
-   .odoc files are generated *)
-
-#use "topfind";;
-#require "containers";;
-#require "containers.io";;
-#require "gen";;
-#require "unix";;
-
-let odoc_files =
-  CCIO.File.walk "_build"
-  |> Gen.filter_map
-    (function
-      | `File, f when CCString.suffix ~suf:".odoc" f -> Some f
-      | _ -> None
-    )
-  |> Gen.flat_map
-    (fun f -> Gen.of_list ["-load"; f])
-  |> Gen.to_list
-;;
-
-let out = "deps.dot";;
-
-let cmd =
-  "ocamldoc -dot -o " ^ out ^ " " ^ String.concat " " odoc_files
-;;
-
-print_endline ("run: " ^ cmd);;
-Unix.system cmd;;
-print_endline ("output in " ^ out);;

doc/containers.md

@@ -1,12 +1,12 @@
-= OCaml-containers =
+# More about OCaml-containers
-:toc: macro
-:source-highlighter: pygments
 
 This document contains more information on some modules of Containers.
 
-toc::[]
+```ocaml
+# #require "containers";;
+```
 
-== Hash combinators: `CCHash`
+## Hash combinators: `CCHash`
 
 Although OCaml provides polymorphic hash tables (`('a,'b) Hashtbl.t`)
 using the polymorphic equality `(=)` and hash `Hashtbl.hash`, it is often
@@ -15,63 +15,67 @@ with custom equality and hash functions.
 
 `CCHash` provides combinators for writing hash functions:
 
-[source,OCaml]
+```ocaml
-----
 # module H = CCHash;;
+module H = CCHash
 
 # let hash1 : (int * bool) list H.t = H.(list (pair int bool));;
+val hash1 : (int * bool) list H.t = <fun>
+```
 
+```ocaml non-deterministic=output
 # hash1 [1, true; 2, false; 3, true];;
 - : int = 636041136
-
-(* the function hashes the whole value, can be costly *)
 # hash1 CCList.(1 -- 1000 |> map (fun i->i, i mod 2 = 0));;
 - : int = 845685523
 # hash1 CCList.(1 -- 1001 |> map (fun i->i, i mod 2 = 0));;
 - : int = 381026697
-----
+```
 
 The polymorphic hash function is still present, as `CCHash.poly`.
 The functions `CCHash.list_comm` and `CCHash.array_comm` allow to hash
 lists and arrays while ignoring the order of elements: all permutations
 of the input will have the same hash.
 
-
+## Parser Combinator: `CCParse`
-
-== Parser Combinator: `CCParse`
-:toc: macro
-:source-highlighter: pygments
 
 The module `CCParse` defines basic parser combinators on strings.
-Adapting https://github.com/inhabitedtype/angstrom#usage[angstrom's tutorial example] gives the following snippet.
+Adapting [angstrom's tutorial example](https://github.com/inhabitedtype/angstrom#usage)
+gives the following snippet.
 Note that backtracking is explicit in `CCParse`, hence
 the use of `try_` to allow it in some places.
 Explicit memoization with `memo` and `fix_memo` is also possible.
 
-[source,OCaml]
+```ocaml
-----
+open CCParse.Infix
-open CCParse.Infix;;
+module P = CCParse
-module P = CCParse;;
 
-let parens p = P.try_ (P.char '(') *> p <* P.char ')' ;;
+let parens p = P.try_ (P.char '(') *> p <* P.char ')'
-let add = P.char '+' *> P.return (+) ;;
+let add = P.char '+' *> P.return (+)
-let sub = P.char '-' *> P.return (-) ;;
+let sub = P.char '-' *> P.return (-)
-let mul = P.char '*' *> P.return ( * ) ;;
+let mul = P.char '*' *> P.return ( * )
-let div = P.char '/' *> P.return ( / ) ;;
+let div = P.char '/' *> P.return ( / )
 let integer =
-  P.chars1_if (function '0'..'9'->true|_->false) >|= int_of_string ;;
+  P.chars1_if (function '0'..'9'->true|_->false) >|= int_of_string
 
 let chainl1 e op =
   P.fix (fun r ->
-    e >>= fun x -> P.try_ (op <*> P.return x <*> r) <|> P.return x) ;;
+    e >>= fun x -> P.try_ (op <*> P.return x <*> r) <|> P.return x)
 
 let expr : int P.t =
   P.fix (fun expr ->
     let factor = parens expr <|> integer in
     let term = chainl1 factor (mul <|> div) in
-    chainl1 term (add <|> sub)) ;;
+    chainl1 term (add <|> sub))
+```
 
-P.parse_string expr "4*1+2";; (* Ok 6 *)
+Now we can parse strings using `expr`:
-P.parse_string expr "4*(1+2)";; (* Ok 12 *)
+
+```ocaml
+# P.parse_string expr "4*1+2";; (* Ok 6 *)
+- : int P.or_error = Result.Ok 6
+
+# P.parse_string expr "4*(1+2)";; (* Ok 12 *)
+- : int P.or_error = Result.Ok 12
+```
 
-----

doc/intro.txt

@@ -1,166 +0,0 @@
-{1 Containers}
-
-{2 Change Log}
-
-See {{: https://github.com/c-cube/ocaml-containers/blob/master/CHANGELOG.adoc } this file}
-
-{2 License}
-
-This code is free, under the BSD license.
-
-The logo (media/logo.png) is
-CC-SA3 {{:http://en.wikipedia.org/wiki/File:Hypercube.svg} wikimedia}
-
-{2 Contents}
-
-The design is mostly centered around polymorphism rather than functors. Such
-structures comprise (some modules in misc/, some other in core/):
-
-the core library, containers, now depends on base-bytes (provided
-by ocamlfind).
-
-{4 Core Modules (extension of the standard library)}
-
-{b findlib name}: containers
-
-{!modules:
-CCArray
-CCArrayLabels
-CCArray_slice
-CCBool
-CCChar
-CCEqual
-CCFloat
-CCFormat
-CCFun
-CCHash
-CCHashtbl
-CCHeap
-CCIO
-CCInt
-CCInt64
-CCList
-CCListLabels
-CCMap
-CCOpt
-CCOrd
-CCPair
-CCParse
-CCRandom
-CCRef
-CCResult
-CCSet
-CCString
-CCVector
-Containers
-}
-
-The module {!Containers} contains aliases to most other modules defined
-in {i containers core}, and mixins
-such as:
-
-{[ module List = struct
-    include List
-    include CCList
-  end
-]}
-
-{4 Containers.data}
-
-{b findlib name}: containers.data
-
-Various data structures.
-
-{!modules:
-CCBitField
-CCBV
-CCCache
-CCDeque
-CCFQueue
-CCFlatHashtbl
-CCGraph
-CCHashSet
-CCHashTrie
-CCHet
-CCImmutArray
-CCIntMap
-CCMixmap
-CCMixset
-CCMixtbl
-CCMultiMap
-CCMultiSet
-CCPersistentArray
-CCPersistentHashtbl
-CCRAL
-CCRingBuffer
-CCSimple_queue
-CCTrie
-CCWBTree
-}
-
-{4 Containers.unix}
-
-Helpers that depend on {!Unix}, e.g. to spawn sub-processes.
-
-{!modules: CCUnix}
-
-{4 Containers.sexp}
-
-A small S-expression library. The interface is relatively unstable, but
-the main type ([CCSexp.t]) isn't.
-
-{!modules:
-CCSexp
-}
-
-{4 Containers.iter}
-
-Iterators:
-
-{!modules:
-CCKList
-CCKTree
-CCLazy_list}
-
-{4 String}
-
-containers.string has been removed. Some of its functionality is present
-in {!CCString}; some in other libraries such as [Spelll].
-
-{4 Bigarrays}
-
-containers.bigarray has been removed. Use the [Bigstring] library for
-arrays of bytes.
-
-{4 Advanced}
-
-containers.advanced has been removed. Use [OLinq] to replace some of its
-functionality.
-
-{4 Misc}
-
-Moved to its own repository.
-
-{4 Lwt}
-
-Moved to its own repository
-
-{4 Thread Helpers}
-
-{b findlib name}: containers.thread
-
-Modules related to the use of [Thread].
-
-{!modules:
-CCBlockingQueue
-CCLock
-CCPool
-CCSemaphore
-CCThread
-CCTimer
-}
-
-
-{2 Index}
-
-{!indexlist}

dune

@@ -0,0 +1,41 @@
+(rule
+ (targets README.md.corrected)
+ (deps
+  (package containers-data)
+  ./src/mdx_runner.exe)
+ (enabled_if
+  (= %{system} "linux"))
+ (action
+  (run ./src/mdx_runner.exe)))
+
+(rule
+ (alias runtest)
+ (package containers-data)
+ (enabled_if
+  (= %{system} "linux"))
+ (locks /ctest)
+ (action
+  (diff README.md README.md.corrected)))
+
+(env
+ (_
+  (flags
+   :standard
+   -warn-error
+   -a+8
+   -w
+   -32-48-60-70
+   -w
+   +a-4-40-42-44-70
+   -color
+   always
+   -safe-string
+   -strict-sequence)
+  (ocamlopt_flags
+   :standard
+   -O3
+   -unbox-closures
+   -unbox-closures-factor
+   20
+   -inline
+   100)))

dune-project

@@ -0,0 +1,60 @@
+(lang dune 3.0)
+
+(name containers)
+
+(generate_opam_files true)
+
+(version 3.17)
+
+(authors c-cube)
+
+(maintainers c-cube)
+
+(license BSD-2-Clause)
+
+(homepage "https://github.com/c-cube/ocaml-containers/")
+
+(source
+ (github c-cube/ocaml-containers))
+
+(package
+ (name containers)
+ (synopsis
+  "A modular, clean and powerful extension of the OCaml standard library")
+ (tags
+  (stdlib containers iterators list heap queue))
+ (depends
+  (ocaml
+   (>= 4.08))
+  either
+  dune-configurator
+  (qcheck-core
+   (and
+    (>= 0.18)
+    :with-test))
+  (yojson :with-test)
+  (iter :with-test)
+  (gen :with-test)
+  (csexp :with-test)
+  (uutf :with-test)
+  (odoc :with-doc))
+ (depopts base-unix base-threads))
+
+(package
+ (name containers-data)
+ (synopsis "A set of advanced datatypes for containers")
+ (tags
+  (containers RAL function vector okasaki))
+ (depends
+  (ocaml
+   (>= 4.08))
+  (containers
+   (= :version))
+  (qcheck-core
+   (and
+    (>= 0.18)
+    :with-test))
+  (iter :with-test)
+  (gen :with-test)
+  (mdx :with-test)
+  (odoc :with-doc)))

examples/bencode_write.ml

@@ -1,22 +0,0 @@
-
-(** Write 10_000 Bencode values on the given file *)
-
-(* write n times the same value in the file *)
-let write_values file n =
-  let out = BencodeOnDisk.open_out file in
-  Printf.printf "[%d] opened file\n" (Unix.getpid ());
-  let v = Bencode.(L [I 0; I 1; S "foo"]) in
-  for i = 0 to n-1 do
-    Printf.printf "[%d] iteration %d\n" (Unix.getpid ()) i;
-    flush stdout;
-    BencodeOnDisk.write out v;
-  done;
-  BencodeOnDisk.close_out out;
-  Printf.printf "done\n";
-  ()
-
-let _ =
-  let file = Sys.argv.(1) in
-  Printf.printf "[%d] start: write to %s\n" (Unix.getpid ()) file;
-  flush stdout;
-  write_values file 100

examples/ccparse_irclogs_real.cond.ml

@@ -0,0 +1,80 @@
+(* parse IRC logs *)
+
+type datetime = {
+  year: int;
+  month: int;
+  day: int;
+  hour: int;
+  min: int;
+  sec: int;
+}
+
+let pp_datetime out d =
+  let { year; month; day; hour; min; sec } = d in
+  CCFormat.(
+    fprintf out "{y=%d;M=%d;d=%d;h=%d;m=%d;s=%d}" year month day hour min sec)
+
+type msg = {
+  timestamp: datetime;
+  user: string;
+  msg: string;
+}
+
+let pp_msg out m =
+  CCFormat.fprintf out "{@[time=%a;@ user=%S;@ msg=%S@]}" pp_datetime
+    m.timestamp m.user m.msg
+
+open CCParse
+
+let p_datetime : datetime t =
+  let int = U.int in
+  let* date, time = split_2 ~on_char:' ' in
+  let* y, m, d = recurse date (split_3 ~on_char:'-') in
+  let* year = recurse y int in
+  let* month = recurse m int in
+  let* day = recurse d int in
+  let* hour, min, sec =
+    recurse time
+      (let* hour = int in
+       char ':'
+       *> let* min = int in
+          char ':'
+          *> let+ sec = int in
+             hour, min, sec)
+  in
+  let dt = { year; month; day; hour; min; sec } in
+  return dt
+
+let p_line =
+  let* line = lookahead all in
+
+  if Slice.is_empty line then
+    return None
+  else
+    let* fields = split_list ~on_char:'\t' in
+    match fields with
+    | [ date; user; rest ] ->
+      let+ timestamp = recurse date p_datetime
+      and+ user =
+        recurse user
+          (chars_if (function
+            | '>' -> false
+            | _ -> true))
+      and+ msg = recurse rest (all_str >|= String.trim) in
+      Some { timestamp; user; msg }
+    | _ ->
+      failf "expected 3 fields, got [%s]"
+        (String.concat ";" @@ List.map String.escaped
+        @@ List.map Slice.to_string fields)
+
+let p_file = each_line (parsing "line" p_line) >|= CCList.keep_some
+
+let () =
+  let s = CCIO.File.read_exn Sys.argv.(1) in
+  match parse_string p_file s with
+  | Ok l ->
+    Format.printf "parsed:@.";
+    List.iter (Format.printf "%a@." pp_msg) l
+  | Error e ->
+    Format.printf "parse error: %s@." e;
+    exit 1

examples/ccparse_sexp.ml

@@ -0,0 +1,73 @@
+open CCParse
+
+type sexp =
+  | Atom of string
+  | List of sexp list
+
+let rec pp_sexpr out (s : sexp) : unit =
+  match s with
+  | Atom s -> Format.fprintf out "%S" s
+  | List l ->
+    Format.fprintf out "(@[";
+    List.iteri
+      (fun i s ->
+        if i > 0 then Format.fprintf out "@ ";
+        pp_sexpr out s)
+      l;
+    Format.fprintf out "@])"
+
+let skip_white_and_comments =
+  fix @@ fun self ->
+  skip_white
+  *> try_or (char ';')
+       ~f:(fun _ ->
+         skip_chars (function
+           | '\n' -> false
+           | _ -> true)
+         *> self)
+       ~else_:(return ())
+
+let atom =
+  chars_fold_transduce `Start ~f:(fun acc c ->
+      match acc, c with
+      | `Start, '"' -> `Continue `In_quote
+      | `Start, (' ' | '\t' | '\n' | '(' | ')' | ';') -> `Fail "atom"
+      | `Normal, (' ' | '\t' | '\n' | '(' | ')' | ';') -> `Stop
+      | `Done, _ -> `Stop
+      | `In_quote, '"' -> `Continue `Done (* consume *)
+      | `In_quote, '\\' -> `Continue `Escape
+      | `In_quote, c -> `Yield (`In_quote, c)
+      | `Escape, 'n' -> `Yield (`In_quote, '\n')
+      | `Escape, 't' -> `Yield (`In_quote, '\t')
+      | `Escape, '"' -> `Yield (`In_quote, '"')
+      | `Escape, '\\' -> `Yield (`In_quote, '\\')
+      | `Escape, c -> `Fail (Printf.sprintf "unknown escape code \\%c" c)
+      | (`Start | `Normal), c -> `Yield (`Normal, c)
+      | _ -> `Fail "invalid atom")
+  >>= function
+  | `In_quote, _ -> fail "unclosed \""
+  | `Escape, _ -> fail "unfinished escape sequence"
+  | _, "" -> fail "expected non-empty atom"
+  | _, s -> return (Atom s)
+
+let psexp =
+  fix @@ fun self ->
+  skip_white_and_comments
+  *> try_or (char '(')
+       ~f:(fun _ ->
+         sep ~by:skip_white_and_comments self
+         <* skip_white_and_comments <* char ')'
+         >|= fun l -> List l)
+       ~else_:atom
+
+let psexp_l = many_until ~until:(skip_white_and_comments *> eoi) psexp
+
+let () =
+  let s = CCIO.File.read_exn Sys.argv.(1) in
+  match parse_string psexp_l s with
+  | Ok l ->
+    Format.printf "parsed:@.";
+    List.iter (Format.printf "%a@." pp_sexpr) l
+  | Error e ->
+    Format.printf "parse error: %s@." e;
+    exit 1

examples/cgi/web_pwd.ml

@@ -1,26 +0,0 @@
-
-(** Export the list of files in a directory *)
-
-let dir = "/tmp/"
-
-(* list of files in a dir *)
-let lsdir dir =
-  let d = Unix.opendir dir in
-  let l = ref [] in
-  begin try while true do
-    l := Unix.readdir d :: !l
-  done with End_of_file -> Unix.closedir d
-  end;
-  !l
-
-let export dir =
-  let l = lsdir dir in
-  ToWeb.HTML.(concat
-    [ h1 (str ("files in "^ dir))
-    ; list (List.map str l)
-    ])
-
-let state = ToWeb.State.create dir ~export
-
-let _ =
-  ToWeb.serve_state ~sockfile:"/tmp/foo.sock" state

examples/collatz.ml

@@ -1,20 +0,0 @@
-
-(** Display the graph of the collatz conjecture, starting from the given int *)
-
-let g = LazyGraph.map
-  ~edges:(fun () -> [])
-  ~vertices:(fun i -> [`Label (string_of_int i)])
-  LazyGraph.collatz_graph
-
-let collatz n filename =
-  Format.printf "print graph to %s@." filename;
-  let out = open_out filename in
-  let fmt = Format.formatter_of_out_channel out in
-  LazyGraph.Dot.pp ~name:"collatz" g fmt (Sequence.singleton n);
-  Format.pp_print_flush fmt ();
-  close_out out
-
-let _ =
-  if Array.length Sys.argv < 3
-    then (Format.printf "use: collatz num file@."; exit 0)
-    else collatz (int_of_string Sys.argv.(1)) Sys.argv.(2)

examples/crawl.ml

@@ -1,83 +0,0 @@
-
-(** Crawl the web to find shortest path between two urls *)
-
-open Batteries
-
-let pool = Future.Pool.create ~timeout:15. ~size:50
-
-let split_lines s = String.nsplit s ~by:"\n"
-
-let get_and_parse url =
-  let cmd = Format.sprintf "wget -q '%s' -O - | grep -o 'http\\(s\\)\\?://[^ \"]\\+'" url in
-  let content = Future.spawn_process ?stdin:None ~pool ~cmd in
-  content
-    |> Future.map (fun (_, stdout, _) -> stdout)
-    |> Future.map split_lines
-    |> Batteries.tap (fun lines ->
-      Future.on_success lines (fun lines -> Format.printf "downloaded %s (%d urls)@." url (List.length lines)))
-
-type page = string * (string list Future.t)
-
-(** The web graph; its vertices are annotated by futures of the content *)
-let g : (page, string, unit) LazyGraph.t =
-  let force (url, future) =
-    Format.printf "force %s@." url;
-    let urls =
-      try Future.get future |> List.map (fun url -> (), (url, get_and_parse url))
-      with e -> [] in
-    let edges = Gen.of_list urls in
-    (* need to parse the page to get the urls *)
-    LazyGraph.Node ((url, future), url, edges)
-  in LazyGraph.make
-    ~eq:(fun (url1,_) (url2,_) -> url1 = url2)
-    ~hash:(fun (url,_) -> Hashtbl.hash url)
-    force 
-
-let pp_path fmt path =
-  List.print ~sep:"\n"
-    (fun fmt ((u1,_), (), (u2,_)) ->
-      String.print fmt u1; String.print fmt " -> "; String.print fmt u2)
-    fmt path
-
-(* seek a path from the first url to the second *)
-let path_between from into =
-  Format.printf "seek path from %s to %s@." from into;
-  let on_explore (url,_) = Format.printf "  explore %s...@." url in
-  try
-    let cost, path = LazyGraph.dijkstra ~on_explore g
-      (from, get_and_parse from) (into, get_and_parse into) in
-    Printf.printf "found path (cost %f):\n%a\n" cost pp_path path
-  with Not_found ->
-    Format.printf "no path could be found@."
-
-let print_limit file start depth =
-  Format.printf "print into %s webgraph starting from %s, up to depth %d@."
-    file start depth;
-  let start = start, get_and_parse start in
-  let g' = LazyGraph.limit_depth g depth (Gen.singleton start) in
-  let g'' = LazyGraph.map ~vertices:(fun v -> [`Label v]) ~edges:(fun _ -> []) g' in
-  let out = Format.formatter_of_out_channel (open_out file) in
-  LazyGraph.Dot.pp ~name:"web" g'' out (Gen.singleton start);
-  Format.pp_print_flush out ();
-  ()
-
-let _ =
-  let timer = Future.Timer.create () in
-  let rec ping () =
-    Format.printf "*** ping! (size of pool: %d)@." (Future.Pool.size pool);
-    Future.Timer.schedule_in timer 10. ping
-  in ping ()
-
-let print_usage () =
-  Format.printf "usage: crawl path url1 url2@.";
-  Format.printf "usage: crawl print file url depth@.";
-  ()
-
-let _ =
-  match Sys.argv with
-  | [|_; "print"; file; url; depth|] ->
-    print_limit file url (int_of_string depth)
-  | [|_; "path"; from; into|] ->
-    path_between from into
-  | _ ->
-    print_usage ()

examples/dune

@@ -0,0 +1,49 @@
+(executables
+ (names id_sexp ccparse_sexp ccparse_irclogs)
+ (libraries containers)
+ (flags :standard -warn-error -a+8))
+
+(rule
+ (alias runtest)
+ (locks /ctest)
+ (deps
+  (source_tree test_data))
+ (action
+  (ignore-stdout
+   (run ./id_sexp.exe test_data/benchpress.sexp))))
+
+(rule
+ (alias runtest)
+ (locks /ctest)
+ (deps
+  (source_tree test_data))
+ (action
+  (ignore-stdout
+   (run ./ccparse_sexp.exe test_data/benchpress.sexp))))
+
+(rule
+ (targets ccparse_irclogs.ml)
+ (enabled_if
+  (>= %{ocaml_version} "4.08"))
+ (action
+  (copy ccparse_irclogs_real.cond.ml %{targets})))
+
+(rule
+ (targets ccparse_irclogs.ml)
+ (enabled_if
+  (< %{ocaml_version} "4.08"))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run echo "let() = print_endline {|ok|}"))))
+
+(rule
+ (alias runtest)
+ (locks /ctest)
+ (deps
+  (source_tree test_data))
+ (enabled_if
+  (>= %{ocaml_version} "4.08"))
+ (action
+  (ignore-stdout
+   (run ./ccparse_irclogs.exe test_data/irc-logs.txt))))

examples/id_sexp.ml

@@ -1,20 +1,14 @@
-
+let pp_sexp s =
-open Result
+  match s with
-
+  | Ok l -> List.iter (fun s -> Format.printf "@[%a@]@." CCSexp.pp s) l
-let pp_sexp s = match s with
+  | Error msg -> Format.printf "error: %s@." msg
-  | Ok l ->
-      List.iter
-        (fun s -> Format.printf "@[%a@]@." CCSexp.pp s)
-        l
-  | Error msg ->
-      Format.printf "error: %s@." msg
 
 let () =
   match Sys.argv with
   | [| _ |] ->
-      let s = CCSexp.parse_chan_list stdin in
+    let s = CCSexp.parse_chan_list stdin in
-      pp_sexp s
+    pp_sexp s
   | [| _; file |] ->
-      let s = CCSexp.parse_file_list file in
+    let s = CCSexp.parse_file_list file in
-      pp_sexp s
+    pp_sexp s
   | _ -> failwith "usage: id_sexp [file]"

examples/lambda.ml

@@ -1,112 +0,0 @@
-
-(** Example of printing trees: lambda-term evaluation *)
-
-
-type term =
-  | Lambda of string * term
-  | App of term * term
-  | Var of string
-
-let _gensym =
-  let r = ref 0 in
-  fun () ->
-    let s = Printf.sprintf "x%d" !r in
-    incr r;
-    s
-
-module SSet = Set.Make(String)
-module SMap = Map.Make(String)
-
-let rec fvars t = match t with
-  | Var s -> SSet.singleton s
-  | Lambda (v,t') ->
-      let set' = fvars t' in
-      SSet.remove v set'
-  | App (t1, t2) -> SSet.union (fvars t1) (fvars t2)
-
-(* replace [var] with the term [by] *)
-let rec replace t ~var ~by = match t with
-  | Var s -> if s=var then by else t
-  | App (t1,t2) -> App (replace t1 ~var ~by, replace t2 ~var ~by)
-  | Lambda (v, t') when v=var -> t  (* no risk *)
-  | Lambda (v, t') -> Lambda (v, replace t' ~var ~by)
-
-(* rename [t] so that [var] doesn't occur in it *)
-let rename ~var t =
-  if SSet.mem var (fvars t)
-    then replace t ~var ~by:(Var (_gensym ()))
-    else t
-
-let (>>=) o f = match o with
-  | None -> None
-  | Some x -> f x
-
-let rec one_step t = match t with
-  | App (Lambda (var, t1), t2) ->
-      let t2' = rename ~var t2 in
-      Some (replace t1 ~var ~by:t2')
-  | App (t1, t2) ->
-      begin match one_step t1 with
-      | None ->
-          one_step t2 >>= fun t2' ->
-          Some (App (t1,t2'))
-      | Some t1' ->
-          Some (App (t1',t2))
-      end
-  | Var _ -> None
-  | Lambda (v,t') ->
-      one_step t' >>= fun t'' ->
-      Some (Lambda (v, t''))
-
-let normal_form t =
-  let rec aux acc t = match one_step t with
-    | None -> List.rev (t::acc)
-    | Some t' -> aux (t::acc) t'
-  in
-  aux [] t
-
-let _split_fuel f =
-  assert (f>=2);
-  if f=2 then 1,1
-  else
-    let x = 1+Random.int (f-1) in
-    f-x, x
-
-let _random_var () =
-  let v = [| "x"; "y"; "z"; "u"; "w" |] in
-  v.(Random.int (Array.length v))
-
-let  _choose_var ~vars = match vars with
-  | [] -> Var (_random_var ())
-  | _::_ ->
-      let i = Random.int (List.length vars) in
-      List.nth vars i
-
-let rec _random_term fuel vars =
-  match Random.int 2 with
-  | _ when fuel = 1 -> _choose_var ~vars
-  | 0 ->
-      let f1,f2 = _split_fuel fuel in
-      App (_random_term f1 vars, _random_term f2 vars)
-  | 1 ->
-      let v = _random_var () in
-      Lambda (v, _random_term (fuel-1) (Var v::vars))
-  | _ -> assert false
-
-let print_term t =
-  PrintBox.mk_tree
-    (function
-      | Var v -> PrintBox.line v, []
-      | App (t1,t2) -> PrintBox.line "app", [t1;t2]
-      | Lambda (v,t') -> PrintBox.line "lambda", [Var v; t']
-    ) t
-
-let print_reduction t =
-  let l = normal_form t in
-  let l = List.map (fun t -> PrintBox.pad (print_term t)) l in
-  PrintBox.vlist ~bars:false l
-
-let () =
-  Random.self_init ();
-  let t = _random_term (5 + Random.int 20) [] in
-  PrintBox.output ~indent:2 stdout (print_reduction t)

examples/mem_size.ml

@@ -1,67 +0,0 @@
-(** Compute the memory footprint of a value (and its subvalues). Reference is
-    http://rwmj.wordpress.com/2009/08/05/ocaml-internals-part-2-strings-and-other-types/ *)
-
-
-
-(** A graph vertex is an Obj.t value *)
-let graph =
-  let force x =
-    if Obj.is_block x
-      then
-        let children = Sequence.map (fun i -> i, Obj.field x i) (0--(Obj.size x - 1)) in
-        LazyGraph.Node (x, Obj.tag x, children)
-      else
-        LazyGraph.Node (x, Obj.obj x, Sequence.empty)
-  in LazyGraph.make ~eq:(==) force
-
-let word_size = Sys.word_size / 8
-
-let size x =
-  if Obj.is_block x
-    then (1+Obj.size x) * word_size
-    else word_size
-
-let compute_size x =
-  let o = Obj.repr x in
-  let vertices = LazyGraph.bfs graph o in
-  Sequence.fold (fun sum (o',_,_) -> size o' + sum) 0 vertices
-
-let print_val fmt x =
-  let o = Obj.repr x in
-  let graph' = LazyGraph.map ~edges:(fun i -> [`Label (string_of_int i)])
-                 ~vertices:(fun v -> [`Label (string_of_int v); `Shape "box"]) graph in
-  LazyGraph.Dot.pp ~name:"value" graph' fmt (Sequence.singleton o)
-
-let print_val_file filename x =
-  let out = open_out filename in
-  let fmt = Format.formatter_of_out_channel out in
-  print_val fmt x;
-  Format.pp_print_flush fmt ();
-  close_out out
-
-let process_val ~name x =
-  print_val_file (Format.sprintf "/tmp/%s.dot" name) x;
-  Format.printf "size of val is %d@." (compute_size x)
-
-module ISet = Set.Make(struct type t = int let compare = compare end)
-
-let mk_circ n =
-  let start = Sequence.to_list (1--n) in
-  (* make the end of the list point to its beginning *)
-  let rec cycle l = match l with
-  | [] -> assert false
-  | [_] -> Obj.set_field (Obj.repr l) 1 (Obj.repr start)
-  | _::l' -> cycle l'
-  in
-  cycle start;
-  start
-
-let _ =
-  let s = Sequence.fold (fun s x -> ISet.add x s) ISet.empty (1--100) in
-  process_val ~name:"foo" s;
-  let l = Sequence.to_list (Sequence.map (fun i -> Sequence.to_list (i--(i+42)))
-    (Sequence.of_list [0;100;1000])) in
-  process_val ~name:"bar" l;
-  let l' = mk_circ 100 in
-  process_val ~name:"baaz" l';
-  ()

examples/test_data/benchpress.sexp

@@ -0,0 +1,13 @@
+
+(prover
+  (name msat)
+  (synopsis "msat for pure sat problems")
+  (version "git:.")
+  (sat "^Sat")
+  (unsat "^Unsat")
+  (cmd "$cur_dir/../msat.exe -time $timeout $file"))
+
+(dir
+  (path $cur_dir)
+  (pattern ".*\\.cnf")
+  (expect (const unknown)))

examples/test_data/irc-logs.txt

@@ -0,0 +1,777 @@
+2021-06-04 00:50:44	kluk>	How do I start using DynArray from the ocaml command line?
+2021-06-04 00:50:51	kluk>	I have already done opam install extlib
+2021-06-04 00:51:12	kluk>	I am a newbie at OCaml
+2021-06-04 05:18:03	dockerusocamlus>	Hello! I'm minimizing an Alpine-based Docker image with OCaml installed via opam, and I'm trying to understand if I could erase some files to save some space. Basically, trying to understand if they are needed only on special situations, or if that would cause issues for users of the Docker image.
+2021-06-04 05:19:46	dockerusocamlus>	For instance, in this image, I have file ~/.opam/<version>/lib/ocaml/expunge, which take 15 MB of space. I don't think I have ever used it, but I don't know if it's internally used by some other OCaml process.
+2021-06-04 05:28:12	dockerusocamlus>	I don't have much documentation about it, and grepping ocaml's sources only shows a few occurrences. It seems related to the installation of the OCaml compiler itself, but even after removing it, I'm still able to do a `opam switch create` to install a different compiler, so... I guess it's fine to remove it?
+2021-06-04 05:36:13	octachron>	This is a compiler tool which is used to build REPLs. It is also used by utop.
+2021-06-04 05:42:54	dockerusocamlus>	Thanks!
+2021-06-04 08:10:44	superherointj>	Need some feedback on a minimalistic lwt demo: https://github.com/superherointj/lwt-demo1
+2021-06-04 08:38:37	d_bot>	<superherointj> Just solved it. I must be really tired.
+2021-06-04 09:49:45	d_bot>	<superherointj> Can anybody point me to a good article/information on incompatible ppx drivers (ppxlib and ocaml-migrate-parsetree)?
+2021-06-04 09:49:46	d_bot>	<superherointj> I have read already the saga blog post, but I am missing something.
+2021-06-04 09:49:47	d_bot>	<superherointj> I want to build my old project. I'm trying to replicate problem atm on a demo.
+2021-06-04 09:50:25	companion_cube>	people are supposed to use ppxlib, that's all I know
+2021-06-04 09:51:25	d_bot>	<superherointj> Any example?
+2021-06-04 09:51:51	companion_cube>	https://github.com/ocaml-ppx/ppx_deriving I guess?
+2021-06-04 09:52:40	d_bot>	<superherointj> Found this:
+2021-06-04 09:52:41	d_bot>	<superherointj> https://ppxlib.readthedocs.io/_/downloads/en/stable/pdf/
+2021-06-04 09:57:49	d_bot>	<EduardoRFS> Why does OCaml not optimizes this in a noop? Even under flambda and -O3
+2021-06-04 09:57:49	d_bot>	<EduardoRFS>
+2021-06-04 09:57:51	d_bot>	<EduardoRFS> ```ocaml
+2021-06-04 09:57:52	d_bot>	<EduardoRFS> let f (a, b) = (a, b)
+2021-06-04 09:57:53	d_bot>	<EduardoRFS> ```
+2021-06-04 10:00:07	@adrien>	it returns a new tuple, not the same one
+2021-06-04 10:00:37	@adrien>	let x = (1,2);; let f (a, b) = (a, b);; let y = f x;; y == x;;
+2021-06-04 10:00:41	d_bot>	<EduardoRFS> the question is why? It would change the `==` behavior but it's already not defined from what I remember
+2021-06-04 10:01:06	d_bot>	<EduardoRFS> it behaves differently in bytecode, native and IIRC it's also different in flambda
+2021-06-04 10:01:14	companion_cube>	I agree it'd be a valid optim
+2021-06-04 10:02:19	d_bot>	<EduardoRFS> This is especiall try for the case of different types and pattern matching but that generates identical data in memory, like
+2021-06-04 10:02:20	d_bot>	<EduardoRFS>
+2021-06-04 10:02:21	d_bot>	<EduardoRFS> ```ocaml
+2021-06-04 10:02:22	d_bot>	<EduardoRFS> type a = | A(int)
+2021-06-04 10:02:24	d_bot>	<EduardoRFS> type b = B(int)
+2021-06-04 10:02:25	d_bot>	<EduardoRFS> let f = function | A v -> B v
+2021-06-04 10:02:26	d_bot>	<EduardoRFS> ```
+2021-06-04 10:02:36	@adrien>	I get the same behaviour in native
+2021-06-04 10:03:11	@adrien>	and you can do f u = u
+2021-06-04 10:03:13	companion_cube>	@eduardors these are only the same by accident though
+2021-06-04 10:03:18	companion_cube>	seems far less useful as an optim
+2021-06-04 10:03:18	zozozo>	see https://github.com/ocaml/ocaml/pull/8958
+2021-06-04 10:03:22	d_bot>	<EduardoRFS> yes but the compiler knows it
+2021-06-04 10:03:32	@adrien>	not sure how is the generated code but in that case it's not a new tuple
+2021-06-04 10:04:02	zozozo>	there is a PR to do pretty much that (the link I posted above)
+2021-06-04 10:04:05	theblatte>	I keep writing functions like `let f ((a,b) as x0) = let a' = g a in let b' = g b in if a == a' && b == b' then x0 else (a', b')`
+2021-06-04 10:04:07	d_bot>	<EduardoRFS> in this case yes, but not all cases, I'm not asking about this specific tuple, I'm asking more about identical blocks that are known to be always identical
+2021-06-04 10:04:13	companion_cube>	I don't think it's a very useful optimization to see if per chance two different variants of different types happen to have the same binary representation
+2021-06-04 10:04:33	companion_cube>	more important stuff is to eliminate temporaries imho
+2021-06-04 10:04:41	companion_cube>	like a tuple built just to be deconstructed in the same function
+2021-06-04 10:04:45	companion_cube>	(or an option…)
+2021-06-04 10:04:53	zozozo>	companion_cube: what do you mean by "temporaries"?
+2021-06-04 10:05:05	d_bot>	<EduardoRFS> temporary allocations IIUC
+2021-06-04 10:05:06	companion_cube>	data that doesn't escape the current function :p
+2021-06-04 10:05:09	zozozo>	companion_cube: ah, well, avoiding these is more or less exactly the job of flambda, ^^
+2021-06-04 10:05:11	companion_cube>	(after inlining)
+2021-06-04 10:05:12	companion_cube>	yeah I know
+2021-06-04 10:05:17	companion_cube>	godspeed to you zozozo 
+2021-06-04 10:05:30	zozozo>	^^
+2021-06-04 10:05:55	zozozo>	@EduardoRFS : did you look at https://github.com/ocaml/ocaml/pull/8958 ?
+2021-06-04 10:07:07	d_bot>	<EduardoRFS> I'm looking on it, the argument of not being predictable is sad, it's a flat allocation reduction, no hidden allocation, not trying to make non efficient code efficient, but trying to make code that is efficient as possible more efficient
+2021-06-04 10:07:34	zozozo>	companion_cube: also, note that sometimes, because of type subtleties, you need to write the "identity" function, as a pattern match that then reconstructs exactly the same value, but with a slightly different type (thing GADTs), in such cases, being able to detect that a switch returns exactly its argument, is a nice improvements, and you can't really write it differently because of the types
+2021-06-04 10:07:36	@adrien>	well, as theblatte said, the "as" construct should help for that case
+2021-06-04 10:08:04	d_bot>	<EduardoRFS> that's exactly the case zozozo, for a lot of code in ocaml-migrate-types
+2021-06-04 10:08:11	theblatte>	zozozo: yes!
+2021-06-04 10:08:19	zozozo>	the advantage of the PR I linked is that it can trigger in cases where one cannot write code using "as"
+2021-06-04 10:08:27	theblatte>	much sad when that happens
+2021-06-04 10:08:30	d_bot>	<EduardoRFS> "as"?
+2021-06-04 10:08:53	zozozo>	@EduardoRFS : `let f ((a, b) as pair) = pair`
+2021-06-04 10:09:13	d_bot>	<EduardoRFS> oh but that works only for structural types
+2021-06-04 10:09:21	companion_cube>	zozozo: good argument against GADTs ;)
+2021-06-04 10:09:34	d_bot>	<EduardoRFS> companion_cube loves GADTs
+2021-06-04 10:09:42	companion_cube>	heh, in small doses
+2021-06-04 10:09:47	theblatte>	companion_cube: no need for GADTs! https://github.com/facebook/infer/blob/cfed4c4fa0c99ab1f42683bb92df76c8c8434e79/infer/src/pulse/PulseSummary.ml#L56
+2021-06-04 10:10:03	olle>	as?
+2021-06-04 10:10:06	olle>	new keyword?
+2021-06-04 10:10:13	companion_cube>	wait, theblatte, why
+2021-06-04 10:10:14	theblatte>	eg phantom type parameters
+2021-06-04 10:10:18	companion_cube>	ah yes
+2021-06-04 10:10:29	companion_cube>	it's unfortunate
+2021-06-04 10:10:34	theblatte>	(in my case not phantom but "phantom" because it doesn't show up in some of the variants)
+2021-06-04 10:10:37	companion_cube>	but it's the same constructors in this case.
+2021-06-04 10:10:38	zozozo>	companion_cube: gadts are useful *sometimes*
+2021-06-04 10:10:40	d_bot>	<EduardoRFS> I wonder if #8958 would be better as lambda layer
+2021-06-04 10:10:44	d_bot>	<EduardoRFS> but tempting to rebase it ;/
+2021-06-04 10:11:25	zozozo>	@EduardoRFS : the problem is that if you do that at lambda level, you miss out on situations where it happens after some inlining/simplification
+2021-06-04 10:11:47	d_bot>	<EduardoRFS> yeah but you ensure same behavior between all backends
+2021-06-04 10:11:50	zozozo>	(also, the code of lambda simplifications is quite a mess from what I hear)
+2021-06-04 10:12:33	theblatte>	companion_cube: same constructors: yes, personally I would only care about preserving physical equality when the objects are actually equal but ymmv
+2021-06-04 10:12:34	zozozo>	well.. there is now a pass specifically designed to implement optimizations, so why not use it ?
+2021-06-04 10:13:05	theblatte>	I've seen several examples where it would have a material effect on perf
+2021-06-04 10:13:08	d_bot>	<EduardoRFS> But the pass should not change behavior of code unless it provides a fallback, this is how I see most of it
+2021-06-04 10:13:13	d_bot>	<EduardoRFS> maybe Sys.opaque_identity would ignore it
+2021-06-04 10:13:32	d_bot>	<EduardoRFS> can we deprecate ==? That seems like a better idea overall
+2021-06-04 10:13:34	companion_cube>	zozozo: because it only works for native?
+2021-06-04 10:13:41	companion_cube>	ahahah 
+2021-06-04 10:13:47	companion_cube>	removing == kills perf for other programs
+2021-06-04 10:14:01	theblatte>	#8958 ftw, I didn't know there'd been such a PR in flight for such a long time
+2021-06-04 10:14:04	zozozo>	companion_cube: well, bytecode is pretty much meant to not care about performance, so from that point of view it's not unreasonable
+2021-06-04 10:14:05	d_bot>	<EduardoRFS> not removing it, deprecating it, keep it under Obj.xx
+2021-06-04 10:14:34	theblatte>	== is an important part of the language, not an extension
+2021-06-04 10:14:41	zozozo>	the *good* solution would be to change the bytecode generation to use the result of flambda
+2021-06-04 10:14:56	zozozo>	the semantics of "==" is largely not officially specified
+2021-06-04 10:14:56	d_bot>	<EduardoRFS> NAH
+2021-06-04 10:15:10	theblatte>	but not a bad idea to not give it such an easily-confused name :p eg use "phys_equal" instead
+2021-06-04 10:15:12	zozozo>	and for any non-mutable record, there are next to no guarantees about "=="
+2021-06-04 10:15:26	d_bot>	<EduardoRFS> unless we had a blazing fast flambda pass, bytecode is so fast right now
+2021-06-04 10:16:22	d_bot>	<EduardoRFS> == is not exactly part of the language in many ways, and it's known to behave differently depending on the backend which should never happen for a specified feature of the language
+2021-06-04 10:16:30	zozozo>	@EduardoRFS: are you talking about compilation time or runtime of the compild program ?
+2021-06-04 10:16:35	d_bot>	<EduardoRFS> compilation time
+2021-06-04 10:16:36	companion_cube>	zozozo: I wish I could agree
+2021-06-04 10:16:40	companion_cube>	but some of us are stuck with bytecode
+2021-06-04 10:16:45	d_bot>	<EduardoRFS> bytecode is slow in runtime, really slow
+2021-06-04 10:16:46	companion_cube>	because that's the only official toplevel for now
+2021-06-04 10:17:10	d_bot>	<EduardoRFS> but bytecode generated from flambda would still work with the toplevel
+2021-06-04 10:17:16	zozozo>	companion_cube: yeah, but sometimes with others in my team, we talk about making it so that bytecode is generated after the flambda pass, which would solve all problems (if we can make it work)
+2021-06-04 10:17:21	companion_cube>	sure
+2021-06-04 10:17:36	companion_cube>	I mean in the future maybe we'll also have a JIT
+2021-06-04 10:17:42	d_bot>	<EduardoRFS> there is any plan on deprecating closure middle end?
+2021-06-04 10:17:45	companion_cube>	but for now it's not like there's a choice, and there's basically 0 optims on bytecode
+2021-06-04 10:17:47	companion_cube>	which… ugh
+2021-06-04 10:19:26	d_bot>	<dinosaure> it remmembers me one time when people compared ocsigenserver and http servers and used the bytecode version accidentally and say, OCaml is so bad
+2021-06-04 10:19:34	companion_cube>	:D
+2021-06-04 10:19:38	d_bot>	<EduardoRFS> D:
+2021-06-04 10:19:49	companion_cube>	or even using dune without --profile=release
+2021-06-04 10:19:53	companion_cube>	bye bye optims
+2021-06-04 10:19:58	d_bot>	<EduardoRFS> TEZOS IS RUNNING WITHOUT PROFILE=RELEASE
+2021-06-04 10:20:25	d_bot>	<EduardoRFS> even worse it is benchmarked without profile=release
+2021-06-04 10:20:33	companion_cube>	hu, weirder
+2021-06-04 10:21:18	zozozo>	well, if the switch is not using flambda, I don't think the difference is that important between the dev and release profiles
+2021-06-04 10:22:34	companion_cube>	err, you still have a bit of cross module inlining, don't you?
+2021-06-04 10:22:39	companion_cube>	with normal ocamlopt
+2021-06-04 10:22:54	zozozo>	I'm not sure
+2021-06-04 10:22:55	d_bot>	<EduardoRFS> yeah it makes difference, I benchmarked it, around 30% boost on some smart contracts
+2021-06-04 10:23:06	d_bot>	<EduardoRFS> dune without profile=release runs under -opaque
+2021-06-04 10:23:10	companion_cube>	I think it does, including for stuff like externals
+2021-06-04 10:23:16	companion_cube>	exactly
+2021-06-04 10:23:25	companion_cube>	--profile=release brings you back to normal behavior
+2021-06-04 10:23:26	zozozo>	I think (but I'm not sure) the only thing cross-inlined would be externals, but those are in the .mlis so no need for cross-optimization actually
+2021-06-04 10:23:30	d_bot>	<EduardoRFS> externals rely on the interface, so it doesn't depend on profile=release
+2021-06-04 10:23:50	companion_cube>	zozozo: but the .cmx ?
+2021-06-04 10:24:00	theblatte>	is profile=release different than passing -O3 to ocamlopt??
+2021-06-04 10:24:05	zozozo>	ah, maybe the small functions that closure unconditionally inline are inliend cross-modules by vanilla ocamlopt
+2021-06-04 10:24:17	d_bot>	<EduardoRFS> it is, because without profile=release you're under -opaque
+2021-06-04 10:24:30	theblatte>	whaaaat
+2021-06-04 10:24:40	theblatte>	:o
+2021-06-04 10:24:44	d_bot>	<EduardoRFS> that's the only way to achieve blazing fast build speed
+2021-06-04 10:24:53	companion_cube>	zozozo: the functions marked "inline" in .cmx files
+2021-06-04 10:24:56	d_bot>	<EduardoRFS> yup, small functions like having `Module.equal` are not inlined and Module.equal a lot of times is literally a single cnstruction
+2021-06-04 10:25:09	theblatte>	blazing fast = 6x slower than without -O3 ^^
+2021-06-04 10:25:11	companion_cube>	that's what I was talking about
+2021-06-04 10:25:21	zozozo>	companion_cube: indeed, ^^
+2021-06-04 10:25:30	companion_cube>	so it can make a big difference :)
+2021-06-04 10:25:35	companion_cube>	even without flambda
+2021-06-04 10:25:45	theblatte>	ohhh, recently-ish we noticed marking some functor arguments as [@inline] made a big difference
+2021-06-04 10:25:52	companion_cube>	:D 
+2021-06-04 10:25:59	zozozo>	that's not surprising
+2021-06-04 10:26:04	theblatte>	is that sort of thing (adding @inline) not needed with flambda + release profile?
+2021-06-04 10:26:25	theblatte>	or is that independent?
+2021-06-04 10:26:26	companion_cube>	it still gives you better control
+2021-06-04 10:26:34	zozozo>	iirc, flambda tries as much as possibvle to inline functor applicaiton that are at toplevel, so you shouldn't need the annotations in that particular case
+2021-06-04 10:26:51	companion_cube>	do a lot of people use flambda1  in production?!
+2021-06-04 10:26:59	zozozo>	companion_cube: jane street i guess ?
+2021-06-04 10:27:07	companion_cube>	ahah maybe they have enough RAM
+2021-06-04 10:27:16	zozozo>	also, the binary release of dolmen is now compiled with flambda, :D
+2021-06-04 10:27:18	companion_cube>	I stopped using it years ago
+2021-06-04 10:27:18	theblatte>	infer is 30% faster with flambda, so you bet
+2021-06-04 10:27:32	companion_cube>	wow
+2021-06-04 10:27:37	companion_cube>	well can't wait for flambda2
+2021-06-04 10:28:01	companion_cube>	anyway, the point of --profile=release is to tell dune to not block optimizations, it doesn't enable new ones
+2021-06-04 10:28:05	companion_cube>	for that you can use ocamlopt_flags
+2021-06-04 10:28:13	d_bot>	<EduardoRFS> tezos is another 20% faster on flambda
+2021-06-04 10:28:15	zozozo>	we're trying very hard on making it so that flambda2 is as fast as possible, but it's hard sometimes
+2021-06-04 10:28:27	companion_cube>	zozozo: it's not just a question of "fast"
+2021-06-04 10:28:35	companion_cube>	it's also "not gobble up RAM on bad cases"
+2021-06-04 10:28:38	theblatte>	yes but I'm trying to understand if adding --profile=release will make a difference
+2021-06-04 10:28:51	theblatte>	I'll try that
+2021-06-04 10:29:01	companion_cube>	so, -p foo already switches to release mode
+2021-06-04 10:29:12	companion_cube>	it's only if you use `dune build @all` and that kind of stuff that it matters
+2021-06-04 10:29:21	zozozo>	companion_cube: right, can you send me (if you recall), the packages that were not working 'or taking ut too much RAM) ?
+2021-06-04 10:29:24	companion_cube>	it makes compilation slower (removes -opaque) but enables optimization
+2021-06-04 10:29:27	companion_cube>	zozozo: at least dose3 
+2021-06-04 10:29:30	companion_cube>	that was the blocker
+2021-06-04 10:29:32	zozozo>	so that we can at least try and see what happens with flamdba2
+2021-06-04 10:29:32	companion_cube>	and camlp4
+2021-06-04 10:29:35	d_bot>	<EduardoRFS> even the new dose3?
+2021-06-04 10:29:52	d_bot>	<EduardoRFS> dose3 6 changed quite a bit of stuff, even parmap they're using now
+2021-06-04 10:30:34	theblatte>	companion_cube: we do "dune build infer.exe"
+2021-06-04 10:31:29	companion_cube>	lol
+2021-06-04 10:31:39	companion_cube>	yeah you need the flag
+2021-06-04 10:31:54	companion_cube>	idk about dose3 6
+2021-06-04 10:32:01	companion_cube>	I stopped trying flambda a while ago
+2021-06-04 10:32:17	companion_cube>	using too much ram is a big problem imho
+2021-06-04 10:32:45	d_bot>	<EduardoRFS> that seems weird, flambda reduces the number of allocations considerably
+2021-06-04 10:33:30	companion_cube>	per module
+2021-06-04 10:33:38	companion_cube>	with this you might also gain cross module
+2021-06-04 10:33:54	theblatte>	ah I thought you meant too much ram used during compilation :)
+2021-06-04 10:34:09	companion_cube>	that's what I meant yes
+2021-06-04 10:34:11	companion_cube>	sorry
+2021-06-04 10:34:18	companion_cube>	but theblatte, try the flag :p
+2021-06-04 10:34:26	d_bot>	<EduardoRFS> yeah makes sense
+2021-06-04 10:34:29	theblatte>	companion_cube: I am!!
+2021-06-04 10:34:30	companion_cube>	and also, make sure .cmx are installed for all libraries
+2021-06-04 10:34:52	d_bot>	<EduardoRFS> do we have an idea on what leads flambda to use so much memory?
+2021-06-04 10:34:57	theblatte>	companion_cube: how?
+2021-06-04 10:35:14	companion_cube>	well most should do it if they use dune
+2021-06-04 10:35:25	d_bot>	<ggole> Is there any info on flambda2 floating around yet?
+2021-06-04 10:35:36	companion_cube>	there's zozozo's brain
+2021-06-04 10:35:40	companion_cube>	although it's not floating
+2021-06-04 10:39:04	d_bot>	<dinosaure> technically, his brain is floating in his skull
+2021-06-04 10:39:15	companion_cube>	he might be a robot
+2021-06-04 10:39:17	companion_cube>	can't be sure
+2021-06-04 10:39:27	d_bot>	<EduardoRFS> if he is doing flambda2 he is a robot
+2021-06-04 10:40:07	zozozo>	right, I can try and answer questions about flambda2
+2021-06-04 10:40:17	zozozo>	since I'm working on it, ^^
+2021-06-04 10:41:07	companion_cube>	it'll be the default if it works well enough, right?
+2021-06-04 10:41:53	zozozo>	that's the plan
+2021-06-04 10:43:01	companion_cube>	🤞
+2021-06-04 10:43:57	d_bot>	<ggole> Hmm, I'm not sure I know enough about it to ask good questions
+2021-06-04 10:45:07	d_bot>	<ggole> Although maybe "what was not adequate about the first flambda design" is an obvious one
+2021-06-04 10:45:29	theblatte>	companion_cube: ah, but actually we never use dune default profiles, we do --profile=opt (or dev). There's no -opaque in the build logs
+2021-06-04 10:45:41	companion_cube>	ah, I see
+2021-06-04 10:45:47	theblatte>	phew :)
+2021-06-04 10:45:49	companion_cube>	(wait, there's a profile=opt??)
+2021-06-04 10:46:01	theblatte>	you can name your profile however you want :p
+2021-06-04 10:46:40	zozozo>	@ggole: basically, flambda2 now uses a CPS representation of source code, which is very useful (whereas flambda1 had an ANF representation iirc)
+2021-06-04 10:46:40	theblatte>	then we have (env (opt (ocamlopt_flags (:standard -O3))), etc.
+2021-06-04 10:47:35	theblatte>	maybe we should have -opaque for profile=dev though!
+2021-06-04 10:47:52	d_bot>	<EduardoRFS> wondering, when the optimization mentioned in 8958 may be triggered after inlining?
+2021-06-04 10:48:19	d_bot>	<EduardoRFS> It would be weird if flambda allocated two identical temporary blocks
+2021-06-04 10:48:30	d_bot>	<Drup> I also have a question on flambda 2.0
+2021-06-04 10:48:37	d_bot>	<ggole> @guigui CPS is an interesting direction. It used to be the IL style of choice, but seems to have gone right out of favour.
+2021-06-04 10:49:04	zozozo>	Drup: fire away, ^^
+2021-06-04 10:49:07	d_bot>	<Drup> Do you (the flambda team) intend to keep working on it instead of instantly decide to shoot the for moon and work on flambda 3.0 ?
+2021-06-04 10:49:36	companion_cube>	lolol
+2021-06-04 10:49:39	companion_cube>	I could say the same of ppx
+2021-06-04 10:49:44	zozozo>	Drup: the plan is to continue working on flambda2
+2021-06-04 10:50:14	d_bot>	<ggole> Although people who use ANF seem to have discovered the need for very continuation-like constructs with join points
+2021-06-04 10:50:17	zozozo>	basically, doing flambda1 gave the team (note that this was before I joined) some insights about how to do and not to do some things
+2021-06-04 10:50:17	d_bot>	<Drup> (you don't have to answer it, it's friday evening, and I know you don't really have a sway on this all that much)
+2021-06-04 10:50:50	zozozo>	Drup: indeed, but I'm right now in a conference call with Pierre so I can ask him, ^^
+2021-06-04 10:51:02	d_bot>	<Drup> Say hello from me :p
+2021-06-04 10:51:22	zozozo>	Drup: he says hello to you too
+2021-06-04 10:52:18	theblatte>	hi pchambart :)
+2021-06-04 10:52:48	companion_cube>	coucou to him
+2021-06-04 10:52:58	d_bot>	<Drup> but yeah, flambda in general is a bit moonshot infused sometimes. I understand why (it's much more fun to work on "The Perfect IR") but it's a bit infuriating.
+2021-06-04 10:53:28	companion_cube>	like multicore has been for a while, too
+2021-06-04 10:53:31	companion_cube>	or even opam 2.1
+2021-06-04 10:53:36	companion_cube>	seems like a common theme in OCaml :p
+2021-06-04 10:53:37	theblatte>	companion_cube: alright so something good still came out of that: compiling with -opaqe turns a 50s full build into a 40s one \o/ and I assume it's even better for incremental build?
+2021-06-04 10:53:42	zozozo>	yeah, but now with flambda2 we should have a good enough IR to do what we want and need
+2021-06-04 10:54:11	companion_cube>	theblatte: err it's faster builds, but slower code, yes
+2021-06-04 10:54:12	d_bot>	<Drup> let's hope so
+2021-06-04 10:54:34	theblatte>	companion_cube: it's for "dev" builds
+2021-06-04 10:54:49	companion_cube>	then yes
+2021-06-04 10:55:07	companion_cube>	with -opaque you have fully separate compilation
+2021-06-04 10:55:24	theblatte>	I was wondering why dune was doing so much work on incremental compilation ^^
+2021-06-04 10:55:31	theblatte>	thanks!
+2021-06-04 10:56:35	d_bot>	<Drup> (I though dune already added `-opaque` for dev builds)
+2021-06-04 10:57:05	d_bot>	<ggole> @guigui what was difficult before that's easy now?
+2021-06-04 10:57:06	companion_cube>	seems like theblatte has his own profiles
+2021-06-04 10:57:37	companion_cube>	zozozo: so in CPS, do you have 2 "kinds" of function calls? normal and continuations?
+2021-06-04 10:57:42	companion_cube>	to make sure there's no new closures?
+2021-06-04 10:57:53	d_bot>	<Drup> That doesn't seem very smart if those are less though-out than the normal ones :3
+2021-06-04 10:57:56	theblatte>	dune profiles have... weird defaults
+2021-06-04 10:58:24	theblatte>	fair enough :p
+2021-06-04 10:59:06	zozozo>	companion_cube: continuations in flambda2 are more along the lines of static jumps
+2021-06-04 10:59:12	companion_cube>	cool
+2021-06-04 10:59:33	companion_cube>	zozozo: please stop delaying the PR for ocaml.org 
+2021-06-04 10:59:33	companion_cube>	plz
+2021-06-04 11:00:48	zozozo>	sorry, ^^
+2021-06-04 11:00:57	companion_cube>	why does a PR against a fracking website take a full week to be merged anyway
+2021-06-04 11:01:29	zozozo>	right, that's a problem
+2021-06-04 11:02:22	companion_cube>	if you want the website to go stale because no one opens a PR to update it, that's the best way to go
+2021-06-04 11:02:38	octachron>	companion_cube, because there is noone clearly responsible? My commit right is normally mostly for OCaml releases
+2021-06-04 11:03:07	companion_cube>	is Anil trying to do too many things? :p
+2021-06-04 11:03:21	companion_cube>	definitely not blaming you octachron 
+2021-06-04 11:04:36	companion_cube>	just  annoyed that this, which should have taken literally 5 minutes, is taking a week
+2021-06-04 11:04:41	theblatte>	interesting, -opaque seems to make no difference for incremental compilation, only for full compilation
+2021-06-04 11:04:46	companion_cube>	during which the information on the website is misleading
+2021-06-04 11:05:14	companion_cube>	theblatte: try modifying a file deep in the dep graph, but only the implementation, not the interface
+2021-06-04 11:05:22	theblatte>	that's what I tried
+2021-06-04 11:05:36	companion_cube>	hu
+2021-06-04 11:06:25	theblatte>	humm, there's a leftover -opaque in the logs, my experiment must have gone wrong, sorry, digging in further
+2021-06-04 11:11:27	d_bot>	<EduardoRFS> theblatte: also opaque allows to build strictly against cmi which leads to better parallelism if you're using mli well
+2021-06-04 11:12:30	d_bot>	<EduardoRFS> so opaque should definitely matter for incremental as without it you need to rebuilt the full tree if any module changes
+2021-06-04 11:12:36	d_bot>	<EduardoRFS> maybe dune doesn't have this implemented?
+2021-06-04 11:12:48	d_bot>	<EduardoRFS> @rgrinberg any idea here?
+2021-06-04 11:13:00	theblatte>	I think because we use the "dev" name for our profile -opaque was already being passed!
+2021-06-04 11:13:48	theblatte>	even though we override (flags ...)
+2021-06-04 11:13:53	theblatte>	but not ocamlopt_flags
+2021-06-04 11:15:11	octachron>	companion_cube, anyway my week ended 15 minutes ago, so the PR is merged.
+2021-06-04 11:16:16	theblatte>	and we still see a win for the full build by forcing -opaque because it passes it in a bunch of places where dune doesn't by default
+2021-06-04 11:16:58	theblatte>	looks like that's when building the entire libraries' .cmx
+2021-06-04 11:17:21	@adrien>	octachron: thanks :)
+2021-06-04 11:17:46	theblatte>	so, hmmm, *shrug*
+2021-06-04 11:39:10	companion_cube>	octachron: 😂 thank you
+2021-06-04 11:43:12	companion_cube>	and the website is updated already, nice
+2021-06-04 11:46:07	companion_cube>	"variant constructor unboxing" that's nice
+2021-06-04 11:46:16	companion_cube>	didn't we discuss it here recently? 
+2021-06-04 11:46:21	companion_cube>	 perhaps about bitvectors
+2021-06-04 11:51:05	olle>	oooooh
+2021-06-04 13:58:46	zozozo>	@ggole : sorry for the delay, basically, control flow manipulation is much easier in cps form, also inlining a function's body is tricky to do in ANF (and can be exponential in the worst case if you need to ensure the result if in strict ANF)
+2021-06-04 13:59:23	companion_cube>	coudl you post a snippet of a tiny CPS AST? :p
+2021-06-04 13:59:39	companion_cube>	sth where we could see let, application, and like a primitive like + ?
+2021-06-04 13:59:44	zozozo>	sure
+2021-06-04 13:59:56	companion_cube>	👍
+2021-06-04 14:00:08	companion_cube>	I want to see how the continuations are represented
+2021-06-04 14:07:32	zozozo>	https://gist.github.com/Gbury/7a02a35cb4906914fa351183490f11b2
+2021-06-04 14:07:44	zozozo>	basically, a continuation is a (unique) integer
+2021-06-04 14:08:05	zozozo>	companion_cube: ^
+2021-06-04 14:09:06	companion_cube>	so, apply_cont is where you jump
+2021-06-04 14:09:09	zozozo>	yup
+2021-06-04 14:09:29	zozozo>	also, after a function call (i.e. Apply_expr), you call the given continuation with the return value of the function call
+2021-06-04 14:09:35	companion_cube>	and why is there 2 let?
+2021-06-04 14:09:42	companion_cube>	yeah
+2021-06-04 14:09:49	companion_cube>	and you call the function on already computed arguments
+2021-06-04 14:09:59	zozozo>	you can bind continuations, and regular expressions
+2021-06-04 14:10:37	companion_cube>	hmmm
+2021-06-04 14:10:54	companion_cube>	I mean, Let_expr makes sense, it's a local definition, ok
+2021-06-04 14:11:00	companion_cube>	but what's the "handler" in Let_cont?
+2021-06-04 14:11:00	zozozo>	yup
+2021-06-04 14:11:07	zozozo>	the code of the continuation
+2021-06-04 14:11:17	companion_cube>	oh shit ok
+2021-06-04 14:11:17	zozozo>	let_cont k args = handler in body
+2021-06-04 14:11:22	companion_cube>	nice
+2021-06-04 14:11:43	zozozo>	note that continuations are local to a function's body and cannot escape
+2021-06-04 14:11:44	companion_cube>	so patmatch could also create such expressions, for example
+2021-06-04 14:11:55	zozozo>	since continuations are not regular value (i.e. simples or named)
+2021-06-04 14:11:55	companion_cube>	with explicit sharing and everything
+2021-06-04 14:12:02	zozozo>	yes
+2021-06-04 14:12:29	companion_cube>	(I imagine switch could also have a default case)
+2021-06-04 14:12:49	zozozo>	in this case no, the switch has no default case
+2021-06-04 14:12:56	zozozo>	it simplifies some things
+2021-06-04 14:13:07	zozozo>	but in theory it could
+2021-06-04 14:13:08	companion_cube>	even in flambda2?
+2021-06-04 14:13:17	companion_cube>	I guess since you can share continuations, it's ok
+2021-06-04 14:13:24	zozozo>	it's just that having no default case means the code is much more regular
+2021-06-04 14:13:29	zozozo>	you can fold on the arms of the switch
+2021-06-04 14:13:41	zozozo>	and not have to specifically treat the default case
+2021-06-04 14:15:30	companion_cube>	heh, fair enough
+2021-06-04 14:16:03	companion_cube>	I think the insight that continuations are not values, is sth I didn't realize
+2021-06-04 14:16:05	companion_cube>	so thank you! :)
+2021-06-04 14:16:27	zozozo>	no problem, ^^
+2021-06-04 14:30:12	d_bot>	<ggole> zozozo: hmm, that's actually pretty close to what I expected. Thanks for taking the time to write it up.
+2021-06-04 14:33:07	d_bot>	<ggole> When I tried CPS ILs I found it difficult to perform what should be simple transformations like commuting `case` expressions, but perhaps my approach was too naive.
+2021-06-04 14:37:04	zozozo>	@ggole : well, commuting switches would be quite complicated indeed (and isn't done currently in flambda2)
+2021-06-04 14:38:59	d_bot>	<ggole> That's one benefit of a more lambda-calculus like IL, it's quite easy to do context-directed optimisations (of which commuting is probably the most significant)
+2021-06-04 14:39:37	zozozo>	yeah, but then again, I don't think commuting is really something that we want to do in flambda2
+2021-06-04 14:39:39	d_bot>	<ggole> But there are downsides with scope
+2021-06-04 14:39:55	d_bot>	<colin> will flambda2 carry through to faithful CPS compilation or what
+2021-06-04 14:40:21	zozozo>	@colin : I'm not sure what you mean ?
+2021-06-04 14:41:00	d_bot>	<ggole> SML/NJ style CPS all the way? Seems unlikely.
+2021-06-04 14:41:03	d_bot>	<colin> I've seen compilers that use CPS as an IR yet blast to something slightly different to compile to something that still uses a runtime stack
+2021-06-04 14:41:22	d_bot>	<colin> Yeah, I don't think SML/NJ or MLton can be described as using CPS to much of an extent nowadays tbh
+2021-06-04 14:41:57	d_bot>	<ggole> I thought SML/NJ still used that for their `Cont` implementation
+2021-06-04 14:41:57	zozozo>	ah well, the flambda IR is in CPS, but there will be no change to the other IR of the compiler, so that's that, ^^
+2021-06-04 14:43:13	d_bot>	<colin> is the Apply_cont constructor in this cps.ml file representing "contificated"/static continuations?
+2021-06-04 14:43:43	zozozo>	yeah, it represents static continuations bound previously by a Let_cont
+2021-06-04 14:43:59	d_bot>	<colin> interesting, I've only ever seen the IR presented in Appel's CwC book
+2021-06-04 14:44:30	d_bot>	<ggole> There's a nice paper on an CPS IR a bit like this that you might be interested in
+2021-06-04 14:44:36	d_bot>	<colin> is it by Kennedy
+2021-06-04 14:44:42	d_bot>	<ggole> Yeah
+2021-06-04 14:44:56	d_bot>	<colin> yeah, I've seen that as well actually, it's the one most people seem to go with I think
+2021-06-04 14:45:17	d_bot>	<ggole> Makes a lot of sense if you aren't supporting call/cc
+2021-06-04 14:45:18	companion_cube>	zozozo: what comes after flambda? something with a control flow graph already?
+2021-06-04 14:45:36	zozozo>	companion_cube: after flambda, it's cmm
+2021-06-04 14:46:07	d_bot>	<colin> been a while since I've toyed with CPSing compilers because very few go the full mile with the whole "no runtime stack" - they go the chicken route and use it as a GC nursery because they can't get their C compiler to do the strict (tail) call -> jumps that CPS requires and LLVM certainly can't handle CPS so you're just stuck writing your own back-end each time
+2021-06-04 14:46:17	zozozo>	(fun factoid: cmm quite literraly means C minus minus, :p )
+2021-06-04 14:46:56	d_bot>	<ggole> If the continuations are second class as in this example, then you can probably linearise to SSA fairly successfully
+2021-06-04 14:47:25	companion_cube>	hmm so cmm still has function calls and expressions, but no types, right?
+2021-06-04 14:47:33	d_bot>	<colin> I just think going from ANF -> LLVM (SSA) is simpler
+2021-06-04 14:47:41	d_bot>	<ggole> Although there's the usual complications of closure conversion and whatnot because LLVM is first order
+2021-06-04 14:48:10	d_bot>	<colin> Oleg seems to have some strong views on actually doing faithful compilation of CPS as well, along the lines of "whole-program continuations are never useful" and uh "the garbage collector doesn't like this" etc. paraphrasing (perhaps inaccurately) here
+2021-06-04 14:48:21	zozozo>	companion_cube: cmm has very minimal types (basically it says whether a value can/should be scanned)
+2021-06-04 14:48:39	d_bot>	<ggole> Well, CPS as a compiler IL is a different storly to exposing continuations reified as functions
+2021-06-04 14:48:42	companion_cube>	yeah, that's not typing ;)
+2021-06-04 14:49:20	companion_cube>	but there you eliminate continuations again, right? towards some sort of static jump, like local exceptions?
+2021-06-04 14:49:27	zozozo>	yup
+2021-06-04 14:49:38	zozozo>	cmm has static jumps and flambda continuations maps perfectly to that
+2021-06-04 14:49:50	zozozo>	(ofc continuations that are used exactly once can be inlined)
+2021-06-04 14:50:23	companion_cube>	right
+2021-06-04 14:50:32	d_bot>	<ggole> Either a return or a jump
+2021-06-04 14:50:36	d_bot>	<colin> this discussion is urging me to actually go and read Shivers' k-CFA stuff since I've always just avoided any real detail/proposed benefit of program transformations in CPS
+2021-06-04 14:50:39	companion_cube>	you can still use static jumps for patmathc and stuff
+2021-06-04 14:50:54	d_bot>	<ggole> Or maybe an exception handler if double-barrelled CPS
+2021-06-04 14:51:18	zozozo>	flambda actually has double-barrelled CPS
+2021-06-04 14:51:22	zozozo>	(flambda2)
+2021-06-04 14:51:47	d_bot>	<ggole> That makes sense, rather than duplicating all of the control constructs
+2021-06-04 14:51:51	d_bot>	<ggole> And optims on them
+2021-06-04 14:52:40	d_bot>	<colin> what's double-barrelled, just doing the CPS twice?
+2021-06-04 14:52:58	companion_cube>	wait
+2021-06-04 14:53:03	companion_cube>	does the second handler also work for effects?
+2021-06-04 14:53:10	companion_cube>	or wolud there be a third handler?
+2021-06-04 14:53:11	d_bot>	<ggole> Along with the usual return continuation you pass another continuation which is the error/exn path
+2021-06-04 14:53:42	d_bot>	<colin> ah
+2021-06-04 14:54:19	zozozo>	companion_cube: effects as in algebraic effects (cf multicore) ?
+2021-06-04 14:54:29	companion_cube>	yes
+2021-06-04 14:54:34	companion_cube>	runtime effects anyway
+2021-06-04 14:54:38	companion_cube>	the one shot continuations :)
+2021-06-04 14:54:43	zozozo>	that's a very good question
+2021-06-04 14:55:21	companion_cube>	I think exceptions will just be another effect, except in the type system, so you can probably only have 2
+2021-06-04 14:55:22	d_bot>	<colin> who funds OCamlPro? INRIA? Jane Street? or is it its own company
+2021-06-04 14:57:27	d_bot>	<Christophe> I have a question about the change log of 4.13. The change "type check x |> f and f @@ x as (f x) ` is marked as breaking change. What are the consequences of that change actually? (sorry for interrupting a very interesting conversation)
+2021-06-04 14:59:15	companion_cube>	it might change a few things in a subtle way
+2021-06-04 14:59:22	companion_cube>	like `f x` can be `f ?a ?b x`
+2021-06-04 14:59:26	companion_cube>	if f has optional arguments
+2021-06-04 14:59:43	zozozo>	@colin : OCamlPro is its own company, and janestreet is one client of ocamlpro
+2021-06-04 15:00:51	d_bot>	<colin> Ah, I see, I was looking at compiler jobs at Jane Street (wishful thinking) but now they don't seem like they'd be as interesting as this flambda2 stuff (unless there's some ties between both companies)
+2021-06-04 15:01:19	d_bot>	<Christophe> Ah yes, I didn't think of optional arguments, thanks!
+2021-06-04 15:01:37	companion_cube>	aren't they funding flambda2? :D
+2021-06-04 15:01:37	zozozo>	@colin : well, the work on flambda2 is funded by JaneStreet, ^^
+2021-06-04 15:41:47	d_bot>	<EduardoRFS> type check of `x |> f` as `f x` is something I was not expecting but I really appreciate
+2021-06-04 15:42:00	d_bot>	<EduardoRFS> now we need to type check `let x = y` in the opposite order
+2021-06-04 15:43:25	d_bot>	<EduardoRFS> can we implement this kind of subtyping or would it be unsound?
+2021-06-04 15:43:26	d_bot>	<EduardoRFS> ```ocaml
+2021-06-04 15:43:27	d_bot>	<EduardoRFS> module X : sig
+2021-06-04 15:43:28	d_bot>	<EduardoRFS>   type 'a t = private 'a
+2021-06-04 15:43:30	d_bot>	<EduardoRFS> end = struct
+2021-06-04 15:43:31	d_bot>	<EduardoRFS>   type 'a t = 'a
+2021-06-04 15:43:32	d_bot>	<EduardoRFS> end
+2021-06-04 15:43:34	d_bot>	<EduardoRFS> let add (a : int X.t) (b : int) = a + b
+2021-06-04 15:43:35	d_bot>	<EduardoRFS> ```
+2021-06-04 16:03:27	d_bot>	<octachron> This is already implemented, with an explicit coercion as usual: `let add a b = (a:int X.t:>int) + b`
+2021-06-04 19:56:48	hackinghorn>	hi
+2021-06-04 19:57:03	hackinghorn>	how do I run commands like ls for linux in ocaml?
+2021-06-04 19:59:38	dh`>	there's a binding for system() somewhere
+2021-06-04 19:59:40	hackinghorn>	oh, fileutils work
+2021-06-04 19:59:56	hackinghorn>	got it, thanks
+2021-06-04 23:15:51	d_bot>	<EduardoRFS> Why not implicit?
+2021-06-04 23:20:48	companion_cube>	There are no implicit coercions in ocaml 
+2021-06-04 23:51:53	d_bot>	<dj charlie> 👀 nice to see the stdlib increasingly fleshed out feels good
+2021-06-05 00:39:14	companion_cube>	like what?
+2021-06-05 00:57:05	d_bot>	<dj charlie> like fold_left and fold_right with the strings
+2021-06-05 00:57:12	d_bot>	<dj charlie> the math functions for floats
+2021-06-05 01:05:15	companion_cube>	Lolol ok
+2021-06-05 01:05:33	companion_cube>	Fold on string, heh? 
+2021-06-05 01:05:43	companion_cube>	Forgot that that wasn't there
+2021-06-05 01:06:10	d_bot>	<dj charlie> hey guy who wrote his own stdlib
+2021-06-05 01:06:13	d_bot>	<dj charlie> it's pretty cool to me ok?
+2021-06-05 07:50:23	companion_cube>	:D it is, it is
+2021-06-05 09:57:02	tane>	howdy! found the way
+2021-06-05 11:46:29	d_bot>	<giga_08> anyone familiar with ocaml verification? termination in particular
+2021-06-05 12:03:08	d_bot>	<darrenldl> small code or large projects?
+2021-06-05 12:41:30	d_bot>	<giga_08> small code
+2021-06-05 13:02:29	companion_cube>	@giga_08 you could give a look at try.imandra.ai (it's proprietary but termination checking is def. sth interesting)
+2021-06-05 18:18:14	d_bot>	<TheSkeward> learning ocaml and I occasionally giggle to myself because "O Caml! My Camel!" will pop into my head like a line from some sort of desert-themed walt whitman poem
+2021-06-05 18:19:38	companion_cube>	`my $camel` sounds more like perl, tbh
+2021-06-05 18:21:20	d_bot>	<TheSkeward> perls before swine
+2021-06-05 23:22:45	kluk>	how do I start using DynArray? I tried include DynArray, include Extlib, nothing works
+2021-06-05 23:23:07	companion_cube>	you need to have it in your dune file, if you use dune
+2021-06-05 23:23:10	companion_cube>	and to install it in the first place
+2021-06-05 23:24:09	kluk>	I don't know what dune is yet, I'm still a beginner at OCaml. how do I install DynArray? with opam right?
+2021-06-05 23:24:51	companion_cube>	hmmm if you're  that beginner, maybe take a look at a book 
+2021-06-05 23:24:55	companion_cube>	there's a lot to explain :/
+2021-06-05 23:26:43	kluk>	I just wanted to play around on the ocaml repl with some arrays... not looking for making a project, folders, dune stuff, any of that, if possible to avoid at this point. Is it possible to just play with the OCaml language to learn it and not worry about how it mixes up with unix?
+2021-06-05 23:27:56	companion_cube>	ah well, sure, just type `ocaml`
+2021-06-05 23:28:07	companion_cube>	but Dynarray is a 3rd party library for vectors/resizable arrays
+2021-06-05 23:28:16	companion_cube>	it's not exactly a central type in OCaml :
+2021-06-05 23:28:17	companion_cube>	:p
+2021-06-05 23:29:14	kluk>	yes I can get to the repl, but I wanted to play with arrays first without worrying about packages, does that make sense? I wanted to explore OCaml the language first, like a try.ocaml.org sort of thing if that makes sense... I wanted to have some fun with the language and learn it and not have to think about packages and managing projects for a little
+2021-06-05 23:30:40	kluk>	I need a stack whose elements can be randomly accessed by an integer so I just happen to have an exact use case for arrays, but I am open to suggestions
+2021-06-05 23:34:07	companion_cube>	arrays are in the stdlib
+2021-06-05 23:34:17	companion_cube>	not dynamic arrays
+2021-06-05 23:34:31	companion_cube>	but yeah, a stack with indexing is a good use case
+2021-06-05 23:34:55	kluk>	companion_cube :)
+2021-06-06 00:03:27	d_bot>	<Bluddy> IMO vectors should replace arrays as a primary data type in the language
+2021-06-06 00:04:29	companion_cube>	why "replace"?
+2021-06-06 00:04:42	companion_cube>	I think it'd be nice to be able to build them safely
+2021-06-06 00:04:47	d_bot>	<Bluddy> as the *primary* data type
+2021-06-06 00:04:51	companion_cube>	but otherwise, they have some overhead
+2021-06-06 00:05:03	companion_cube>	arrays are simpler as they're always fully initialized
+2021-06-06 00:05:11	d_bot>	<Bluddy> yeah the overhead is very minor though
+2021-06-06 00:05:34	d_bot>	<Bluddy> very few languages have arrays as their primary data structure
+2021-06-06 00:05:48	d_bot>	<Bluddy> python's lists are vectors
+2021-06-06 00:05:49	companion_cube>	I mean… java?
+2021-06-06 00:06:12	companion_cube>	I think the problem is the GC, because in a vector you need some unitialized space
+2021-06-06 00:06:15	companion_cube>	even in rust it's quite dirty
+2021-06-06 00:06:46	d_bot>	<Bluddy> hmm
+2021-06-06 00:07:10	companion_cube>	it's hard to do well without a bit of Obj currently :/
+2021-06-06 00:08:53	d_bot>	<Bluddy> ok so I guess python/ruby's bias may be due to their reference counting
+2021-06-06 00:09:11	companion_cube>	also they're insanely high level and slow :p
+2021-06-06 00:09:39	d_bot>	<Bluddy> yeah but that's beside the point. java has array, c# has array vs List (really a vector)
+2021-06-06 00:09:54	companion_cube>	java has ArrayList, but only for boxed types
+2021-06-06 00:09:59	companion_cube>	the primitive on the JVM is arrays, same as OCaml
+2021-06-06 00:10:07	companion_cube>	(except with unsound variance)
+2021-06-06 00:10:12	d_bot>	<Bluddy> right
+2021-06-06 00:10:30	d_bot>	<Bluddy> ok so yeah I think I'm just using python too much recently
+2021-06-06 00:11:00	d_bot>	<Bluddy> javascript also has array as its primary type
+2021-06-06 00:11:07	companion_cube>	remember that in OCaml, an array is *one* word of overhead
+2021-06-06 00:11:12	d_bot>	<Bluddy> so are python and ruby really the exceptions?
+2021-06-06 00:11:26	companion_cube>	as far as primitive types go? I'm not sure
+2021-06-06 00:13:25	d_bot>	<EduardoRFS> JS arrays are dynamic arrays / vectors
+2021-06-06 00:13:34	d_bot>	<EduardoRFS> and the implementation of it is really all over the place
+2021-06-06 00:13:51	d_bot>	<Bluddy> perl has dynamic arrays. also reference counted
+2021-06-06 00:14:18	companion_cube>	_scripting languages_ were primitives are all in C
+2021-06-06 00:15:51	d_bot>	<Bluddy> interesting. and it's gc'd.
+2021-06-06 00:16:30	d_bot>	<Bluddy> @companion_cube GC is only an issue if you don't have a bit to tell the GC not to scan the uninitialized memory. If OCaml had it, it wouldn't be an issue.
+2021-06-06 00:16:58	companion_cube>	sure, if you entirely rewrite the GC so it's not just based on the initial tag… :p
+2021-06-06 00:17:13	d_bot>	<EduardoRFS> but JS objects nowadays operates like OCaml blocks, adding and removing field is generally a bad idea because of the types, while it is possible that can trigger a whole lot of compiled and optimized code to be invalidated
+2021-06-06 00:17:15	d_bot>	<Bluddy> hmm.. no I guess you need to build it into the GC process itself so it knows how to process the vector
+2021-06-06 00:17:24	d_bot>	<Bluddy> so it looks at length vs capacity
+2021-06-06 00:17:26	d_bot>	<EduardoRFS> well we can extend the object header
+2021-06-06 00:17:26	companion_cube>	(well for a vector you'd need to fit 2 sizes in one, basically: capacity, and actual size)
+2021-06-06 00:17:35	d_bot>	<EduardoRFS> I'm looking on it during the shower
+2021-06-06 00:17:52	d_bot>	<Bluddy> yeah a bit is not enough, you need to teach the GC about a new kind of object
+2021-06-06 00:18:00	companion_cube>	also remember that vectors are 2 levels of indirection, not one
+2021-06-06 00:18:06	companion_cube>	one to the {len,capacity,ptr}
+2021-06-06 00:18:12	companion_cube>	+ the pointer itself
+2021-06-06 00:18:31	companion_cube>	but you've got to have this level of indirection so you can change the underlying array/pointer
+2021-06-06 00:19:02	d_bot>	<Bluddy> that's true
+2021-06-06 00:19:36	companion_cube>	so that's non trivial overhead compared to a basic array, when all you need is an array
+2021-06-06 00:19:53	d_bot>	<EduardoRFS> but that access can be mostly reduced if you know the cell size at compile time
+2021-06-06 00:19:56	d_bot>	<Bluddy> the problem is that you very rarely need an array
+2021-06-06 00:20:38	d_bot>	<Bluddy> if your primary type is a list, all an array gives you is mutability + O(1) access to any element. it's good, but the lack of ability to extend it is annoying
+2021-06-06 00:20:46	d_bot>	<Bluddy> if you're doing mutable stuff, you almost always want to extend it
+2021-06-06 00:20:56	companion_cube>	idk, it's nice in ASTs for example
+2021-06-06 00:21:03	companion_cube>	I agree that often a vector is also useful
+2021-06-06 00:22:19	d_bot>	<EduardoRFS> I wonder if having an unrolled linked list with some tricks wouldn't be enough for almost all cases
+2021-06-06 00:22:53	companion_cube>	for mutable stuff we just should have a good vector
+2021-06-06 00:22:59	d_bot>	<EduardoRFS> like couple cells all cache aligned + pointers to additional cells if they were created all together so that you can do O(1) after a List.map
+2021-06-06 00:23:03	companion_cube>	for immutable stuff, we _could_ use HAMT… but well
+2021-06-06 00:25:01	d_bot>	<EduardoRFS> copy on write is the solution to all problems
+2021-06-06 00:25:11	companion_cube>	noooo :D
+2021-06-06 00:27:33	d_bot>	<EduardoRFS> computers are fun, nowadays you have an ALU and caching inside of the MMU
+2021-06-06 00:28:05	d_bot>	<EduardoRFS> lisp machine to rule them all
+2021-06-06 00:51:48	d_bot>	<Bluddy> companion_cube: what do you do to prevent the GC from scanning the uninitialized vector area?
+2021-06-06 00:53:27	d_bot>	<EduardoRFS> If it is set to 0x0 the GC should just behave normally, it's a block of tag 0, size 0
+2021-06-06 00:57:50	companion_cube>	@Bluddy in containers, indeed, I fill the vector with 0
+2021-06-06 00:58:03	companion_cube>	or 0.0 if it's a float array 🙄
+2021-06-06 01:34:37	d_bot>	<Bluddy> ugh yeah that's bad
+2021-06-06 01:34:57	companion_cube>	not like we have a better option, imhp
+2021-06-06 01:34:59	companion_cube>	imho
+2021-06-06 01:37:39	d_bot>	<Bluddy> I wonder what other languages do
+2021-06-06 01:37:44	d_bot>	<Bluddy> ones with GC
+2021-06-06 01:40:49	companion_cube>	well, java fills with null I imagine
+2021-06-06 01:40:54	companion_cube>	boxed primitives and all that
+2021-06-06 01:41:03	companion_cube>	D… probably does ugly stuff?
+2021-06-06 01:41:10	companion_cube>	Go has 0 values for all types, so that's easy
+2021-06-06 01:41:31	companion_cube>	and the scripting stuff has nil/None/whatever to fill the blanks
+2021-06-06 01:42:17	d_bot>	<Bluddy> at the Obj level it would be nice if you could have a contiguous array where the size is the length, and right after that you'd place a string header with the remaining size
+2021-06-06 01:42:38	companion_cube>	you'd have to move the header every time you push/pop? :/
+2021-06-06 01:42:48	d_bot>	<Bluddy> not a huge deal. same cache line
+2021-06-06 01:43:07	companion_cube>	ideally push should be as simple and inlineable as possible :p
+2021-06-06 01:43:53	d_bot>	<Bluddy> still pretty simple. copy header over, reduce string size
+2021-06-06 01:44:34	companion_cube>	+ code path for possible resize… that's a lot more than just a normal push
+2021-06-06 01:44:37	d_bot>	<Bluddy> pop doesn't need to do anything because you can just zero data out at that point
+2021-06-06 01:45:12	d_bot>	<Bluddy> that code path is there regardless
+2021-06-06 01:45:38	d_bot>	<Bluddy> a multi-push function can be more efficient as it can do the header copy once
+2021-06-06 01:45:59	companion_cube>	pop still needs to copy the header back
+2021-06-06 01:46:58	d_bot>	<Bluddy> yeah I guess that's true. the only annoying thing about the header is the size counter
+2021-06-06 01:47:20	companion_cube>	I'd rather wish OCaml had a primitive for partially initialized arrays, and that's it
+2021-06-06 01:47:22	d_bot>	<Bluddy> but it should be doable with a couple of instructions
+2021-06-06 01:47:43	d_bot>	<Bluddy> well that's not going to happen anytime soon
+2021-06-06 01:48:23	d_bot>	<Bluddy> it can happen in the 64-bit runtime, but the 32-bit cannot handle it
+2021-06-06 01:48:38	d_bot>	<Bluddy> because you need that extra header space for the size
+2021-06-06 01:48:39	companion_cube>	not sure how that's related :p
+2021-06-06 01:49:03	companion_cube>	I just want an API for the array with a valid 0 inside
+2021-06-06 01:49:16	companion_cube>	that doesn't force me to Obj.magic to see if it's a float array or normal array
+2021-06-06 01:49:16	d_bot>	<Bluddy> valid 0?
+2021-06-06 01:49:26	companion_cube>	a valid object for this array
+2021-06-06 01:49:42	companion_cube>	a valid object for this array, _as seen by the GC_
+2021-06-06 01:51:38	d_bot>	<Bluddy> is this another wish? to deal more easily with float arrays? or is it related?
+2021-06-06 01:51:58	companion_cube>	it's related because it's the only reason I have to use Obj in containers :p
+2021-06-06 01:52:04	companion_cube>	(or one of the few, I can't remember)
+2021-06-06 01:52:20	companion_cube>	to be able to implement a vector
+2021-06-06 01:52:39	d_bot>	<Bluddy> but it doesn't deal with this particular issue
+2021-06-06 01:52:47	d_bot>	<Bluddy> I mean they're phasing out float arrays
+2021-06-06 01:52:57	companion_cube>	yeah that'll be nice
+2021-06-06 01:53:16	companion_cube>	without float arrays one could always fill the array with 0
+2021-06-06 01:53:29	companion_cube>	since the GC doesn't mind 0
+2021-06-06 01:53:55	d_bot>	<Bluddy> yeah I see that piece of code now
+2021-06-06 01:54:12	d_bot>	<Bluddy> let fill_with_junk_ (a:_ array) i len : unit =
+2021-06-06 01:54:15	companion_cube>	yep yep
+2021-06-06 01:54:27	d_bot>	<Bluddy> https://github.com/c-cube/ocaml-containers/blob/95e96fb5e12558fa5b1e907a8e315d8c859c23b8/src/core/CCVector.ml#L27
+2021-06-06 01:54:29	companion_cube>	always interested in better ideas
+2021-06-06 02:04:20	d_bot>	<ggole> For 64-bit machine zero (not OCaml zero) is fine for float arrays as well
+2021-06-06 02:05:07	d_bot>	<ggole> So you might be able to get away with coercing to `float array` and then filling with `0.0`
+2021-06-06 02:05:26	d_bot>	<ggole> However, the recent `FloatArray` stuff might kill that idea
+2021-06-06 02:08:30	d_bot>	<ggole> The no naked pointer changes might also be trouble
+2021-06-06 03:32:21	d_bot>	<aotmr> Hi everyone! I'm a 3rd-year CS student making personal explorations into programming languages with an emphasis on functional and concatenative languages, as well as metaprogramming and optimizing compilers.
+2021-06-06 03:33:32	d_bot>	<aotmr> I'm currently using OCaml to build a functional FORTH interpreter that I hope to shape into a general optimizing FORTH compiler
+2021-06-06 03:33:49	d_bot>	<aotmr> And right now I'm investigating to what extent I can express FORTH concepts in OCaml
+2021-06-06 03:42:01	d_bot>	<ggole> Hmm, they're pretty different
+2021-06-06 03:43:21	d_bot>	<ggole> OCaml code is very variable heavy, which seems to be at odds with the Forth philosophy of communicating between tiny bits with the stack
+2021-06-06 03:43:38	d_bot>	<aotmr> So, for example, inside my VM state is a list representing the current data stack.
+2021-06-06 03:43:38	d_bot>	<aotmr> ```ocaml
+2021-06-06 03:43:40	d_bot>	<aotmr> type state = {
+2021-06-06 03:43:41	d_bot>	<aotmr>     ds : Int.t list;
+2021-06-06 03:43:42	d_bot>	<aotmr>     (* ... *)
+2021-06-06 03:43:44	d_bot>	<aotmr> }
+2021-06-06 03:43:45	d_bot>	<aotmr> ```
+2021-06-06 03:43:46	d_bot>	<aotmr> Stack-based interpreters are excellent matches for programming languages with pattern matching facilities, as it turns out.
+2021-06-06 03:44:15	d_bot>	<aotmr> ```ocaml
+2021-06-06 03:44:16	d_bot>	<aotmr> type opcode =
+2021-06-06 03:44:17	d_bot>	<aotmr>     | Lit of Int.t
+2021-06-06 03:44:19	d_bot>	<aotmr>     | Add
+2021-06-06 03:44:20	d_bot>	<aotmr>     | Dot
+2021-06-06 03:44:21	d_bot>	<aotmr>     (* ... *)
+2021-06-06 03:44:23	d_bot>	<aotmr> ```
+2021-06-06 03:44:41	d_bot>	<aotmr> Let's define a small opcode set for our VM: push a literal to the stack, add the top two on the stack, and print the top on the stack (`Dot`)
+2021-06-06 03:46:01	d_bot>	<aotmr> Now, here's where OCaml's list matching becomes very elegant. Let's define a function, `execute`, that takes a state and an opcode and returns a new state that reflects having executed the opcode.
+2021-06-06 03:46:01	d_bot>	<aotmr> ```ocaml
+2021-06-06 03:46:03	d_bot>	<aotmr> let execute st = function
+2021-06-06 03:46:04	d_bot>	<aotmr> | Lit i -> { st with ds = i::st.ds }
+2021-06-06 03:46:05	d_bot>	<aotmr> | Add -> (* ... *)
+2021-06-06 03:46:07	d_bot>	<aotmr> | Dot -> (* ... *)
+2021-06-06 03:46:08	d_bot>	<aotmr> ```
+2021-06-06 03:46:32	d_bot>	<colin> awaiting the IRC users who'll ask you to read the channel description
+2021-06-06 03:46:43	d_bot>	<aotmr> Aw shit 🤦‍♂️
+2021-06-06 03:46:49	d_bot>	<colin> :p
+2021-06-06 03:46:52	zozozo>	@aotmr : code blocks from discord do not render great on the irc side of this channel, so it'd be best if you could use some paste website to link to code when there are more than a few lines, ^^
+2021-06-06 03:46:59	d_bot>	<aotmr> There it is
+2021-06-06 03:47:08	zozozo>	haha, XD
+2021-06-06 03:47:32	d_bot>	<aotmr> Well all that goes to say
+2021-06-06 03:47:32	d_bot>	<aotmr> You can express stack operations using pattern matching.
+2021-06-06 03:48:43	d_bot>	<colin> if you think that's cute, you'll like a similar idea in dependent typing where you can express stack changes (as a list) indexing the opcodes or something similar
+2021-06-06 03:48:44	d_bot>	<aotmr> For example, to swap the top two items on the stack, you'd use the record update syntax
+2021-06-06 03:48:45	d_bot>	<aotmr> `{ st with ds = match st.ds with a:🅱️:tl -> b:🅰️:tl | _ -> assert false }`
+2021-06-06 03:48:46	d_bot>	<aotmr> Last code block for the time being, I promise 😅
+2021-06-06 03:49:17	d_bot>	<aotmr> (And you can also use `let` matching, I've found, but I can't get ocaml to stop complaining even though I fully understand it'll crash if there aren't enough elements)
+2021-06-06 03:49:30	d_bot>	<aotmr> Oh, have a paper on that?
+2021-06-06 03:49:54	d_bot>	<aotmr> I'm wanting to see how high-level I can get with forth and still generate good code for small microprocessors--say, for NES and game boy dev
+2021-06-06 03:50:06	d_bot>	<colin> no, just thought it was very cute when I studied Agda at university, relevant construction of Hutton's razor can be found at https://github.com/fredrikNordvallForsberg/CS410-20/blob/master/Coursework/Two.agda#L492-L506 what you're saying just reminded me of it, not really relevant just in case you wanted to see cute things
+2021-06-06 03:50:15	zozozo>	@aotmr : small one-line blocks of code (like your last one) are mostly okay I'd say, ^^
+2021-06-06 03:50:48	d_bot>	<aotmr> Oh I'll look at it never the less, thanks.
+2021-06-06 03:50:49	d_bot>	<aotmr> Forth has its own concept of combinators and I want to try to compile those efficiently
+2021-06-06 03:52:04	d_bot>	<aotmr> Honestly I'd say OCaml is distantly related to FORTH just usagewise, there's a similar concept of "pipelining". Where in FORTH you'd write a series of words, passing state between them implicitly on the stack, you do the same in Ocaml when expressing a `|>` or `@@` pipeline
+2021-06-06 03:54:16	d_bot>	<aotmr> This is an interesting idea as, while FORTH is typically untyped, I could use this concept to track the entire lifetimes of values throughout a program
+2021-06-06 03:55:20	d_bot>	<colin> it's just a nice encoding of how the stack ought to change, helps the type system help you implement it correctly (though not a full specification by any means, just a cute stack requirement)
+2021-06-06 03:55:27	d_bot>	<ggole> There are some interesting typed concatenative langs
+2021-06-06 03:55:47	d_bot>	<ggole> Kitten and Cat
+2021-06-06 03:55:48	d_bot>	<aotmr> I've finally taken the forth-pill so to speak because I finally understand how to implement a compiler for the language
+2021-06-06 03:56:18	d_bot>	<colin> a whole new world.mp3 https://llvm.moe/
+2021-06-06 03:56:29	d_bot>	<colin> see past stack-based paradigm
+2021-06-06 03:56:58	d_bot>	<aotmr> Well, once I have a compiler for a stack-based VM that opens the door to using it as an intermediate representation
+2021-06-06 03:57:14	d_bot>	<colin> would there be any benefit
+2021-06-06 03:57:27	d_bot>	<colin> I, admittedly, have never seen the appeal of stack-based languages for general programming
+2021-06-06 03:57:32	d_bot>	<colin> I used to write postscript by hand recreationally
+2021-06-06 03:57:35	d_bot>	<colin> but that's about it
+2021-06-06 03:57:46	d_bot>	<aotmr> It's admittedly kind of recreational
+2021-06-06 03:58:10	d_bot>	<aotmr> I think the real strength is in the way you can build an entire system from the ground up by hand and know every moving part
+2021-06-06 03:59:32	d_bot>	<aotmr> You could write an optimizing compiler x86 in, oh, a month
+2021-06-06 04:00:51	d_bot>	<colin> sadly the majority of back-end optimisations for x86 are really just suffering
+2021-06-06 04:00:59	d_bot>	<aotmr> OCaml's own VM is stack-based so it's kind of circular
+2021-06-06 04:01:09	d_bot>	<colin> yeah but that's just the bytecode OCaml stuff
+2021-06-06 04:01:12	d_bot>	<aotmr> Oh yeah no x86 is a horrible architecture to program for
+2021-06-06 04:01:19	d_bot>	<aotmr> Sure but it's still a neat thought
+2021-06-06 04:01:25	d_bot>	<aotmr> But I digress
+2021-06-06 04:01:28	d_bot>	<colin> I used to be confused as to why Xavier Leroy's earlier work seemed to focus rather specifically on bytecode stack machines as the target of Camls
+2021-06-06 04:01:51	d_bot>	<colin> but then someone said like "it was research into creating a tactic computational kernel for some proof assistant"
+2021-06-06 04:02:01	d_bot>	<colin> not sure how true that is, perhaps someone here can clarify if that's nonsense
+2021-06-06 04:02:07	d_bot>	<colin> and Xavier just really likes stack machines
+2021-06-06 04:02:56	d_bot>	<aotmr> So, it could be that you can take advantage of immutable VM states in unit testing
+2021-06-06 04:03:13	d_bot>	<aotmr> And using it to accelerate the general process
+2021-06-06 04:04:16	d_bot>	<aotmr> If you wanted to do an exhaustive search of the program P with inputs a, b, c..., you could run P over every possible value of a, b, c
+2021-06-06 04:05:19	d_bot>	<aotmr> That is, we're trying to find a, b, c... that causes P to fail
+2021-06-06 04:06:00	d_bot>	<ggole> There's actually some tooling for that
+2021-06-06 04:06:02	d_bot>	<ggole> See Crowbar
+2021-06-06 04:06:08	d_bot>	<aotmr> One way to speed up that process is to memoize the VM state, I think
+2021-06-06 04:06:44	d_bot>	<ggole> It's not exhaustive search, but coverage-feedback guided random generation
+2021-06-06 04:06:47	d_bot>	<aotmr> If we find a "success" set of (a, b, c...), we could maybe remember all of the previous states of the VM and if we ever encounter them again we can stop early
+2021-06-06 04:07:14	d_bot>	<aotmr> But that would blow up your space requirements for little speedup, I'd think
+2021-06-06 04:07:17	d_bot>	<colin> can see why that'd help (as a form of concolic execution) but I think the accepted reality in industry is that Google fuzz their own software over billions of instances using AFL on dozens of Google cloud instances and just consider that alright
+2021-06-06 04:08:00	d_bot>	<aotmr> My other use case is of a rewindable debugger where you can undo all the way back to the start of the program
+2021-06-06 04:08:51	d_bot>	<colin> time travel debugging is pretty cool
+2021-06-06 04:09:07	d_bot>	<aotmr> That also brings to mind the idea of a rewindable game engine, I think rewind mechanics are pretty cool in theory
+2021-06-06 04:09:12	d_bot>	<colin> I always wanted a clean injection mechanism for debugging
+2021-06-06 04:09:27	d_bot>	<colin> hot reloading debugging stubs, that kinda thing
+2021-06-06 04:09:54	d_bot>	<aotmr> I'm still not entirely familiar with the mechanics of debuggers
+2021-06-06 04:10:07	d_bot>	<colin> syscalls and suffering™️
+2021-06-06 04:10:36	d_bot>	<aotmr> I'm under the impression that, if you can execute from RAM, you can at least single-step on pretty much any CPU
+2021-06-06 04:11:58	d_bot>	<colin> yeah there's architectural single step stuff provided by most systems; *nix has PTRACE_SINGLESTEP
+2021-06-06 04:12:02	d_bot>	<aotmr> If you want to single-step the instruction at a given address, then you'd write some kind of "breakpoint" opcode (or, crudely, even just an absolute jump) directly following it, but you'd have to know the length of the opcode beforehand
+2021-06-06 04:12:27	d_bot>	<aotmr> But I'd hope consumer CPUs can single-step in silicon by now 😅
+2021-06-06 04:12:28	d_bot>	<colin> variable length encoding is just one part of suffering in writing x86(_64) tooling, yes
+2021-06-06 04:12:42	d_bot>	<aotmr> Oh yeah I guess debugging has to be infinitely easier on a fixed-length RISC
+2021-06-06 04:13:14	d_bot>	<aotmr> Imagine if x86 had an instruction that only decoded the length of an instruction at a given address
+2021-06-06 04:13:18	d_bot>	<colin> I suppose there's other challenges, given the domain where RISC microprocessors are probably most prevalently being debugged
+2021-06-06 04:13:39	d_bot>	<colin> who knows, they might, Intel has a ton of hidden instructions and their manual doesn't even document some of them accurately
+2021-06-06 04:13:46	d_bot>	<aotmr> You're right, there probably is.
+2021-06-06 04:14:06	d_bot>	<ggole> There's tons of hardware support for debugging
+2021-06-06 04:14:09	d_bot>	<colin> it's common for trampoline hooking code to come with a "variable length decoder" as a form of minimal disassembler
+2021-06-06 04:14:13	d_bot>	<ggole> Watch registers and that kind of thing
+2021-06-06 04:14:26	d_bot>	<ggole> Pretty complicated from what I understand
+2021-06-06 04:14:27	d_bot>	<colin> to know how many bytes to replace w/ their placed `jmp` or `push ...; ret` etc.
+2021-06-06 04:16:26	d_bot>	<colin> but yeah, can't lie
+2021-06-06 04:16:34	d_bot>	<colin> confused how we went from stack langs to all this
+2021-06-06 04:16:58	d_bot>	<colin> what is your ambition, aotmr, to write a forth interpreter/compiler?
+2021-06-06 04:19:34	d_bot>	<aotmr> Just to do it, I guess. I think it's interesting to build a software stack nearly from the bottom up--or nearly so
+2021-06-06 04:19:53	d_bot>	<colin> what, in Forth?
+2021-06-06 04:20:04	d_bot>	<aotmr> I mean, build a Forth itself from the bottom up
+2021-06-06 04:20:14	d_bot>	<colin> oh alright
+2021-06-06 04:20:29	d_bot>	<aotmr> In theory it can even be possible to replace the Ocaml parts with Forth themselves
+2021-06-06 04:21:15	d_bot>	<aotmr> Though "bootstrapping"
+2021-06-06 04:21:47	d_bot>	<aotmr> First, I'd write a forth compiler in ocaml
+2021-06-06 04:22:07	d_bot>	<aotmr> Then, translate the compiler to forth
+2021-06-06 04:22:17	d_bot>	<aotmr> Compile the compiler-in-forth with the compiler-in-ocaml
+2021-06-06 04:22:30	d_bot>	<aotmr> And then I have a forth compiler, compiled and written in forth
+2021-06-06 04:22:36	d_bot>	<colin> can graduate to something hacky like JITing the FORTH then using C FFI to map the code and somehow return opaque caml values back to the user as callables within OCaml
+2021-06-06 04:22:55	d_bot>	<colin> galaxy brain interplay
+2021-06-06 04:23:14	d_bot>	<aotmr> That sounds terrifying
+2021-06-06 04:23:22	d_bot>	<colin> -ly based
+2021-06-06 04:23:28	d_bot>	<aotmr> You got it
+2021-06-06 04:23:44	d_bot>	<colin> don't actually know if you can do that
+2021-06-06 04:23:52	d_bot>	<colin> on the conceptual level, you certainly can with enough hacks
+2021-06-06 04:24:21	d_bot>	<aotmr> Probably the easiest way to "JIT" stack code is just to apply peephole optimization
+2021-06-06 04:24:34	d_bot>	<colin> can't lie, I hate stacks
+2021-06-06 04:24:56	d_bot>	<aotmr> The compiler writer writes manual superwords that implement a series of smaller words in a faster way
+2021-06-06 04:26:26	d_bot>	<aotmr> For example, replacing `>r + r>` with the much shorter machine code for the equivalent sequence that just adds the top element of the stack to the third
+2021-06-06 04:42:07	d_bot>	<BobbyT> I’m just marinating in all these high level ideas
+2021-06-06 05:58:42	ralu>	I am trying to build infer, but I keep getting error about failed dune build. So i can not build dune. Has anyone has any pointers?
+2021-06-06 09:38:22	d_bot>	<Bluddy> What if we make it so a proper null pointer inside an array means the end of GC scanning?
+2021-06-06 10:32:24	d_bot>	<Drup> @Bluddy that's not compatible with a bunch of much more interesting representations improvements (like democratizing the Zarith hack, for instance)
+2021-06-06 10:52:39	d_bot>	<Deadrat> Would lightweight higher kinded types be added to ocaml in the future?
+2021-06-06 10:58:32	d_bot>	<xvw> With modular immlicits I guess that lightweight higher kinded types will be less useful
+2021-06-06 11:08:02	d_bot>	<rbrott> There's a nice chapter on that idea in CPDT: <http://adam.chlipala.net/cpdt/html/Cpdt.StackMachine.html>
+2021-06-06 11:08:04	d_bot>	<Bluddy> @Drup could you explain the 'zarith hack'?
+2021-06-06 11:09:03	d_bot>	<Deadrat> But they are still years away as I understand?
+2021-06-06 11:09:35	d_bot>	<Drup> @Bluddy A value of type `Z.t` in zarith is either a normal ocaml integer (63bits usually, etc) or a GMP "big integers"
+2021-06-06 11:11:56	d_bot>	<Drup> This is achieved by considering the type morally as `int | Big of gmp`. OCaml integers already have a bit put aside for the GC to differentiate them from pointers, so we don't need an extra tag to differentiate between small integers and pointers to a big integer.
+2021-06-06 11:12:15	d_bot>	<Drup> This is only possible by going through the C FFI
+2021-06-06 11:12:29	d_bot>	<ggole> Machine zero isn't an `int` or a block though
+2021-06-06 11:15:09	d_bot>	<Drup> @ggole I can never remember if the tag for integers is 0 or 1.
+2021-06-06 11:17:58	d_bot>	<ggole> It's 1
+2021-06-06 11:18:24	d_bot>	<ggole> But even if it were zero, you could set aside a non-valid pointer value to indicate a truncation spot
+2021-06-06 11:20:59	d_bot>	<Drup> right, I'm not sure how much I like it, but it could work
+2021-06-06 11:26:30	d_bot>	<ggole> I guess there would have to be an `Array.unsafe_set_terminator` or something, which would be a bit nasty
+2021-06-06 11:26:41	d_bot>	<ggole> And I dunno what the interaction with bounds checking would be
+2021-06-06 11:27:07	d_bot>	<ggole> I suspect they would be more trouble than the terminator value itself though
+2021-06-06 11:49:23	d_bot>	<Bluddy> I need to try it out and see the performance difference.
+2021-06-06 11:51:38	d_bot>	<Bluddy> it's not automatically clear that setting all the memory is a bad idea
+2021-06-06 13:00:48	companion_cube>	I'd just like to point out that no one else uses a terminator for vectors, afaik
+2021-06-06 13:00:55	companion_cube>	it seems like a pretty bad idea :p
+2021-06-06 13:05:10	d_bot>	<ggole> Most of the other langs with vectors can handle uninitialised memory or keep the bits there without leaks
+2021-06-06 13:06:34	companion_cube>	and again, it's not that common
+2021-06-06 13:06:57	companion_cube>	languages that compile to native and have a GC and don't rely on C to implement a ton of datastructures are not plenty
+2021-06-06 13:47:15	d_bot>	<aotmr> I'm still not entirely used to building data structures in any language *but* C, to be honest--it feels strange
+2021-06-06 13:47:52	d_bot>	<aotmr> I probably just don't have practice because C is the only language that I use that doesn't have a dynamic array, really
+2021-06-06 13:48:49	companion_cube>	well OCaml is excellent for implementing a lot of data structures
+2021-06-06 13:49:01	companion_cube>	vectors just happen to be a bit on the low-level, unsafe memory thingie side
+2021-06-06 13:51:37	d_bot>	<aotmr> What's a good way to map from a discriminated union to successive integers?
+2021-06-06 13:51:43	d_bot>	<aotmr> And the other way around?
+2021-06-06 13:53:53	companion_cube>	ppx_deriving.enum maybe?
+2021-06-06 13:54:02	companion_cube>	if it's an enum, without payload on the variants, that is.
+2021-06-06 13:57:14	d_bot>	<aotmr> Hmm
+2021-06-06 13:57:14	d_bot>	<aotmr> Here's a simpler question: how do I get the "tag" of a sum type?
+2021-06-06 13:57:41	companion_cube>	you don't :)
+2021-06-06 13:57:45	d_bot>	<aotmr> I figure I can quickly map integers to most of the opcodes and then manually handle opcodes with a payload
+2021-06-06 13:57:47	companion_cube>	it's not really specified in the language.
+2021-06-06 13:57:48	d_bot>	<aotmr> Oh...
+2021-06-06 13:57:52	d_bot>	<octachron> The simpler and most forward-compatible way is to write the function.
+2021-06-06 13:58:11	d_bot>	<aotmr> True, but then I'd have to write two functions and keep them in sync manually, or generate the code.
+2021-06-06 13:58:35	d_bot>	<aotmr> *sigh* Okay then
+2021-06-06 13:58:37	companion_cube>	the function from integers to variants seems impossible to write
+2021-06-06 13:58:45	companion_cube>	if they have payloads that is
+2021-06-06 13:58:56	d_bot>	<aotmr> I'd be converting from a packed representation
+2021-06-06 14:01:41	companion_cube>	your best chance is codegen indeed
+2021-06-06 14:01:53	companion_cube>	variant to int: generate a pattern matching function
+2021-06-06 14:02:10	companion_cube>	int+payload to variant: well, match on the int I guess
+2021-06-06 14:04:58	d_bot>	<aotmr> Actually wait, I'm wrong
+2021-06-06 14:04:58	d_bot>	<aotmr> I shouldn't have written the VM with a discriminated union like this anyways
+2021-06-06 14:05:13	d_bot>	<aotmr> But, I guess I might as well keep a separate encoded and decoded form
+2021-06-06 14:10:07	companion_cube>	a VM seems like a good use case for C or C++ or rust, ironically
+2021-06-06 14:23:33	d_bot>	<aotmr> Oh it's definitely more appropriate, but I'm actually making some headway
+2021-06-06 14:24:11	d_bot>	<aotmr> I haven't played with ocaml in quite some time (OS issues--it didn't work well on Windows for me until quite recently)
+2021-06-06 14:24:23	companion_cube>	glad to hear it works better now
+2021-06-06 14:24:45	d_bot>	<aotmr> I mean, it works better now because it's running in WSL 😆
+2021-06-06 14:25:44	d_bot>	<aotmr> So I'm happy that I remember how to build list to list mappings that produce and consume varying numbers of elements
+2021-06-06 15:08:24	d_bot>	<aotmr> Cool, so I've figured out how to build an encoder and decoder for a variable-length instruction stream
+2021-06-06 18:00:25	kluk>	I get "Error: Unbound module Batteries" after doing open Batteries;; on the ocaml repl after having done opam install batteries. what am I missing?
+2021-06-06 18:04:03	companion_cube>	#require "batteries";;
+2021-06-06 18:04:12	companion_cube>	(and possibly, before that, #use "topfind";;)
+2021-06-06 18:07:13	kluk>	Ahhh.. it wasn't clear to me that #use was needed to bring #require but now that I ran it I can see in its blurb that it does do that. Thank you very much.
+2021-06-06 18:07:49	companion_cube>	also note that if you use `utop` it does the topfind thing directly
+2021-06-06 18:08:03	companion_cube>	you can also put the blurb in ~/.ocamlinit
+2021-06-06 18:11:31	kluk>	companion_cube thank you for the .ocamlinit tip
+2021-06-06 18:27:10	kluk>	companion_cube so now I can use DynArray from Batteries just fine :) thanks so much for the help once again.
+2021-06-06 18:35:30	companion_cube>	heh

fuzz/ccsexp_csexp_reparse.ml

@@ -0,0 +1,17 @@
+let gen_sexp =
+  let open! Crowbar in
+  let ( >|= ) = map in
+  fix (fun self ->
+      choose
+        [
+          (([ bytes ] : _ gens) >|= fun s -> `Atom s);
+          ([ list self ] >|= fun l -> `List l);
+        ])
+
+let () =
+  Crowbar.add_test ~name:"ccsexp_csexp_reparse" [ gen_sexp ] (fun s ->
+      let str = CCCanonical_sexp.to_string s in
+      match CCCanonical_sexp.parse_string_list str with
+      | Ok [ s2 ] -> assert (s = s2)
+      | Ok _ -> failwith "wrong number of sexps"
+      | Error e -> failwith e)

fuzz/ccsexp_parse_string_does_not_crash.ml

@@ -0,0 +1,3 @@
+let () =
+  Crowbar.add_test ~name:"ccsexp_parse_string_does_not_crash" [ Crowbar.bytes ]
+    (fun s -> CCSexp.parse_string s |> ignore)

fuzz/ccutf8_string_uchar_to_bytes_is_same_as_simple_version.ml

@@ -0,0 +1,148 @@
+let simple_uchar_to_string (c : Uchar.t) : string =
+  let c = Uchar.to_int c in
+  let bits =
+    Array.make 64 false
+    |> Array.mapi (fun i _ -> Int.shift_right c (63 - i) land 0x1 <> 0)
+  in
+  let char_of_bit_list bits =
+    let bits = Array.of_list bits in
+    assert (Array.length bits = 8);
+    let res = ref 0 in
+    for i = 0 to 7 do
+      if bits.(i) then res := !res lor (0x1 lsl (7 - i))
+    done;
+    Char.chr !res
+  in
+  let get_start_from_right i = Array.get bits (63 - i) in
+  let chars =
+    if c <= 0x7F then
+      [
+        [
+          false;
+          get_start_from_right 6;
+          get_start_from_right 5;
+          get_start_from_right 4;
+          get_start_from_right 3;
+          get_start_from_right 2;
+          get_start_from_right 1;
+          get_start_from_right 0;
+        ];
+      ]
+    else if c <= 0x7FF then
+      [
+        [
+          true;
+          true;
+          false;
+          get_start_from_right 10;
+          get_start_from_right 9;
+          get_start_from_right 8;
+          get_start_from_right 7;
+          get_start_from_right 6;
+        ];
+        [
+          true;
+          false;
+          get_start_from_right 5;
+          get_start_from_right 4;
+          get_start_from_right 3;
+          get_start_from_right 2;
+          get_start_from_right 1;
+          get_start_from_right 0;
+        ];
+      ]
+    else if c <= 0xFFFF then
+      [
+        [
+          true;
+          true;
+          true;
+          false;
+          get_start_from_right 15;
+          get_start_from_right 14;
+          get_start_from_right 13;
+          get_start_from_right 12;
+        ];
+        [
+          true;
+          false;
+          get_start_from_right 11;
+          get_start_from_right 10;
+          get_start_from_right 9;
+          get_start_from_right 8;
+          get_start_from_right 7;
+          get_start_from_right 6;
+        ];
+        [
+          true;
+          false;
+          get_start_from_right 5;
+          get_start_from_right 4;
+          get_start_from_right 3;
+          get_start_from_right 2;
+          get_start_from_right 1;
+          get_start_from_right 0;
+        ];
+      ]
+    else if c <= 0x10FFFF then
+      [
+        [
+          true;
+          true;
+          true;
+          true;
+          false;
+          get_start_from_right 20;
+          get_start_from_right 19;
+          get_start_from_right 18;
+        ];
+        [
+          true;
+          false;
+          get_start_from_right 17;
+          get_start_from_right 16;
+          get_start_from_right 15;
+          get_start_from_right 14;
+          get_start_from_right 13;
+          get_start_from_right 12;
+        ];
+        [
+          true;
+          false;
+          get_start_from_right 11;
+          get_start_from_right 10;
+          get_start_from_right 9;
+          get_start_from_right 8;
+          get_start_from_right 7;
+          get_start_from_right 6;
+        ];
+        [
+          true;
+          false;
+          get_start_from_right 5;
+          get_start_from_right 4;
+          get_start_from_right 3;
+          get_start_from_right 2;
+          get_start_from_right 1;
+          get_start_from_right 0;
+        ];
+      ]
+    else
+      failwith "Unexpected case"
+  in
+  chars |> List.map char_of_bit_list |> List.to_seq |> String.of_seq
+
+let () =
+  Crowbar.add_test
+    ~name:"ccutf8_string_uchar_to_bytes_is_same_as_simple_version"
+    [ Crowbar.range (succ 0x10FFFF) ]
+    (fun c ->
+      Crowbar.guard (Uchar.is_valid c);
+      let c = Uchar.of_int c in
+      let simple_answer = simple_uchar_to_string c in
+      let answer =
+        let buf = ref [] in
+        CCUtf8_string.uchar_to_bytes c (fun c -> buf := c :: !buf);
+        !buf |> List.rev |> List.to_seq |> String.of_seq
+      in
+      Crowbar.check_eq simple_answer answer)

fuzz/clean.sh

@@ -0,0 +1,6 @@
+#!/bin/bash
+
+script_dir=$(dirname $(readlink -f "$0"))
+
+rm -r "$script_dir"/../fuzz-*-input
+rm -r "$script_dir"/../fuzz-*-output

fuzz/dune

@@ -0,0 +1,9 @@
+(executables
+ (flags
+  (-w "+a-4-9-29-37-40-42-44-48-50-32-70" -g))
+ (names
+  ccsexp_parse_string_does_not_crash
+  ccutf8_string_uchar_to_bytes_is_same_as_simple_version
+  ccsexp_csexp_reparse)
+ (optional)
+ (libraries crowbar containers))

fuzz/list.sh

@@ -0,0 +1,15 @@
+#!/bin/bash
+
+script_dir=$(dirname $(readlink -f "$0"))
+
+echo "Building"
+
+dune build @all
+
+echo ""
+
+echo "Fuzzing tests available:"
+
+for file in "$script_dir"/../_build/default/fuzz/*.exe; do
+  echo "- "$(basename $file | sed 's/\.exe$//')
+done

fuzz/run.sh

@@ -0,0 +1,37 @@
+#!/bin/bash
+
+script_dir=$(dirname $(readlink -f "$0"))
+
+skip_build=$2
+
+if [[ "$skip_build" != "skip_build" ]]; then
+  echo "Building"
+
+  dune build @all
+fi
+
+if [[ "$1" == "" ]]; then
+  echo "Please enter a fuzzing test to run"
+  exit 1
+fi
+
+name=$(echo "$1" | sed 's/\.exe$//' | sed 's/\.ml$//')
+
+echo "Creating input directory"
+
+input_dir="$script_dir"/../"fuzz-""$name""-input"
+
+output_dir="$script_dir"/../"fuzz-""$name""-output"
+
+mkdir -p "$input_dir"
+
+echo "abcd" > "$input_dir"/dummy
+
+if [ -d "$output_dir" ]; then
+  afl-fuzz -t 1000 -i -            -o "$output_dir" "$script_dir"/../_build/default/fuzz/"$name".exe @@
+else
+  mkdir -p "$output_dir"
+
+  afl-fuzz -t 1000 -i "$input_dir" -o "$output_dir" "$script_dir"/../_build/default/fuzz/"$name".exe @@
+fi
+

fuzz/run_all.sh

@@ -0,0 +1,126 @@
+#!/bin/bash
+
+cpu_count=$(grep -c ^processor /proc/cpuinfo)
+
+simul_test_count=$[cpu_count-1]
+
+test_timeout="10m"
+
+script_dir=$(dirname $(readlink -f "$0"))
+
+log_dir="$script_dir"/../fuzz-logs
+
+echo "Building"
+
+dune build @all
+
+echo ""
+
+start_date=$(date "+%Y-%m-%d %H:%M")
+start_time=$(date "+%s")
+
+names=()
+
+i=0
+for file in "$script_dir"/../_build/default/fuzz/*.exe; do
+  name=$(basename $file | sed 's/\.exe$//')
+  names[$i]=$name
+  i=$[i+1]
+done
+
+test_count=${#names[@]}
+
+echo "Fuzzing tests available:"
+
+for name in ${names[@]}; do
+  echo "- "$name
+done
+
+echo ""
+echo "Fuzzing start time:" $start_date
+echo ""
+
+echo "Starting $test_count tests"
+echo ""
+
+mkdir -p "$log_dir"
+
+i=0
+while (( $i < $test_count )); do
+  if (( $test_count - $i >= $simul_test_count )); then
+    tests_to_run=$simul_test_count
+  else
+    tests_to_run=$[test_count - i]
+  fi
+
+  echo "Running $tests_to_run tests in parallel"
+
+  for (( c=0; c < $tests_to_run; c++ )); do
+    name=${names[$i]}
+    if [[ "$name" != "" ]]; then
+      echo "  Starting $name"
+
+      (AFL_NO_UI=1 timeout "$test_timeout" "$script_dir"/run.sh "$name" skip_build > "$log_dir"/"$name".log) &
+
+      i=$[i+1]
+    fi
+  done
+
+  echo "Waiting for $test_timeout"
+
+  sleep $test_timeout
+
+  echo "Terminating tests"
+
+  pkill afl-fuzz
+
+  sleep 5
+
+  echo ""
+  echo "$[test_count - i] / $test_count tests remaining"
+  echo ""
+done
+
+end_date=$(date "+%Y-%m-%d %H:%M")
+end_time=$(date "+%s")
+
+echo ""
+echo "Test end:" $end_date
+
+echo ""
+
+echo "Time elapsed:" $[(end_time - start_time) / 60] "minutes"
+
+test_fail_count=0
+tests_failed=()
+
+for name in ${names[@]}; do
+  output_dir="$script_dir"/../"fuzz-""$name""-output"
+
+  crashes_dir="$output_dir"/crashes
+
+  if [ -z "$(ls -A $crashes_dir)" ]; then
+    # crashes dir is empty
+    :
+  else
+    # crashes dir is not empty
+    test_fail_count=$[$test_fail_count + 1]
+    tests_failed+=("$name")
+  fi
+done
+
+echo "========================================"
+
+if [[ $test_fail_count == 0 ]]; then
+    echo "All $test_count tests passed"
+    exit_code=0
+else
+    echo "$test_fail_count tests failed"
+    echo ""
+    echo "List of tests failed :"
+    for t in ${tests_failed[@]}; do
+      echo "    "$t
+    done
+    exit_code=1
+fi
+

myocamlbuild.ml

@@ -1,692 +0,0 @@
-(* OASIS_START *)
-(* DO NOT EDIT (digest: b119194f5742ac2f3cdceac9a223dda7) *)
-module OASISGettext = struct
-(* # 22 "src/oasis/OASISGettext.ml" *)
-
-
-  let ns_ str =
-    str
-
-
-  let s_ str =
-    str
-
-
-  let f_ (str: ('a, 'b, 'c, 'd) format4) =
-    str
-
-
-  let fn_ fmt1 fmt2 n =
-    if n = 1 then
-      fmt1^^""
-    else
-      fmt2^^""
-
-
-  let init =
-    []
-
-
-end
-
-module OASISExpr = struct
-(* # 22 "src/oasis/OASISExpr.ml" *)
-
-
-
-
-
-  open OASISGettext
-
-
-  type test = string
-
-
-  type flag = string
-
-
-  type t =
-    | EBool of bool
-    | ENot of t
-    | EAnd of t * t
-    | EOr of t * t
-    | EFlag of flag
-    | ETest of test * string
-
-
-
-  type 'a choices = (t * 'a) list
-
-
-  let eval var_get t =
-    let rec eval' =
-      function
-        | EBool b ->
-            b
-
-        | ENot e ->
-            not (eval' e)
-
-        | EAnd (e1, e2) ->
-            (eval' e1) && (eval' e2)
-
-        | EOr (e1, e2) ->
-            (eval' e1) || (eval' e2)
-
-        | EFlag nm ->
-            let v =
-              var_get nm
-            in
-              assert(v = "true" || v = "false");
-              (v = "true")
-
-        | ETest (nm, vl) ->
-            let v =
-              var_get nm
-            in
-              (v = vl)
-    in
-      eval' t
-
-
-  let choose ?printer ?name var_get lst =
-    let rec choose_aux =
-      function
-        | (cond, vl) :: tl ->
-            if eval var_get cond then
-              vl
-            else
-              choose_aux tl
-        | [] ->
-            let str_lst =
-              if lst = [] then
-                s_ "<empty>"
-              else
-                String.concat
-                  (s_ ", ")
-                  (List.map
-                     (fun (cond, vl) ->
-                        match printer with
-                          | Some p -> p vl
-                          | None -> s_ "<no printer>")
-                     lst)
-            in
-              match name with
-                | Some nm ->
-                    failwith
-                      (Printf.sprintf
-                         (f_ "No result for the choice list '%s': %s")
-                         nm str_lst)
-                | None ->
-                    failwith
-                      (Printf.sprintf
-                         (f_ "No result for a choice list: %s")
-                         str_lst)
-    in
-      choose_aux (List.rev lst)
-
-
-end
-
-
-# 132 "myocamlbuild.ml"
-module BaseEnvLight = struct
-(* # 22 "src/base/BaseEnvLight.ml" *)
-
-
-  module MapString = Map.Make(String)
-
-
-  type t = string MapString.t
-
-
-  let default_filename =
-    Filename.concat
-      (Sys.getcwd ())
-      "setup.data"
-
-
-  let load ?(allow_empty=false) ?(filename=default_filename) () =
-    if Sys.file_exists filename then
-      begin
-        let chn =
-          open_in_bin filename
-        in
-        let st =
-          Stream.of_channel chn
-        in
-        let line =
-          ref 1
-        in
-        let st_line =
-          Stream.from
-            (fun _ ->
-               try
-                 match Stream.next st with
-                   | '\n' -> incr line; Some '\n'
-                   | c -> Some c
-               with Stream.Failure -> None)
-        in
-        let lexer =
-          Genlex.make_lexer ["="] st_line
-        in
-        let rec read_file mp =
-          match Stream.npeek 3 lexer with
-            | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
-                Stream.junk lexer;
-                Stream.junk lexer;
-                Stream.junk lexer;
-                read_file (MapString.add nm value mp)
-            | [] ->
-                mp
-            | _ ->
-                failwith
-                  (Printf.sprintf
-                     "Malformed data file '%s' line %d"
-                     filename !line)
-        in
-        let mp =
-          read_file MapString.empty
-        in
-          close_in chn;
-          mp
-      end
-    else if allow_empty then
-      begin
-        MapString.empty
-      end
-    else
-      begin
-        failwith
-          (Printf.sprintf
-             "Unable to load environment, the file '%s' doesn't exist."
-             filename)
-      end
-
-
-  let rec var_expand str env =
-    let buff =
-      Buffer.create ((String.length str) * 2)
-    in
-      Buffer.add_substitute
-        buff
-        (fun var ->
-           try
-             var_expand (MapString.find var env) env
-           with Not_found ->
-             failwith
-               (Printf.sprintf
-                  "No variable %s defined when trying to expand %S."
-                  var
-                  str))
-        str;
-      Buffer.contents buff
-
-
-  let var_get name env =
-    var_expand (MapString.find name env) env
-
-
-  let var_choose lst env =
-    OASISExpr.choose
-      (fun nm -> var_get nm env)
-      lst
-end
-
-
-# 237 "myocamlbuild.ml"
-module MyOCamlbuildFindlib = struct
-(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
-
-
-  (** OCamlbuild extension, copied from
-    * http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild
-    * by N. Pouillard and others
-    *
-    * Updated on 2009/02/28
-    *
-    * Modified by Sylvain Le Gall
-    *)
-  open Ocamlbuild_plugin
-
-  type conf =
-    { no_automatic_syntax: bool;
-    }
-
-  (* these functions are not really officially exported *)
-  let run_and_read =
-    Ocamlbuild_pack.My_unix.run_and_read
-
-
-  let blank_sep_strings =
-    Ocamlbuild_pack.Lexers.blank_sep_strings
-
-
-  let exec_from_conf exec =
-    let exec =
-      let env_filename = Pathname.basename BaseEnvLight.default_filename in
-      let env = BaseEnvLight.load ~filename:env_filename ~allow_empty:true () in
-      try
-        BaseEnvLight.var_get exec env
-      with Not_found ->
-        Printf.eprintf "W: Cannot get variable %s\n" exec;
-        exec
-    in
-    let fix_win32 str =
-      if Sys.os_type = "Win32" then begin
-        let buff = Buffer.create (String.length str) in
-        (* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'.
-         *)
-        String.iter
-          (fun c -> Buffer.add_char buff (if c = '\\' then '/' else c))
-          str;
-        Buffer.contents buff
-      end else begin
-        str
-      end
-    in
-      fix_win32 exec
-
-  let split s ch =
-    let buf = Buffer.create 13 in
-    let x = ref [] in
-    let flush () =
-      x := (Buffer.contents buf) :: !x;
-      Buffer.clear buf
-    in
-      String.iter
-        (fun c ->
-           if c = ch then
-             flush ()
-           else
-             Buffer.add_char buf c)
-        s;
-      flush ();
-      List.rev !x
-
-
-  let split_nl s = split s '\n'
-
-
-  let before_space s =
-    try
-      String.before s (String.index s ' ')
-    with Not_found -> s
-
-  (* ocamlfind command *)
-  let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x]
-
-  (* This lists all supported packages. *)
-  let find_packages () =
-    List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list"))
-
-
-  (* Mock to list available syntaxes. *)
-  let find_syntaxes () = ["camlp4o"; "camlp4r"]
-
-
-  let well_known_syntax = [
-    "camlp4.quotations.o";
-    "camlp4.quotations.r";
-    "camlp4.exceptiontracer";
-    "camlp4.extend";
-    "camlp4.foldgenerator";
-    "camlp4.listcomprehension";
-    "camlp4.locationstripper";
-    "camlp4.macro";
-    "camlp4.mapgenerator";
-    "camlp4.metagenerator";
-    "camlp4.profiler";
-    "camlp4.tracer"
-  ]
-
-
-  let dispatch conf =
-    function
-      | After_options ->
-          (* By using Before_options one let command line options have an higher
-           * priority on the contrary using After_options will guarantee to have
-           * the higher priority override default commands by ocamlfind ones *)
-          Options.ocamlc     := ocamlfind & A"ocamlc";
-          Options.ocamlopt   := ocamlfind & A"ocamlopt";
-          Options.ocamldep   := ocamlfind & A"ocamldep";
-          Options.ocamldoc   := ocamlfind & A"ocamldoc";
-          Options.ocamlmktop := ocamlfind & A"ocamlmktop";
-          Options.ocamlmklib := ocamlfind & A"ocamlmklib"
-
-      | After_rules ->
-
-          (* When one link an OCaml library/binary/package, one should use
-           * -linkpkg *)
-          flag ["ocaml"; "link"; "program"] & A"-linkpkg";
-
-          if not (conf.no_automatic_syntax) then begin
-            (* For each ocamlfind package one inject the -package option when
-             * compiling, computing dependencies, generating documentation and
-             * linking. *)
-            List.iter
-              begin fun pkg ->
-                let base_args = [A"-package"; A pkg] in
-                (* TODO: consider how to really choose camlp4o or camlp4r. *)
-                let syn_args = [A"-syntax"; A "camlp4o"] in
-                let (args, pargs) =
-                  (* Heuristic to identify syntax extensions: whether they end in
-                     ".syntax"; some might not.
-                  *)
-                  if Filename.check_suffix pkg "syntax" ||
-                     List.mem pkg well_known_syntax then
-                    (syn_args @ base_args, syn_args)
-                  else
-                    (base_args, [])
-                in
-                flag ["ocaml"; "compile";  "pkg_"^pkg] & S args;
-                flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
-                flag ["ocaml"; "doc";      "pkg_"^pkg] & S args;
-                flag ["ocaml"; "link";     "pkg_"^pkg] & S base_args;
-                flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
-
-                (* TODO: Check if this is allowed for OCaml < 3.12.1 *)
-                flag ["ocaml"; "compile";  "package("^pkg^")"] & S pargs;
-                flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs;
-                flag ["ocaml"; "doc";      "package("^pkg^")"] & S pargs;
-                flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs;
-              end
-              (find_packages ());
-          end;
-
-          (* Like -package but for extensions syntax. Morover -syntax is useless
-           * when linking. *)
-          List.iter begin fun syntax ->
-          flag ["ocaml"; "compile";  "syntax_"^syntax] & S[A"-syntax"; A syntax];
-          flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
-          flag ["ocaml"; "doc";      "syntax_"^syntax] & S[A"-syntax"; A syntax];
-          flag ["ocaml"; "infer_interface"; "syntax_"^syntax] &
-                S[A"-syntax"; A syntax];
-          end (find_syntaxes ());
-
-          (* The default "thread" tag is not compatible with ocamlfind.
-           * Indeed, the default rules add the "threads.cma" or "threads.cmxa"
-           * options when using this tag. When using the "-linkpkg" option with
-           * ocamlfind, this module will then be added twice on the command line.
-           *
-           * To solve this, one approach is to add the "-thread" option when using
-           * the "threads" package using the previous plugin.
-           *)
-          flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
-          flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
-          flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
-          flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]);
-          flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]);
-          flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]);
-          flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]);
-          flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]);
-
-      | _ ->
-          ()
-end
-
-module MyOCamlbuildBase = struct
-(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
-
-
-  (** Base functions for writing myocamlbuild.ml
-      @author Sylvain Le Gall
-    *)
-
-
-
-
-
-  open Ocamlbuild_plugin
-  module OC = Ocamlbuild_pack.Ocaml_compiler
-
-
-  type dir = string
-  type file = string
-  type name = string
-  type tag = string
-
-
-(* # 62 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
-
-
-  type t =
-      {
-        lib_ocaml: (name * dir list * string list) list;
-        lib_c:     (name * dir * file list) list;
-        flags:     (tag list * (spec OASISExpr.choices)) list;
-        (* Replace the 'dir: include' from _tags by a precise interdepends in
-         * directory.
-         *)
-        includes:  (dir * dir list) list;
-      }
-
-
-  let env_filename =
-    Pathname.basename
-      BaseEnvLight.default_filename
-
-
-  let dispatch_combine lst =
-    fun e ->
-      List.iter
-        (fun dispatch -> dispatch e)
-        lst
-
-
-  let tag_libstubs nm =
-    "use_lib"^nm^"_stubs"
-
-
-  let nm_libstubs nm =
-    nm^"_stubs"
-
-
-  let dispatch t e =
-    let env =
-      BaseEnvLight.load
-        ~filename:env_filename
-        ~allow_empty:true
-        ()
-    in
-      match e with
-        | Before_options ->
-            let no_trailing_dot s =
-              if String.length s >= 1 && s.[0] = '.' then
-                String.sub s 1 ((String.length s) - 1)
-              else
-                s
-            in
-              List.iter
-                (fun (opt, var) ->
-                   try
-                     opt := no_trailing_dot (BaseEnvLight.var_get var env)
-                   with Not_found ->
-                     Printf.eprintf "W: Cannot get variable %s\n" var)
-                [
-                  Options.ext_obj, "ext_obj";
-                  Options.ext_lib, "ext_lib";
-                  Options.ext_dll, "ext_dll";
-                ]
-
-        | After_rules ->
-            (* Declare OCaml libraries *)
-            List.iter
-              (function
-                 | nm, [], intf_modules ->
-                     ocaml_lib nm;
-                     let cmis =
-                       List.map (fun m -> (String.uncapitalize m) ^ ".cmi")
-                                intf_modules in
-                     dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis
-                 | nm, dir :: tl, intf_modules ->
-                     ocaml_lib ~dir:dir (dir^"/"^nm);
-                     List.iter
-                       (fun dir ->
-                          List.iter
-                            (fun str ->
-                               flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir]))
-                            ["compile"; "infer_interface"; "doc"])
-                       tl;
-                     let cmis =
-                       List.map (fun m -> dir^"/"^(String.uncapitalize m)^".cmi")
-                                intf_modules in
-                     dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"]
-                         cmis)
-              t.lib_ocaml;
-
-            (* Declare directories dependencies, replace "include" in _tags. *)
-            List.iter
-              (fun (dir, include_dirs) ->
-                 Pathname.define_context dir include_dirs)
-              t.includes;
-
-            (* Declare C libraries *)
-            List.iter
-              (fun (lib, dir, headers) ->
-                   (* Handle C part of library *)
-                   flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib]
-                     (S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib";
-                        A("-l"^(nm_libstubs lib))]);
-
-                   flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib]
-                     (S[A"-cclib"; A("-l"^(nm_libstubs lib))]);
-
-                   flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
-                     (S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
-
-                   (* When ocaml link something that use the C library, then one
-                      need that file to be up to date.
-                      This holds both for programs and for libraries.
-                    *)
-  		 dep ["link"; "ocaml"; tag_libstubs lib]
-  		     [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
-
-  		 dep  ["compile"; "ocaml"; tag_libstubs lib]
-  		      [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
-
-                   (* TODO: be more specific about what depends on headers *)
-                   (* Depends on .h files *)
-                   dep ["compile"; "c"]
-                     headers;
-
-                   (* Setup search path for lib *)
-                   flag ["link"; "ocaml"; "use_"^lib]
-                     (S[A"-I"; P(dir)]);
-              )
-              t.lib_c;
-
-              (* Add flags *)
-              List.iter
-              (fun (tags, cond_specs) ->
-                 let spec = BaseEnvLight.var_choose cond_specs env in
-                 let rec eval_specs =
-                   function
-                     | S lst -> S (List.map eval_specs lst)
-                     | A str -> A (BaseEnvLight.var_expand str env)
-                     | spec -> spec
-                 in
-                   flag tags & (eval_specs spec))
-              t.flags
-        | _ ->
-            ()
-
-
-  let dispatch_default conf t =
-    dispatch_combine
-      [
-        dispatch t;
-        MyOCamlbuildFindlib.dispatch conf;
-      ]
-
-
-end
-
-
-# 606 "myocamlbuild.ml"
-open Ocamlbuild_plugin;;
-let package_default =
-  {
-     MyOCamlbuildBase.lib_ocaml =
-       [
-          ("containers", ["src/core"], []);
-          ("containers_io", ["src/io"], []);
-          ("containers_unix", ["src/unix"], []);
-          ("containers_sexp", ["src/sexp"], []);
-          ("containers_data", ["src/data"], []);
-          ("containers_iter", ["src/iter"], []);
-          ("containers_string", ["src/string"], []);
-          ("containers_advanced", ["src/advanced"], []);
-          ("containers_bigarray", ["src/bigarray"], []);
-          ("containers_thread", ["src/threads"], []);
-          ("containers_top", ["src/top"], [])
-       ];
-     lib_c = [];
-     flags = [];
-     includes =
-       [
-          ("src/top",
-            [
-               "src/bigarray";
-               "src/core";
-               "src/data";
-               "src/iter";
-               "src/sexp";
-               "src/string";
-               "src/unix"
-            ]);
-          ("src/threads", ["src/core"]);
-          ("src/bigarray", ["src/core"]);
-          ("src/advanced", ["src/core"]);
-          ("qtest",
-            [
-               "src/advanced";
-               "src/bigarray";
-               "src/core";
-               "src/data";
-               "src/io";
-               "src/iter";
-               "src/sexp";
-               "src/string";
-               "src/threads";
-               "src/unix"
-            ]);
-          ("examples", ["src/sexp"]);
-          ("benchs",
-            [
-               "src/advanced";
-               "src/core";
-               "src/data";
-               "src/iter";
-               "src/string";
-               "src/threads"
-            ])
-       ]
-  }
-  ;;
-
-let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
-
-let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
-
-# 673 "myocamlbuild.ml"
-(* OASIS_STOP *)
-
-let doc_intro = "doc/intro.txt"
-
-open Ocamlbuild_plugin;;
-
-dispatch
-  (MyOCamlbuildBase.dispatch_combine [
-    begin function
-    | After_rules ->
-
-      (* Documentation index *)
-      dep ["ocaml"; "doc"; "extension:html"] & [doc_intro] ;
-      flag ["ocaml"; "doc"; "extension:html"]
-        & S[A"-t"; A"Containers doc"; A"-intro"; P doc_intro ];
-
-    | _ -> ()
-    end;
-    dispatch_default
-  ])

opam

@@ -1,44 +0,0 @@
-opam-version: "1.2"
-name: "containers"
-version: "dev"
-author: "Simon Cruanes"
-maintainer: "simon.cruanes@inria.fr"
-build: [
-    ["./configure"
-        "--prefix" prefix
-        "--disable-bench"
-        "--disable-tests"
-        "--%{base-unix:enable}%-unix"
-        "--enable-docs"
-    ]
-    [make "build"]
-]
-install: [
-    [make "install"]
-]
-build-doc: [ make "doc" ]
-build-test: [ make "test" ]
-remove: [
-    ["ocamlfind" "remove" "containers"]
-]
-depends: [
-  "ocamlfind" {build}
-  "oasis" {build}
-  "base-bytes"
-  "result"
-  "ocamlbuild" {build}
-]
-depopts: [
-  "base-unix"
-  "base-threads"
-  "qtest" { test }
-]
-conflicts: [
-  "sequence" { < "0.5" }
-]
-tags: [ "stdlib" "containers" "iterators" "list" "heap" "queue" ]
-homepage: "https://github.com/c-cube/ocaml-containers/"
-doc: "http://cedeela.fr/~simon/software/containers/"
-available: [ocaml-version >= "4.01.0"]
-dev-repo: "https://github.com/c-cube/ocaml-containers.git"
-bug-reports: "https://github.com/c-cube/ocaml-containers/issues/"

run_bench_hash.sh

@@ -0,0 +1,4 @@
+#!/bin/sh
+
+OPTS="--profile=release --display=quiet"
+exec dune exec $OPTS -- benchs/run_benchs_hash.exe $@

run_benchs.sh

@@ -0,0 +1,4 @@
+#!/bin/sh
+
+OPTS="--profile=release --display=quiet"
+exec dune exec $OPTS -- benchs/run_benchs.exe $@

setup.ml

@@ -1,32 +0,0 @@
-(* setup.ml generated for the first time by OASIS v0.4.4 *)
-
-(* OASIS_START *)
-(* DO NOT EDIT (digest: 1bc19e72587da58c1e1f99f847b509aa) *)
-(******************************************************************************)
-(* OASIS: architecture for building OCaml libraries and applications          *)
-(*                                                                            *)
-(* Copyright (C) 2011-2016, Sylvain Le Gall                                   *)
-(* Copyright (C) 2008-2011, OCamlCore SARL                                    *)
-(*                                                                            *)
-(* This library is free software; you can redistribute it and/or modify it    *)
-(* under the terms of the GNU Lesser General Public License as published by   *)
-(* the Free Software Foundation; either version 2.1 of the License, or (at    *)
-(* your option) any later version, with the OCaml static compilation          *)
-(* exception.                                                                 *)
-(*                                                                            *)
-(* This library is distributed in the hope that it will be useful, but        *)
-(* WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *)
-(* or FITNESS FOR A PARTICULAR PURPOSE. See the file COPYING for more         *)
-(* details.                                                                   *)
-(*                                                                            *)
-(* You should have received a copy of the GNU Lesser General Public License   *)
-(* along with this library; if not, write to the Free Software Foundation,    *)
-(* Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA              *)
-(******************************************************************************)
-
-open OASISDynRun
-
-let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t
-open BaseCompat.Compat_0_4
-(* OASIS_STOP *)
-let () = setup ();;

src/bencode/containers_bencode.ml

@@ -0,0 +1,183 @@
+module Str_map = Map.Make (String)
+
+type t =
+  | Int of int64
+  | String of string
+  | List of t list
+  | Map of t Str_map.t
+
+let rec equal t1 t2 =
+  match t1, t2 with
+  | Int i1, Int i2 -> i1 = i2
+  | String s1, String s2 -> s1 = s2
+  | List l1, List l2 ->
+    (try List.for_all2 equal l1 l2 with Invalid_argument _ -> false)
+  | Map d1, Map d2 -> Str_map.equal equal d1 d2
+  | (Int _ | String _ | List _ | Map _), _ -> false
+
+let rec hash t =
+  let module H = CCHash in
+  match t with
+  | Int i -> H.int64 i
+  | String s -> H.combine2 10 (H.string s)
+  | List l -> H.combine2 20 (H.list hash l)
+  | Map l ->
+    H.combine2 30
+      ( H.iter (H.pair H.string hash) @@ fun k ->
+        Str_map.iter (fun x y -> k (x, y)) l )
+
+let int64 i : t = Int i
+let int i : t = int64 (Int64.of_int i)
+let string s : t = String s
+let list l : t = List l
+let map m : t = Map m
+
+let map_of_list l : t =
+  map @@ List.fold_left (fun m (k, v) -> Str_map.add k v m) Str_map.empty l
+
+let rec pp_debug out (self : t) : unit =
+  let fpf = Format.fprintf in
+  match self with
+  | Int i -> fpf out "%Ld" i
+  | String s -> fpf out "%S" s
+  | List l ->
+    fpf out "[@[<hv>";
+    List.iteri
+      (fun i v ->
+        if i > 0 then fpf out ";@ ";
+        pp_debug out v)
+      l;
+    fpf out "@]]"
+  | Map m ->
+    fpf out "{@[<hv>";
+    let i = ref 0 in
+    Str_map.iter
+      (fun k v ->
+        if !i > 0 then fpf out ";@ ";
+        incr i;
+        fpf out "@[<1>%S:@ %a@]" k pp_debug v)
+      m;
+    fpf out "@]}"
+
+let to_string_debug self = Format.asprintf "%a" pp_debug self
+
+module Encode = struct
+  let bpf = Printf.bprintf
+  let fpf = Printf.fprintf
+
+  let rec to_buffer (buf : Buffer.t) (self : t) : unit =
+    let recurse = to_buffer buf in
+    let addc = Buffer.add_char in
+    match self with
+    | Int i -> bpf buf "i%Lde" i
+    | String s -> bpf buf "%d:%s" (String.length s) s
+    | List l ->
+      addc buf 'l';
+      List.iter recurse l;
+      addc buf 'e'
+    | Map l ->
+      addc buf 'd';
+      Str_map.iter
+        (fun k v -> bpf buf "%d:%s%a" (String.length k) k to_buffer v)
+        l;
+      addc buf 'e'
+
+  let to_string (self : t) : string =
+    let buf = Buffer.create 32 in
+    to_buffer buf self;
+    Buffer.contents buf
+
+  let rec to_chan (oc : out_channel) (self : t) : unit =
+    let recurse = to_chan oc in
+    let addc = output_char in
+    match self with
+    | Int i -> fpf oc "i%Lde" i
+    | String s -> fpf oc "%d:%s" (String.length s) s
+    | List l ->
+      addc oc 'l';
+      List.iter recurse l;
+      addc oc 'e'
+    | Map l ->
+      addc oc 'd';
+      Str_map.iter (fun k v -> fpf oc "%d:%s%a" (String.length k) k to_chan v) l;
+      addc oc 'e'
+
+  let to_fmt out self = Format.pp_print_string out (to_string self)
+end
+
+module Decode = struct
+  exception Fail
+
+  let of_string s =
+    let i = ref 0 in
+
+    let[@inline] check_not_eof () =
+      if !i >= String.length s then raise_notrace Fail
+    in
+
+    let rec top () : t =
+      check_not_eof ();
+      match String.unsafe_get s !i with
+      | 'l' ->
+        incr i;
+        read_list []
+      | 'd' ->
+        incr i;
+        read_map Str_map.empty
+      | 'i' ->
+        incr i;
+        let n = read_int 'e' true 0 in
+        int n
+      | '0' .. '9' -> String (parse_str_len ())
+      | _ -> raise_notrace Fail
+    (* read integer until char [stop] is met, consume [stop], return int *)
+    and read_int stop sign n : int =
+      check_not_eof ();
+      match String.unsafe_get s !i with
+      | c when c == stop ->
+        incr i;
+        if sign then
+          n
+        else
+          -n
+      | '-' when stop == 'e' && sign && n = 0 ->
+        incr i;
+        read_int stop false n
+      | '0' .. '9' as c ->
+        incr i;
+        read_int stop sign (Char.code c - Char.code '0' + (10 * n))
+      | _ -> raise_notrace Fail
+    and parse_str_len () : string =
+      let n = read_int ':' true 0 in
+      if !i + n > String.length s then raise_notrace Fail;
+      let s = String.sub s !i n in
+      i := !i + n;
+      s
+    and read_list acc =
+      check_not_eof ();
+      match String.unsafe_get s !i with
+      | 'e' ->
+        incr i;
+        List (List.rev acc)
+      | _ ->
+        let x = top () in
+        read_list (x :: acc)
+    and read_map acc =
+      check_not_eof ();
+      match String.unsafe_get s !i with
+      | 'e' ->
+        incr i;
+        Map acc
+      | _ ->
+        let k = parse_str_len () in
+        let v = top () in
+        read_map (Str_map.add k v acc)
+    in
+
+    try Some (top ()) with Fail -> None
+
+  let of_string_exn s =
+    match of_string s with
+    | Some x -> x
+    | None -> failwith "bencode.decode: invalid string"
+end

src/bencode/containers_bencode.mli

@@ -0,0 +1,44 @@
+(** Basic Bencode decoder/encoder.
+
+    See https://en.wikipedia.org/wiki/Bencode .
+
+    @since 3.8 *)
+
+module Str_map : module type of Map.Make (String)
+
+type t =
+  | Int of int64
+  | String of string
+  | List of t list
+  | Map of t Str_map.t
+
+val equal : t -> t -> bool
+val hash : t -> int
+
+val pp_debug : Format.formatter -> t -> unit
+(** Printer for diagnostic/human consumption *)
+
+val to_string_debug : t -> string
+val int : int -> t
+val int64 : int64 -> t
+val string : string -> t
+val list : t list -> t
+val map_of_list : (string * t) list -> t
+val map : t Str_map.t -> t
+
+(** Encoding *)
+module Encode : sig
+  val to_string : t -> string
+  val to_buffer : Buffer.t -> t -> unit
+  val to_chan : out_channel -> t -> unit
+  val to_fmt : Format.formatter -> t -> unit
+end
+
+(** Decoding *)
+module Decode : sig
+  val of_string : string -> t option
+
+  val of_string_exn : string -> t
+  (** Parse string.
+      @raise Failure if the string is not valid bencode. *)
+end

src/bencode/dune

@@ -0,0 +1,5 @@
+(library
+ (name containers_bencode)
+ (public_name containers.bencode)
+ (libraries containers)
+ (synopsis "Bencode codec for containers (the format for bittorrent files)"))

src/cbor/containers_cbor.ml

@@ -0,0 +1,323 @@
+module Fmt = CCFormat
+
+type t =
+  [ `Null
+  | `Undefined
+  | `Simple of int
+  | `Bool of bool
+  | `Int of int64
+  | `Float of float
+  | `Bytes of string
+  | `Text of string
+  | `Array of t list
+  | `Map of (t * t) list
+  | `Tag of int * t
+  ]
+
+let rec pp_diagnostic out (self : t) =
+  match self with
+  | `Null -> Fmt.string out "null"
+  | `Undefined -> Fmt.string out "undefined"
+  | `Simple i -> Fmt.fprintf out "simple(%d)" i
+  | `Bool b -> Fmt.bool out b
+  | `Int i -> Fmt.int64 out i
+  | `Float f -> Fmt.float out f
+  | `Bytes b -> Fmt.fprintf out "h'%s'" (CCString.to_hex b)
+  | `Text s -> Fmt.fprintf out "%S" s
+  | `Array l ->
+    Fmt.fprintf out "[@[";
+    List.iteri
+      (fun i x ->
+        if i > 0 then Fmt.fprintf out ",@ ";
+        pp_diagnostic out x)
+      l;
+    Fmt.fprintf out "@]]"
+  | `Map l ->
+    Fmt.fprintf out "{@[";
+    List.iteri
+      (fun i (k, v) ->
+        if i > 0 then Fmt.fprintf out ",@ ";
+        Fmt.fprintf out "@[%a:@ %a@]" pp_diagnostic k pp_diagnostic v)
+      l;
+    Fmt.fprintf out "@]}"
+  | `Tag (i, x) -> Fmt.fprintf out "%d(@[%a@])" i pp_diagnostic x
+
+let to_string_diagnostic (self : t) : string =
+  Format.asprintf "@[<h>%a@]" pp_diagnostic self
+
+exception Indefinite
+
+let[@inline] i64_to_int i =
+  let j = Int64.to_int i in
+  if Int64.(of_int j = i) then
+    j
+  else
+    failwith "int64 does not fit in int"
+
+let decode_exn (s : string) : t =
+  let b = Bytes.unsafe_of_string s in
+  let i = ref 0 in
+
+  (* currently at end delimiter? *)
+  let[@inline] is_break_stop_code () = Char.code s.[!i] = 0b111_11111 in
+
+  let[@inline] read_i8 () =
+    let c = Char.code s.[!i] in
+    incr i;
+    c
+  in
+
+  let[@inline] read_i16 () =
+    let c = Bytes.get_uint16_be b !i in
+    i := !i + 2;
+    c
+  in
+
+  let[@inline] read_i32 () =
+    let c = Bytes.get_int32_be b !i in
+    i := !i + 4;
+    c
+  in
+
+  let[@inline] read_i64 () =
+    let c = Bytes.get_int64_be b !i in
+    i := !i + 8;
+    c
+  in
+
+  let reserve_n n =
+    let j = !i in
+    if j + n > String.length s then failwith "cbor: cannot extract slice";
+    i := !i + n;
+    j
+  in
+
+  (* read integer value from least significant bits *)
+  let read_int ~allow_indefinite low =
+    match low with
+    | _ when low < 0 -> failwith "cbor: invalid length"
+    | _ when low < 24 -> Int64.of_int low
+    | 24 -> Int64.of_int (read_i8 ())
+    | 25 -> Int64.of_int (read_i16 ())
+    | 26 -> Int64.of_int32 (read_i32 ())
+    | 27 -> read_i64 ()
+    | 28 | 29 | 30 -> failwith "cbor: invalid length"
+    | 31 ->
+      if allow_indefinite then
+        raise_notrace Indefinite
+      else
+        failwith "cbor: invalid integer 31 in this context"
+    | _ -> assert false
+  in
+
+  (* appendix D
+
+     double decode_half(unsigned char *halfp) {
+       unsigned half = (halfp[0] << 8) + halfp[1];
+       unsigned exp = (half >> 10) & 0x1f;
+       unsigned mant = half & 0x3ff;
+       double val;
+       if (exp == 0) val = ldexp(mant, -24);
+       else if (exp != 31) val = ldexp(mant + 1024, exp - 25);
+       else val = mant == 0 ? INFINITY : NAN;
+       return half & 0x8000 ? -val : val;
+     }
+  *)
+  let decode_f16 (half : int) : float =
+    (* exponent is bits 15:10 *)
+    let exp = (half lsr 10) land 0x1f in
+    (* mantissa is bits 9:0 *)
+    let mant = half land 0x3ff in
+    let value =
+      if exp = 0 then
+        ldexp (float mant) (-24)
+      else if exp <> 31 then
+        ldexp (float (mant + 1024)) (exp - 25)
+      else if mant = 0 then
+        infinity
+      else
+        nan
+    in
+    if half land 0x8000 <> 0 then
+      -.value
+    else
+      value
+  in
+
+  (* roughly follow https://www.rfc-editor.org/rfc/rfc8949.html#pseudocode *)
+  let rec read_value () =
+    let c = read_i8 () in
+    let high = (c land 0b111_00000) lsr 5 in
+    let low = c land 0b000_11111 in
+    match high with
+    | 0 -> `Int (read_int ~allow_indefinite:false low)
+    | 1 ->
+      let i = read_int ~allow_indefinite:false low in
+      `Int Int64.(sub minus_one i)
+    | 2 ->
+      let s = read_bytes ~ty:`Bytes low in
+      `Bytes s
+    | 3 ->
+      let s = read_bytes ~ty:`String low in
+      `Text s
+    | 4 ->
+      let l =
+        match read_int ~allow_indefinite:true low |> i64_to_int with
+        | len -> List.init len (fun _ -> read_value ())
+        | exception Indefinite ->
+          let l = ref [] in
+          while not (is_break_stop_code ()) do
+            l := read_value () :: !l
+          done;
+          incr i;
+          (* consume stop code *)
+          List.rev !l
+      in
+      `Array l
+    | 5 ->
+      let l =
+        match read_int ~allow_indefinite:true low |> i64_to_int with
+        | len -> List.init len (fun _ -> read_pair ())
+        | exception Indefinite ->
+          let l = ref [] in
+          while not (is_break_stop_code ()) do
+            l := read_pair () :: !l
+          done;
+          incr i;
+          (* consume stop code *)
+          List.rev !l
+      in
+      `Map l
+    | 6 ->
+      let tag = read_int ~allow_indefinite:false low |> i64_to_int in
+      let v = read_value () in
+      `Tag (tag, v)
+    | 7 ->
+      (* simple or float,
+         https://www.rfc-editor.org/rfc/rfc8949.html#fpnocont *)
+      let i = read_int ~allow_indefinite:false low in
+      (match low with
+      | 20 -> `Bool false
+      | 21 -> `Bool true
+      | 22 -> `Null
+      | 23 -> `Undefined
+      | _ when low <= 24 -> `Simple (i64_to_int i)
+      | 25 ->
+        (* float16 *)
+        `Float (decode_f16 (Int64.to_int i))
+      | 26 ->
+        (* float 32 *)
+        `Float (Int32.float_of_bits (Int64.to_int32 i))
+      | 27 ->
+        (* float 64 *)
+        `Float (Int64.float_of_bits i)
+      | 28 | 29 | 30 -> failwith "cbor: malformed"
+      | 31 -> failwith "uncaught 'break' stop code"
+      | _ -> assert false (* unreachable *))
+    | _ ->
+      (* unreachable *)
+      assert false
+  and read_bytes ~ty low =
+    match read_int ~allow_indefinite:true low |> i64_to_int with
+    | exception Indefinite ->
+      let buf = Buffer.create 32 in
+      while not (is_break_stop_code ()) do
+        match read_value (), ty with
+        | `Text s, `String | `Bytes s, `Bytes -> Buffer.add_string buf s
+        | _ -> failwith "cbor: invalid chunk in indefinite length string/byte"
+      done;
+      incr i;
+      (* consume stop code *)
+      Buffer.contents buf
+    | len ->
+      let off = reserve_n len in
+      String.sub s off len
+  and read_pair () =
+    let k = read_value () in
+    let v = read_value () in
+    k, v
+  in
+  read_value ()
+
+let decode s = try Ok (decode_exn s) with Failure s -> Error s
+
+let encode ?(buf = Buffer.create 32) (self : t) : string =
+  Buffer.clear buf;
+
+  let[@inline] add_byte (high : int) (low : int) =
+    let i = (high lsl 5) lor low in
+    assert (i land 0xff == i);
+    Buffer.add_char buf (Char.unsafe_chr i)
+  in
+
+  let add_i64 (i : int64) = Buffer.add_int64_be buf i in
+
+  (* add unsigned integer, including first tag byte *)
+  let add_uint (high : int) (x : int64) =
+    assert (x >= 0L);
+    if x < 24L then
+      add_byte high (i64_to_int x)
+    else if x <= 0xffL then (
+      add_byte high 24;
+      Buffer.add_char buf (Char.unsafe_chr (i64_to_int x))
+    ) else if x <= 0xff_ffL then (
+      add_byte high 25;
+      Buffer.add_uint16_be buf (i64_to_int x)
+    ) else if x <= 0xff_ff_ff_ffL then (
+      add_byte high 26;
+      Buffer.add_int32_be buf (Int64.to_int32 x)
+    ) else (
+      add_byte high 27;
+      Buffer.add_int64_be buf x
+    )
+  in
+
+  let rec encode_val (self : t) : unit =
+    match self with
+    | `Bool false -> add_byte 7 20
+    | `Bool true -> add_byte 7 21
+    | `Null -> add_byte 7 22
+    | `Undefined -> add_byte 7 23
+    | `Simple i ->
+      if i < 24 then
+        add_byte 7 i
+      else if i <= 0xff then (
+        add_byte 7 24;
+        Buffer.add_char buf (Char.unsafe_chr i)
+      ) else
+        failwith "cbor: simple value too high (above 255)"
+    | `Float f ->
+      add_byte 7 27;
+      (* float 64 *)
+      add_i64 (Int64.bits_of_float f)
+    | `Array l ->
+      add_uint 4 (Int64.of_int (List.length l));
+      List.iter encode_val l
+    | `Map l ->
+      add_uint 5 (Int64.of_int (List.length l));
+      List.iter
+        (fun (k, v) ->
+          encode_val k;
+          encode_val v)
+        l
+    | `Text s ->
+      add_uint 3 (Int64.of_int (String.length s));
+      Buffer.add_string buf s
+    | `Bytes s ->
+      add_uint 2 (Int64.of_int (String.length s));
+      Buffer.add_string buf s
+    | `Tag (t, v) ->
+      add_uint 6 (Int64.of_int t);
+      encode_val v
+    | `Int i ->
+      if i >= Int64.zero then
+        add_uint 0 i
+      else if Int64.(add min_int 2L) > i then (
+        (* large negative int, be careful. encode [(-i)-1] via int64. *)
+        add_byte 1 27;
+        Buffer.add_int64_be buf Int64.(neg (add 1L i))
+      ) else
+        add_uint 1 Int64.(sub (neg i) one)
+  in
+  encode_val self;
+  Buffer.contents buf

src/cbor/containers_cbor.mli

@@ -0,0 +1,32 @@
+(** CBOR encoder/decoder.
+
+  The type is chosen to be compatible with ocaml-cbor.
+  See {{: https://www.rfc-editor.org/rfc/rfc8949.html} the RFC}.
+
+  {b note} this is experimental.
+
+  @since 3.9
+  *)
+
+type t =
+  [ `Null
+  | `Undefined
+  | `Simple of int
+  | `Bool of bool
+  | `Int of int64
+  | `Float of float
+  | `Bytes of string
+  | `Text of string
+  | `Array of t list
+  | `Map of (t * t) list
+  | `Tag of int * t
+  ]
+
+val pp_diagnostic : t CCFormat.printer
+val to_string_diagnostic : t -> string
+val encode : ?buf:Buffer.t -> t -> string
+val decode : string -> (t, string) result
+
+val decode_exn : string -> t
+(** Like {!decode}.
+    @raise Failure if the string isn't valid *)

src/cbor/dune

@@ -0,0 +1,7 @@
+(library
+ (name containers_cbor)
+ (libraries containers)
+ (preprocess
+  (action
+   (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
+ (public_name containers.cbor))

src/codegen/containers_codegen.ml

@@ -0,0 +1,143 @@
+(** {1 Code generators} *)
+
+module Fmt = CCFormat
+
+let spf = Printf.sprintf
+let fpf = Fmt.fprintf
+
+type code =
+  | Base of { pp: unit Fmt.printer }
+  | Struct of string * code list
+  | Sig of string * code list
+
+module Code = struct
+  type t = code
+
+  let in_struct m (cs : t list) : t = Struct (m, cs)
+  let in_sig m (cs : t list) : t = Sig (m, cs)
+
+  let rec pp_rec out c =
+    let ppl = Fmt.(list ~sep:(return "@ ") pp_rec) in
+    match c with
+    | Base { pp } -> pp out ()
+    | Struct (m, cs) ->
+      fpf out "@[<hv2>module %s = struct@ %a@;<1 -2>end@]" m ppl cs
+    | Sig (m, cs) -> fpf out "@[<hv2>module %s : sig@ %a@;<1 -2>end@]" m ppl cs
+
+  let pp out c = fpf out "@[<v>%a@]" pp_rec c
+  let to_string c = Fmt.to_string pp c
+  let mk_pp pp = Base { pp }
+  let mk_str s = Base { pp = Fmt.const Fmt.string s }
+end
+
+module Bitfield = struct
+  type field = {
+    f_name: string;
+    f_offset: int;
+    f_def: field_def;
+  }
+
+  and field_def =
+    | F_bit
+    | F_int of { width: int }
+
+  type t = {
+    name: string;
+    mutable fields: field list;
+    mutable width: int;
+    emit_failure_if_too_wide: bool;
+  }
+
+  let make ?(emit_failure_if_too_wide = true) ~name () : t =
+    { name; fields = []; width = 0; emit_failure_if_too_wide }
+
+  let total_width self = self.width
+
+  let field_bit self f_name =
+    let f_offset = total_width self in
+    let f = { f_name; f_offset; f_def = F_bit } in
+    self.fields <- f :: self.fields;
+    self.width <- 1 + self.width
+
+  let field_int self ~width f_name : unit =
+    let f_offset = total_width self in
+    let f = { f_name; f_offset; f_def = F_int { width } } in
+    self.fields <- f :: self.fields;
+    self.width <- self.width + width
+
+  let empty_name self =
+    if self.name = "t" then
+      "empty"
+    else
+      spf "empty_%s" self.name
+
+  let gen_ml self : code =
+    Code.mk_pp @@ fun out () ->
+    fpf out "@[<v>type %s = int@," self.name;
+    fpf out "@[let %s : %s = 0@]@," (empty_name self) self.name;
+    List.iter
+      (fun f ->
+        let inline = "[@inline]" in
+        (* TODO: option to enable/disable that *)
+        let off = f.f_offset in
+        match f.f_def with
+        | F_bit ->
+          let x_lsr =
+            if off = 0 then
+              "x"
+            else
+              spf "(x lsr %d)" off
+          in
+          fpf out "@[let%s get_%s (x:%s) : bool = (%s land 1) <> 0@]@," inline
+            f.f_name self.name x_lsr;
+          let mask_shifted = 1 lsl off in
+          fpf out
+            "@[<2>let%s set_%s (v:bool) (x:%s) : %s =@ if v then x lor %d else \
+             x land (lnot %d)@]@,"
+            inline f.f_name self.name self.name mask_shifted mask_shifted
+        | F_int { width } ->
+          let mask0 = (1 lsl width) - 1 in
+          fpf out "@[let%s get_%s (x:%s) : int = ((x lsr %d) land %d)@]@,"
+            inline f.f_name self.name off mask0;
+          fpf out
+            "@[<2>let%s set_%s (i:int) (x:%s) : %s =@ assert ((i land %d) == \
+             i);@ ((x land (lnot %d)) lor (i lsl %d))@]@,"
+            inline f.f_name self.name self.name mask0 (mask0 lsl off) off)
+      (List.rev self.fields);
+    (* check width *)
+    if self.emit_failure_if_too_wide then
+      fpf out
+        "(* check that int size is big enough *)@,\
+         @[let () = assert (Sys.int_size >= %d);;@]"
+        (total_width self);
+    fpf out "@]"
+
+  let gen_mli self : code =
+    Code.mk_pp @@ fun out () ->
+    fpf out "@[<v>type %s = private int@," self.name;
+    fpf out "@[<v>val %s : %s@," (empty_name self) self.name;
+    List.iter
+      (fun f ->
+        match f.f_def with
+        | F_bit ->
+          fpf out "@[val get_%s : %s -> bool@]@," f.f_name self.name;
+          fpf out "@[val set_%s : bool -> %s -> %s@]@," f.f_name self.name
+            self.name
+        | F_int { width } ->
+          fpf out "@[val get_%s : %s -> int@]@," f.f_name self.name;
+          fpf out
+            "@,@[(** %d bits integer *)@]@,@[val set_%s : int -> %s -> %s@]@,"
+            width f.f_name self.name self.name)
+      (List.rev self.fields);
+    fpf out "@]"
+end
+
+let emit_chan oc cs =
+  let fmt = Fmt.formatter_of_out_channel oc in
+  List.iter (fun c -> Fmt.fprintf fmt "@[%a@]@." Code.pp c) cs;
+  Fmt.fprintf fmt "@?"
+
+let emit_file file cs = CCIO.with_out file (fun oc -> emit_chan oc cs)
+
+let emit_string cs : string =
+  Fmt.asprintf "@[<v>%a@]" (Fmt.list ~sep:(Fmt.return "@ ") Code.pp) cs

src/codegen/containers_codegen.mli

@@ -0,0 +1,86 @@
+(** {1 Code generators}
+
+    The code generator library is designed to be used from a build system
+    (for example, from [dune]) to generate efficient code for features
+    that are harder to provide at runtime.
+
+    The idea is that the build system should invoke some OCaml script
+    that depends on [containers.codegen]; the script uses the DSL below
+    to describe what code to generate (e.g. a description of a bitfield type)
+    and emits a [.ml] file (and possibly a [.mli] file).
+
+    For example, the build script might contain:
+
+{[
+module CG = Containers_codegen
+let () =
+  let module B = CG.Bitfield in
+  let b = B.make ~name:"t" () in
+  B.field_bit b "x";
+  B.field_bit b "y";
+  B.field_bit b "z";
+  B.field_int b ~width:5 "foo";
+
+  CG.emit_file "foo.mli" [B.gen_mli b];
+  CG.emit_file "foo.ml" [B.gen_ml b];
+  ()
+]}
+
+    and this will produce [foo.ml] and [foo.mli] with a bitfield containing
+    [x], [y], and [z].
+
+*)
+
+module Fmt = CCFormat
+
+type code
+
+(** {2 Representation of OCaml code} *)
+module Code : sig
+  type t = code
+
+  val pp : t Fmt.printer
+  val to_string : t -> string
+  val mk_pp : unit Fmt.printer -> t
+  val mk_str : string -> t
+  val in_struct : string -> t list -> t
+  val in_sig : string -> t list -> t
+end
+
+(** {2 Generate efficient bitfields that fit in an integer} *)
+module Bitfield : sig
+  type t
+
+  val make : ?emit_failure_if_too_wide:bool -> name:string -> unit -> t
+  (** Make a new bitfield with the given name.
+      @param name the name of the generated type
+      @param emit_failure_if_too_wide if true, generated code includes a runtime
+      assertion that {!Sys.int_size} is wide enough to support this type *)
+
+  val field_bit : t -> string -> unit
+  (** [field_bit ty name] adds a field of size [1] to the bitfield [ty],
+      with name [name]. The generate code will provide get/set for
+      a boolean. *)
+
+  val field_int : t -> width:int -> string -> unit
+  (** [field_int ty name ~width] adds a field of size [width] to
+    the bitfield with name [name].
+    The accessors will be for integers of [width] bits, and the
+    setter might assert that the provided integer fits. *)
+
+  val total_width : t -> int
+  (** Total width in bits of the given bitfield. *)
+
+  val gen_mli : t -> code
+  (** Generate code for the type signature for the given bitfield *)
+
+  val gen_ml : t -> code
+  (** Generate code for the implementation for the given bitfield *)
+end
+
+val emit_file : string -> code list -> unit
+(** [emit_file file cs] emits code fragments [cs] into the given file
+    at path [file] *)
+
+val emit_chan : out_channel -> code list -> unit
+val emit_string : code list -> string

src/codegen/dune

@@ -0,0 +1,6 @@
+(library
+ (name containers_codegen)
+ (public_name containers.codegen)
+ (synopsis "code generators for Containers")
+ (libraries containers)
+ (flags :standard -warn-error -a+8))

src/codegen/tests/dune

@@ -0,0 +1,25 @@
+; emit tests
+
+(executable
+ (name emit_tests)
+ (modules emit_tests)
+ (flags :standard -warn-error -a+8)
+ (libraries containers containers.codegen))
+
+(rule
+ (targets test_bitfield.ml test_bitfield.mli)
+ (action
+  (run ./emit_tests.exe)))
+
+; run tests
+
+(executables
+ (names test_bitfield)
+ (modules test_bitfield)
+ (flags :standard -warn-error -a+8)
+ (libraries containers))
+
+(rule
+ (alias runtest)
+ (action
+  (run ./test_bitfield.exe)))

src/codegen/tests/emit_tests.ml

@@ -0,0 +1,58 @@
+module CG = Containers_codegen
+module Vec = CCVector
+
+let spf = Printf.sprintf
+
+let emit_bitfields () =
+  let module B = CG.Bitfield in
+  let ml = Vec.create () in
+  let mli = Vec.create () in
+  (let b = B.make ~name:"t" () in
+   B.field_bit b "x";
+   B.field_bit b "y";
+   B.field_bit b "z";
+   B.field_int b ~width:5 "foo";
+
+   Vec.push ml (CG.Code.in_struct "T1" [ B.gen_ml b ]);
+   Vec.push mli (CG.Code.in_sig "T1" [ B.gen_mli b ]);
+   (* check width *)
+   Vec.push ml
+     (CG.Code.mk_str (spf "let() = assert (%d = 8);;" (B.total_width b)));
+   ());
+
+  Vec.push ml
+  @@ CG.Code.mk_str
+       {|
+    let n_fails = ref 0;;
+    at_exit (fun () -> if !n_fails > 0 then exit 1);;
+    let assert_true line s =
+      if not s then ( incr n_fails; Printf.eprintf "test failure at %d\n%!" line);;
+
+    |};
+
+  let test1 =
+    {|
+    assert_true __LINE__ T1.(get_y (empty |> set_x true |> set_y true |> set_foo 10));;
+    assert_true __LINE__ T1.(get_x (empty |> set_x true |> set_y true |> set_foo 10));;
+    assert_true __LINE__ T1.(get_y (empty |> set_x true |> set_z true
+                            |> set_y false |> set_x false |> set_y true));;
+    assert_true __LINE__ T1.(get_z (empty |> set_z true));;
+    assert_true __LINE__ T1.(not @@ get_x (empty |> set_z true));;
+    assert_true __LINE__ T1.(not @@ get_y (empty |> set_z true |> set_x true));;
+    assert_true __LINE__ T1.(not @@ get_y (empty |> set_z true |> set_foo 18));;
+    (* check width of foo *)
+    assert_true __LINE__ T1.(try ignore (empty |> set_foo (1 lsl 6)); false with _ -> true);;
+    assert_true __LINE__ T1.(12 = get_foo (empty |> set_x true |> set_foo 12 |> set_x false));;
+    assert_true __LINE__ T1.(24 = get_foo (empty |> set_y true |> set_foo 24 |> set_z true));;
+  |}
+    |> CG.Code.mk_str
+  in
+  Vec.push ml test1;
+
+  CG.emit_file "test_bitfield.ml" (Vec.to_list ml);
+  CG.emit_file "test_bitfield.mli" (Vec.to_list mli);
+  ()
+
+let () =
+  emit_bitfields ();
+  ()

src/core/CCArray.mli

@@ -1,10 +1,11 @@
-
 (* This file is free software, part of containers. See file "license" for more details. *)
 
-(** {1 Array utils} *)
+(** Array utils *)
+
+type 'a iter = ('a -> unit) -> unit
+(** Fast internal iterator.
+    @since 2.8 *)
 
-type 'a sequence = ('a -> unit) -> unit
-type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
 type 'a gen = unit -> 'a option
 type 'a equal = 'a -> 'a -> bool
 type 'a ord = 'a -> 'a -> int
@@ -14,226 +15,293 @@ type 'a printer = Format.formatter -> 'a -> unit
 (** {2 Arrays} *)
 
 include module type of Array
-
+(** @inline *)
-type 'a t = 'a array
 
 val empty : 'a t
+(** [empty] is the empty array, physically equal to [[||]]. *)
 
 val equal : 'a equal -> 'a t equal
+(** [equal eq a1 a2] is [true] if the lengths of [a1] and [a2] are the same
+    and if their corresponding elements test equal, using [eq]. *)
 
 val compare : 'a ord -> 'a t ord
+(** [compare cmp a1 a2] compares arrays [a1] and [a2] using the function comparison [cmp]. *)
 
 val swap : 'a t -> int -> int -> unit
-(** [swap arr i j] swaps elements at indices [i] and [j].
+(** [swap a i j] swaps elements at indices [i] and [j].
     @since 1.4 *)
 
-val get : 'a t -> int -> 'a
-
 val get_safe : 'a t -> int -> 'a option
-(** [get_safe a i] returns [Some a.(i)] if [i] is a valid index
+(** [get_safe a i] returns [Some a.(i)] if [i] is a valid index.
     @since 0.18 *)
 
-val set : 'a t -> int -> 'a -> unit
+val map_inplace : ('a -> 'a) -> 'a t -> unit
+(** [map_inplace f a] replace all elements of [a] by its image by [f].
+    @since 3.8 *)
 
-val length : _ t -> int
+val mapi_inplace : (int -> 'a -> 'a) -> 'a t -> unit
+(** [mapi_inplace f a] replace all elements of [a] by its image by [f].
+    @since 3.10 *)
 
 val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
+(** [fold f init a] computes [f (… (f (f init a.(0)) a.(1)) …) a.(n-1)],
+    where [n] is the length of the array [a].
+    Same as {!Array.fold_left}*)
 
 val foldi : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a
-(** Fold left on array, with index *)
+(** [foldi f init a] is just like {!fold}, but it also passes in the index
+    of each element as the second argument to the folded function [f]. *)
 
-val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a
+val fold_while : ('a -> 'b -> 'a * [ `Stop | `Continue ]) -> 'a -> 'b t -> 'a
-(** Fold left on array until a stop condition via [('a, `Stop)] is
+(** [fold_while f init a] folds left on array [a] until a stop condition via [('a, `Stop)]
-    indicated by the accumulator
+    is indicated by the accumulator.
     @since 0.8 *)
 
 val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a t -> 'acc * 'b t
-(** [fold_map f acc a] is a [fold_left]-like function, but it also maps the
+(** [fold_map f init a] is a [fold_left]-like function, but it also maps the
     array to another array.
-    @since 1.2 *)
+    @since 1.2, but only
+    @since 2.1 with labels *)
 
 val scan_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc t
-(** [scan_left f acc a] returns the array
+(** [scan_left f init a] returns the array
-    [ [|acc; f acc x0; f (f acc a.(0)) a.(1); …|] ]
+    [ [|init; f init x0; f (f init a.(0)) a.(1); …|] ].
-    @since 1.2 *)
 
-
+    @since 1.2, but only
-val iter : ('a -> unit) -> 'a t -> unit
+    @since 2.1 with labels *)
-
-val iteri : (int -> 'a -> unit) -> 'a t -> unit
-
-val blit : 'a t -> int -> 'a t -> int -> int -> unit
-(** [blit from i into j len] copies [len] elements from the first array
-    to the second. See {!Array.blit}. *)
 
 val reverse_in_place : 'a t -> unit
-(** Reverse the array in place *)
+(** [reverse_in_place a] reverses the array [a] in place. *)
 
 val sorted : ('a -> 'a -> int) -> 'a t -> 'a array
-(** [sorted cmp a] makes a copy of [a] and sorts it with [cmp].
+(** [sorted f a] makes a copy of [a] and sorts it with [f].
     @since 1.0 *)
 
 val sort_indices : ('a -> 'a -> int) -> 'a t -> int array
-(** [sort_indices cmp a] returns a new array [b], with the same length as [a],
+(** [sort_indices f a] returns a new array [b], with the same length as [a],
-    such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a]
+    such that [b.(i)] is the index at which the [i]-th element of [sorted f a]
     appears in [a]. [a] is not modified.
 
-    In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a].
+    In other words, [map (fun i -> a.(i)) (sort_indices f a) = sorted f a].
     [sort_indices] yields the inverse permutation of {!sort_ranking}.
-
     @since 1.0 *)
 
 val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array
-(** [sort_ranking cmp a] returns a new array [b], with the same length as [a],
+(** [sort_ranking f a] returns a new array [b], with the same length as [a],
-    such that [b.(i)] is the index at which the [i]-the element of [a] appears
+    such that [b.(i)] is the index at which the [i]-th element of [a] appears
-    in [sorted cmp a]. [a] is not modified.
+    in [sorted f a]. [a] is not modified.
 
-    In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a].
+    In other words, [map (fun i -> (sorted f a).(i)) (sort_ranking f a) = a].
     [sort_ranking] yields the inverse permutation of {!sort_indices}.
 
     In the absence of duplicate elements in [a], we also have
-    [lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)]
+    [lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)].
     @since 1.0 *)
 
+val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool
+(** [mem ~eq x a] return true if x is present in [a]. Linear time.
+    @since 3.0
+*)
+
 val find_map : ('a -> 'b option) -> 'a t -> 'b option
 (** [find_map f a] returns [Some y] if there is an element [x] such
-    that [f x = Some y], else it returns [None]
+    that [f x = Some y]. Otherwise returns [None].
-    @since 1.3
+    @since 1.3, but only
-*)
+    @since 2.1 with labels *)
-
-val find : ('a -> 'b option) -> 'a t -> 'b option
-(** Alias to {!find_map}
-    @deprecated since 1.3 *)
 
 val find_map_i : (int -> 'a -> 'b option) -> 'a t -> 'b option
-(** Like {!find_map}, but also pass the index to the predicate function.
+(** [find_map_i f a] is like {!find_map}, but the index of the element is also passed
-    @since 1.3 *)
+    to the predicate function [f].
-
+    @since 1.3, but only
-val findi : (int -> 'a -> 'b option) -> 'a t -> 'b option
+    @since 2.1 with labels *)
-(** Alias to {!find_map_i}
-    @since 0.3.4
-    @deprecated since 1.3 *)
 
 val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option
-(** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
+(** [find_idx f a] returns [Some (i,x)] where [x] is the [i]-th element of [a],
-    and [p x] holds. Otherwise returns [None]
+    and [f x] holds. Otherwise returns [None].
     @since 0.3.4 *)
 
-val lookup : ?cmp:'a ord -> 'a -> 'a t -> int option
+val max : ('a -> 'a -> int) -> 'a t -> 'a option
-(** Lookup the index of some value in a sorted array.
+(** [max cmp a] returns [None] if [a] is empty, otherwise, returns [Some e] where [e]
-    @return [None] if the key is not present, or
+    is a maximum element in [a] with respect to [cmp].
-      [Some i] ([i] the index of the key) otherwise *)
+    @since 3.12 *)
 
-val lookup_exn : ?cmp:'a ord -> 'a -> 'a t -> int
+val max_exn : ('a -> 'a -> int) -> 'a t -> 'a
-(** Same as {!lookup}, but
+(** [max_exn cmp a] is like {!max}, but
-    @raise Not_found if the key is not present *)
+    @raise Invalid_argument if [a] is empty.
+    @since 3.12 *)
 
-val bsearch : ?cmp:('a -> 'a -> int) -> 'a -> 'a t ->
+val argmax : ('a -> 'a -> int) -> 'a t -> int option
+(** [argmax cmp a] returns [None] if [a] is empty, otherwise, returns [Some i] where [i]
+    is the index of a maximum element in [a] with respect to [cmp].
+    @since 3.12 *)
+
+val argmax_exn : ('a -> 'a -> int) -> 'a t -> int
+(** [argmax_exn cmp a] is like {!argmax}, but
+    @raise Invalid_argument if [a] is empty.
+    @since 3.12 *)
+
+val min : ('a -> 'a -> int) -> 'a t -> 'a option
+(** [min cmp a] returns [None] if [a] is empty, otherwise, returns [Some e] where [e]
+    is a minimum element in [a] with respect to [cmp].
+    @since 3.12 *)
+
+val min_exn : ('a -> 'a -> int) -> 'a t -> 'a
+(** [min_exn cmp a] is like {!min}, but
+    @raise Invalid_argument if [a] is empty.
+    @since 3.12 *)
+
+val argmin : ('a -> 'a -> int) -> 'a t -> int option
+(** [argmin cmp a] returns [None] if [a] is empty, otherwise, returns [Some i] where [i]
+    is the index of a minimum element in [a] with respect to [cmp].
+    @since 3.12 *)
+
+val argmin_exn : ('a -> 'a -> int) -> 'a t -> int
+(** [argmin_exn cmp a] is like {!argmin}, but
+    @raise Invalid_argument if [a] is empty.
+    @since 3.12 *)
+
+val lookup : cmp:'a ord -> 'a -> 'a t -> int option
+(** [lookup ~cmp key a] lookups the index of some key [key] in a sorted array [a].
+    Undefined behavior if the array [a] is not sorted wrt [~cmp].
+    Complexity: [O(log (n))] (dichotomic search).
+    @return [None] if the key [key] is not present, or
+      [Some i] ([i] the index of the key) otherwise. *)
+
+val lookup_exn : cmp:'a ord -> 'a -> 'a t -> int
+(** [lookup_exn ~cmp key a] is like {!lookup}, but
+    @raise Not_found if the key [key] is not present. *)
+
+val bsearch :
+  cmp:('a -> 'a -> int) ->
+  'a ->
+  'a t ->
   [ `All_lower | `All_bigger | `Just_after of int | `Empty | `At of int ]
-(** [bsearch ?cmp x arr] finds the index of the object [x] in the array [arr],
+(** [bsearch ~cmp key a] finds the index of the object [key] in the array [a],
-    provided [arr] is {b sorted} using [cmp]. If the array is not sorted,
+    provided [a] is {b sorted} using [cmp]. If the array is not sorted,
     the result is not specified (may raise Invalid_argument).
 
-    Complexity: O(log n) where n is the length of the array
+    Complexity: [O(log n)] where n is the length of the array [a]
     (dichotomic search).
 
     @return
-    - [`At i] if [cmp arr.(i) x = 0] (for some i)
+    - [`At i] if [cmp a.(i) key = 0] (for some i).
-    - [`All_lower] if all elements of [arr] are lower than [x]
+    - [`All_lower] if all elements of [a] are lower than [key].
-    - [`All_bigger] if all elements of [arr] are bigger than [x]
+    - [`All_bigger] if all elements of [a] are bigger than [key].
-    - [`Just_after i] if [arr.(i) < x < arr.(i+1)]
+    - [`Just_after i] if [a.(i) < key < a.(i+1)].
-    - [`Empty] if the array is empty
+    - [`Empty] if the array [a] is empty.
 
-    @raise Invalid_argument if the array is found to be unsorted w.r.t [cmp]
+    @raise Invalid_argument if the array is found to be unsorted w.r.t [cmp].
     @since 0.13 *)
 
-val for_all : ('a -> bool) -> 'a t -> bool
-
 val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
-(** Forall on pairs of arrays.
+(** [for_all2 f [|a1; …; an|] [|b1; …; bn|]] is [true] if each pair of elements [ai bi]
-    @raise Invalid_argument if they have distinct lengths
+    satisfies the predicate [f].
-    allow different types @since 0.20 *)
+    That is, it returns [(f a1 b1) && (f a2 b2) && … && (f an bn)].
 
-val exists : ('a -> bool) -> 'a t -> bool
+    @raise Invalid_argument if arrays have distinct lengths.
-
+    Allow different types.
-val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
-(** Exists on pairs of arrays.
-    @raise Invalid_argument if they have distinct lengths
-    allow different types @since 0.20 *)
-
-val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
-(** Fold on two arrays stepwise.
-    @raise Invalid_argument if they have distinct lengths
     @since 0.20 *)
 
-val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit
+val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
-(** Iterate on two arrays stepwise.
+(** [exists2 f [|a1; …; an|] [|b1; …; bn|]] is [true] if any pair of elements [ai bi]
-    @raise Invalid_argument if they have distinct lengths
+    satisfies the predicate [f].
+    That is, it returns [(f a1 b1) || (f a2 b2) || … || (f an bn)].
+
+    @raise Invalid_argument if arrays have distinct lengths.
+    Allow different types.
+    @since 0.20 *)
+
+val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
+(** [fold2 f init a b] fold on two arrays [a] and [b] stepwise.
+    It computes [f (… (f init a1 b1) …) an bn].
+
+    @raise Invalid_argument if [a] and [b] have distinct lengths.
     @since 0.20 *)
 
 val shuffle : 'a t -> unit
-(** Shuffle randomly the array, in place *)
+(** [shuffle a] randomly shuffles the array [a], in place. *)
 
 val shuffle_with : Random.State.t -> 'a t -> unit
-(** Like shuffle but using a specialized random state *)
+(** [shuffle_with rs a] randomly shuffles the array [a] (like {!shuffle}) but a specialized random
+    state [rs] is used to control the random numbers being produced during shuffling (for reproducibility). *)
 
 val random_choose : 'a t -> 'a random_gen
-(** Choose an element randomly.
+(** [random_choose a rs] randomly chooses an element of [a].
-    @raise Not_found if the array/slice is empty *)
+    @raise Not_found if the array/slice is empty. *)
+
+val to_string : ?sep:string -> ('a -> string) -> 'a array -> string
+(** [to_string ~sep item_to_string a] print [a] to a string using [sep] as a separator
+    between elements of [a].
+    @since 2.7 *)
+
+val to_iter : 'a t -> 'a iter
+(** [to_iter a] returns an [iter] of the elements of an array [a].
+    The input array [a] is shared with the sequence and modification of it will result
+    in modification of the iterator.
+    @since 2.8 *)
+
+val to_seq : 'a t -> 'a Seq.t
+(** [to_seq a] returns a [Seq.t] of the elements of an array [a].
+    The input array [a] is shared with the sequence and modification of it will result
+    in modification of the sequence.
+    Renamed from [to_std_seq] since 3.0.
+    @since 3.0
+*)
 
-val to_seq : 'a t -> 'a sequence
 val to_gen : 'a t -> 'a gen
-val to_klist : 'a t -> 'a klist
+(** [to_gen a] returns a [gen] of the elements of an array [a]. *)
 
 (** {2 IO} *)
 
-val pp: ?sep:string -> 'a printer -> 'a t printer
+val pp :
-(** Print an array of items with printing function *)
+  ?pp_start:unit printer ->
+  ?pp_stop:unit printer ->
+  ?pp_sep:unit printer ->
+  'a printer ->
+  'a t printer
+(** [pp ~pp_start ~pp_stop ~pp_sep pp_item ppf a] formats the array [a] on [ppf].
+    Each element is formatted with [pp_item], [pp_start] is called at the beginning,
+    [pp_stop] is called at the end, [pp_sep] is called between each elements.
+    By defaults [pp_start] and [pp_stop] does nothing and [pp_sep] defaults to
+    (fun out -> Format.fprintf out ",@ "). *)
 
-val pp_i: ?sep:string -> (int -> 'a printer) -> 'a t printer
+val pp_i :
-(** Print an array, giving the printing function both index and item *)
+  ?pp_start:unit printer ->
-
+  ?pp_stop:unit printer ->
-val map : ('a -> 'b) -> 'a t -> 'b t
+  ?pp_sep:unit printer ->
-
+  (int -> 'a printer) ->
-val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
+  'a t printer
-(** Map on two arrays stepwise.
+(** [pp_i ~pp_start ~pp_stop ~pp_sep pp_item ppf a] prints the array [a] on [ppf].
-      @raise Invalid_argument if they have distinct lengths
+    The printing function [pp_item] is giving both index and element.
-      @since 0.20 *)
+    [pp_start] is called at the beginning,
+    [pp_stop] is called at the end, [pp_sep] is called between each elements.
+    By defaults [pp_start] and [pp_stop] does nothing and [pp_sep] defaults to
+    (fun out -> Format.fprintf out ",@ "). *)
 
 val rev : 'a t -> 'a t
-(** Copy + reverse in place
+(** [rev a] copies the array [a] and reverses it in place.
     @since 0.20 *)
 
 val filter : ('a -> bool) -> 'a t -> 'a t
-(** Filter elements out of the array. Only the elements satisfying
+(** [filter f a] filters elements out of the array [a]. Only the elements satisfying
-    the given predicate will be kept. *)
+    the given predicate [f] will be kept. *)
 
 val filter_map : ('a -> 'b option) -> 'a t -> 'b t
-(** Map each element into another value, or discard it *)
+(** [filter_map f [|a1; …; an|]] calls [(f a1) … (f an)] and returns an array [b] consisting
+    of all elements [bi] such as [f ai = Some bi]. When [f] returns [None], the corresponding
+    element of [a] is discarded. *)
+
+val monoid_product : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
+(** [monoid_product f a b] passes all combinaisons of tuples from the two arrays [a] and [b]
+    to the function [f].
+    @since 2.8 *)
 
 val flat_map : ('a -> 'b t) -> 'a t -> 'b array
-(** Transform each element into an array, then flatten *)
+(** [flat_map f a] transforms each element of [a] into an array, then flattens. *)
-
-val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-(** Infix version of {!flat_map} *)
-
-val (>>|) : 'a t -> ('a -> 'b) -> 'b t
-(** Infix version of {!map}
-    @since 0.8 *)
-
-val (>|=) : 'a t -> ('a -> 'b) -> 'b t
-(** Infix version of {!map}
-    @since 0.8 *)
 
 val except_idx : 'a t -> int -> 'a list
-(** Remove given index, obtaining the list of the other elements *)
+(** [except_idx a i] removes the element of [a] at given index [i], and returns
-
+    the list of the other elements. *)
-val (--) : int -> int -> int t
-(** Range array *)
-
-val (--^) : int -> int -> int t
-(** Range array, excluding right bound
-    @since 0.17 *)
 
 val random : 'a random_gen -> 'a t random_gen
 val random_non_empty : 'a random_gen -> 'a t random_gen
@@ -246,15 +314,48 @@ module type MONO_ARRAY = sig
   type t
 
   val length : t -> int
-
   val get : t -> int -> elt
-
   val set : t -> int -> elt -> unit
 end
 
 val sort_generic :
   (module MONO_ARRAY with type t = 'arr and type elt = 'elt) ->
-  ?cmp:('elt -> 'elt -> int) -> 'arr -> unit
+  cmp:('elt -> 'elt -> int) ->
-(** Sort the array, without allocating (eats stack space though). Performance
+  'arr ->
-    might be lower than {!Array.sort}.
+  unit
+(** [sort_generic (module M) ~cmp a] sorts the array [a], without allocating (eats stack space though).
+    Performance might be lower than {!Array.sort}.
     @since 0.14 *)
+
+(** {3 Infix Operators}
+    It is convenient to [open CCArray.Infix] to access the infix operators
+    without cluttering the scope too much.
+
+    @since 2.7 *)
+
+module Infix : sig
+  val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
+  (** [a >>= f] is the infix version of {!flat_map}. *)
+
+  val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t
+  (** [a >>| f] is the infix version of {!map}.
+      @since 0.8 *)
+
+  val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t
+  (** [a >|= f] is the infix version of {!map}.
+      @since 0.8 *)
+
+  val ( -- ) : int -> int -> int t
+  (** [x -- y] creates an array containing integers in the range [x .. y]. Bounds included. *)
+
+  val ( --^ ) : int -> int -> int t
+  (** [x --^ y] creates an array containing integers in the range [x .. y]. Right bound excluded.
+      @since 0.17 *)
+
+  val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
+  val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
+  val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
+  val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
+end
+
+include module type of Infix

src/core/CCArrayLabels.ml

@@ -1,4 +1,3 @@
-
 (* This file is free software, part of containers. See file "license" for more details. *)
 
 include CCArray

src/core/CCArrayLabels.mli

@@ -1,10 +1,11 @@
-
 (* This file is free software, part of containers. See file "license" for more details. *)
 
-(** {1 Array utils} *)
+(** Array utils (Labeled version of {!CCArray}) *)
+
+type 'a iter = ('a -> unit) -> unit
+(** Fast internal iterator.
+    @since 2.8 *)
 
-type 'a sequence = ('a -> unit) -> unit
-type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
 type 'a gen = unit -> 'a option
 type 'a equal = 'a -> 'a -> bool
 type 'a ord = 'a -> 'a -> int
@@ -13,198 +14,310 @@ type 'a printer = Format.formatter -> 'a -> unit
 
 (** {2 Arrays} *)
 
-include module type of ArrayLabels
+include module type of ArrayLabels with module Floatarray = Array.Floatarray
-
+(** @inline *)
-type 'a t = 'a array
 
 val empty : 'a t
+(** [empty] is the empty array, physically equal to [[||]]. *)
 
 val equal : 'a equal -> 'a t equal
+(** [equal eq a1 a2] is [true] if the lengths of [a1] and [a2] are the same
+    and if their corresponding elements test equal, using [eq]. *)
 
 val compare : 'a ord -> 'a t ord
+(** [compare cmp a1 a2] compares arrays [a1] and [a2] using the function comparison [cmp]. *)
 
-val get : 'a t -> int -> 'a
+val swap : 'a t -> int -> int -> unit
+(** [swap a i j] swaps elements at indices [i] and [j].
+    @since 1.4 *)
 
 val get_safe : 'a t -> int -> 'a option
-(** [get_safe a i] returns [Some a.(i)] if [i] is a valid index
+(** [get_safe a i] returns [Some a.(i)] if [i] is a valid index.
     @since 0.18 *)
 
-val set : 'a t -> int -> 'a -> unit
+val map_inplace : f:('a -> 'a) -> 'a t -> unit
+(** [map_inplace ~f a] replace all elements of [a] by its image by [f].
+    @since 3.8 *)
 
-val length : _ t -> int
+val mapi_inplace : f:(int -> 'a -> 'a) -> 'a t -> unit
+(** [mapi_inplace ~f a] replace all elements of [a] by its image by [f].
+    @since 3.10 *)
 
 val fold : f:('a -> 'b -> 'a) -> init:'a -> 'b t -> 'a
+(** [fold ~f ~init a] computes [f (… (f (f init a.(0)) a.(1)) …) a.(n-1)],
+    where [n] is the length of the array [a].
+    Same as {!ArrayLabels.fold_left} *)
 
 val foldi : f:('a -> int -> 'b -> 'a) -> init:'a -> 'b t -> 'a
-(** Fold left on array, with index *)
+(** [foldi ~f ~init a] is just like {!fold}, but it also passes in the index
+    of each element as the second argument to the folded function [f]. *)
 
-val fold_while : f:('a -> 'b -> 'a * [`Stop | `Continue]) -> init:'a -> 'b t -> 'a
+val fold_while :
-(** Fold left on array until a stop condition via [('a, `Stop)] is
+  f:('a -> 'b -> 'a * [ `Stop | `Continue ]) -> init:'a -> 'b t -> 'a
-    indicated by the accumulator
+(** [fold_while ~f ~init a] folds left on array [a] until a stop condition via [('a, `Stop)]
+    is indicated by the accumulator.
     @since 0.8 *)
 
-val iter : f:('a -> unit) -> 'a t -> unit
+val fold_map : f:('acc -> 'a -> 'acc * 'b) -> init:'acc -> 'a t -> 'acc * 'b t
+(** [fold_map ~f ~init a] is a [fold_left]-like function, but it also maps the
+    array to another array.
+    @since 1.2, but only
+    @since 2.1 with labels *)
 
-val iteri : f:(int -> 'a -> unit) -> 'a t -> unit
+val scan_left : f:('acc -> 'a -> 'acc) -> init:'acc -> 'a t -> 'acc t
+(** [scan_left ~f ~init a] returns the array
+    [ [|init; f init x0; f (f init a.(0)) a.(1); …|] ].
 
-val blit : 'a t -> int -> 'a t -> int -> int -> unit
+    @since 1.2, but only
-(** [blit from i into j len] copies [len] elements from the first array
+    @since 2.1 with labels *)
-    to the second. See {!Array.blit}. *)
 
 val reverse_in_place : 'a t -> unit
-(** Reverse the array in place *)
+(** [reverse_in_place a] reverses the array [a] in place. *)
 
 val sorted : f:('a -> 'a -> int) -> 'a t -> 'a array
-(** [sorted cmp a] makes a copy of [a] and sorts it with [cmp].
+(** [sorted ~f a] makes a copy of [a] and sorts it with [f].
     @since 1.0 *)
 
 val sort_indices : f:('a -> 'a -> int) -> 'a t -> int array
-(** [sort_indices cmp a] returns a new array [b], with the same length as [a],
+(** [sort_indices ~f a] returns a new array [b], with the same length as [a],
-    such that [b.(i)] is the index of the [i]-th element of [a] in [sort cmp a].
+    such that [b.(i)] is the index at which the [i]-th element of [sorted f a]
-    In other words, [map (fun i -> a.(i)) (sort_indices a) = sorted cmp a].
+    appears in [a]. [a] is not modified.
-    [a] is not modified.
+
+    In other words, [map (fun i -> a.(i)) (sort_indices f a) = sorted f a].
+    [sort_indices] yields the inverse permutation of {!sort_ranking}.
     @since 1.0 *)
 
 val sort_ranking : f:('a -> 'a -> int) -> 'a t -> int array
-(** [sort_ranking cmp a] returns a new array [b], with the same length as [a],
+(** [sort_ranking ~f a] returns a new array [b], with the same length as [a],
-    such that [b.(i)] is the position in [sorted cmp a] of the [i]-th
+    such that [b.(i)] is the index at which the [i]-th element of [a] appears
-    element of [a].
+    in [sorted f a]. [a] is not modified.
-    [a] is not modified.
 
-    In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a].
+    In other words, [map (fun i -> (sorted f a).(i)) (sort_ranking f a) = a].
+    [sort_ranking] yields the inverse permutation of {!sort_indices}.
 
-    Without duplicates, we also have
+    In the absence of duplicate elements in [a], we also have
-    [lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)]
+    [lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)].
     @since 1.0 *)
 
-val find : f:('a -> 'b option) -> 'a t -> 'b option
+val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool
-(** [find f a] returns [Some y] if there is an element [x] such
+(** [mem ~eq x a] return true if x is present in [a]. Linear time.
-    that [f x = Some y], else it returns [None] *)
+    @since 3.0
+*)
 
-val findi : f:(int -> 'a -> 'b option) -> 'a t -> 'b option
+val find_map : f:('a -> 'b option) -> 'a t -> 'b option
-(** Like {!find}, but also pass the index to the predicate function.
+(** [find_map ~f a] returns [Some y] if there is an element [x] such
-    @since 0.3.4 *)
+    that [f x = Some y]. Otherwise returns [None].
+    @since 1.3, but only
+    @since 2.1 with labels *)
+
+val find_map_i : f:(int -> 'a -> 'b option) -> 'a t -> 'b option
+(** [find_map_i ~f a] is like {!find_map}, but the index of the element is also passed
+    to the predicate function [f].
+    @since 1.3, but only
+    @since 2.1 with labels *)
 
 val find_idx : f:('a -> bool) -> 'a t -> (int * 'a) option
-(** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
+(** [find_idx ~f a] returns [Some (i,x)] where [x] is the [i]-th element of [a],
-    and [p x] holds. Otherwise returns [None]
+    and [f x] holds. Otherwise returns [None].
     @since 0.3.4 *)
 
-val lookup : ?cmp:'a ord -> key:'a -> 'a t -> int option
+val max : cmp:('a -> 'a -> int) -> 'a t -> 'a option
-(** Lookup the index of some value in a sorted array.
+(** [max ~cmp a] returns [None] if [a] is empty, otherwise, returns [Some e] where [e]
-    @return [None] if the key is not present, or
+    is a maximum element in [a] with respect to [cmp].
-      [Some i] ([i] the index of the key) otherwise *)
+    @since 3.12 *)
 
-val lookup_exn : ?cmp:'a ord -> key:'a -> 'a t -> int
+val max_exn : cmp:('a -> 'a -> int) -> 'a t -> 'a
-(** Same as {!lookup_exn}, but
+(** [max_exn ~cmp a] is like {!max}, but
-    @raise Not_found if the key is not present *)
+    @raise Invalid_argument if [a] is empty.
+    @since 3.12 *)
 
-val bsearch : ?cmp:('a -> 'a -> int) -> key:'a -> 'a t ->
+val argmax : cmp:('a -> 'a -> int) -> 'a t -> int option
+(** [argmax ~cmp a] returns [None] if [a] is empty, otherwise, returns [Some i] where [i]
+    is the index of a maximum element in [a] with respect to [cmp].
+    @since 3.12 *)
+
+val argmax_exn : cmp:('a -> 'a -> int) -> 'a t -> int
+(** [argmax_exn ~cmp a] is like {!argmax}, but
+    @raise Invalid_argument if [a] is empty.
+    @since 3.12 *)
+
+val min : cmp:('a -> 'a -> int) -> 'a t -> 'a option
+(** [min ~cmp a] returns [None] if [a] is empty, otherwise, returns [Some e] where [e]
+    is a minimum element in [a] with respect to [cmp].
+    @since 3.12 *)
+
+val min_exn : cmp:('a -> 'a -> int) -> 'a t -> 'a
+(** [min_exn ~cmp a] is like {!min}, but
+    @raise Invalid_argument if [a] is empty.
+    @since 3.12 *)
+
+val argmin : cmp:('a -> 'a -> int) -> 'a t -> int option
+(** [argmin ~cmp a] returns [None] if [a] is empty, otherwise, returns [Some i] where [i]
+    is the index of a minimum element in [a] with respect to [cmp].
+    @since 3.12 *)
+
+val argmin_exn : cmp:('a -> 'a -> int) -> 'a t -> int
+(** [argmin_exn ~cmp a] is like {!argmin}, but
+    @raise Invalid_argument if [a] is empty.
+    @since 3.12 *)
+
+val lookup : cmp:('a ord[@keep_label]) -> key:'a -> 'a t -> int option
+(** [lookup ~cmp ~key a] lookups the index of some key [key] in a sorted array [a].
+    Undefined behavior if the array [a] is not sorted wrt [cmp].
+    Complexity: [O(log (n))] (dichotomic search).
+    @return [None] if the key [key] is not present, or
+      [Some i] ([i] the index of the key) otherwise. *)
+
+val lookup_exn : cmp:('a ord[@keep_label]) -> key:'a -> 'a t -> int
+(** [lookup_exn ~cmp ~key a] is like {!lookup}, but
+    @raise Not_found if the key [key] is not present. *)
+
+val bsearch :
+  cmp:(('a -> 'a -> int)[@keep_label]) ->
+  key:'a ->
+  'a t ->
   [ `All_lower | `All_bigger | `Just_after of int | `Empty | `At of int ]
-(** [bsearch ?cmp key arr] finds the index of the object [key] in the array [arr],
+(** [bsearch ~cmp ~key a] finds the index of the object [key] in the array [a],
-    provided [arr] is {b sorted} using [cmp]. If the array is not sorted,
+    provided [a] is {b sorted} using [cmp]. If the array is not sorted,
     the result is not specified (may raise Invalid_argument).
 
-    Complexity: O(log n) where n is the length of the array
+    Complexity: [O(log n)] where n is the length of the array [a]
     (dichotomic search).
 
     @return
-    - [`At i] if [cmp arr.(i) key = 0] (for some i)
+    - [`At i] if [cmp a.(i) key = 0] (for some i).
-    - [`All_lower] if all elements of [arr] are lower than [key]
+    - [`All_lower] if all elements of [a] are lower than [key].
-    - [`All_bigger] if all elements of [arr] are bigger than [key]
+    - [`All_bigger] if all elements of [a] are bigger than [key].
-    - [`Just_after i] if [arr.(i) < key < arr.(i+1)]
+    - [`Just_after i] if [a.(i) < key < a.(i+1)].
-    - [`Empty] if the array is empty
+    - [`Empty] if the array [a] is empty.
 
-    @raise Invalid_argument if the array is found to be unsorted w.r.t [cmp]
+    @raise Invalid_argument if the array is found to be unsorted w.r.t [cmp].
     @since 0.13 *)
 
-val for_all : f:('a -> bool) -> 'a t -> bool
-
 val for_all2 : f:('a -> 'b -> bool) -> 'a t -> 'b t -> bool
-(** Forall on pairs of arrays.
+(** [for_all2 ~f [|a1; …; an|] [|b1; …; bn|]] is [true] if each pair of elements [ai bi]
-    @raise Invalid_argument if they have distinct lengths
+    satisfies the predicate [f].
-    allow different types @since 0.20 *)
+    That is, it returns [(f a1 b1) && (f a2 b2) && … && (f an bn)].
 
-val exists : f:('a -> bool) -> 'a t -> bool
+    @raise Invalid_argument if arrays have distinct lengths.
+    Allow different types.
+    @since 0.20 *)
 
 val exists2 : f:('a -> 'b -> bool) -> 'a t -> 'b t -> bool
-(** Exists on pairs of arrays.
+(** [exists2 ~f [|a1; …; an|] [|b1; …; bn|]] is [true] if any pair of elements [ai bi]
-    @raise Invalid_argument if they have distinct lengths
+    satisfies the predicate [f].
-    allow different types @since 0.20 *)
+    That is, it returns [(f a1 b1) || (f a2 b2) || … || (f an bn)].
+
+    @raise Invalid_argument if arrays have distinct lengths.
+    Allow different types.
+    @since 0.20 *)
 
 val fold2 : f:('acc -> 'a -> 'b -> 'acc) -> init:'acc -> 'a t -> 'b t -> 'acc
-(** Fold on two arrays stepwise.
+(** [fold2 ~f ~init a b] fold on two arrays [a] and [b] stepwise.
-    @raise Invalid_argument if they have distinct lengths
+    It computes [f (… (f init a1 b1) …) an bn].
+
+    @raise Invalid_argument if [a] and [b] have distinct lengths.
     @since 0.20 *)
 
 val iter2 : f:('a -> 'b -> unit) -> 'a t -> 'b t -> unit
-(** Iterate on two arrays stepwise.
+(** [iter2 ~f a b] iterates on the two arrays [a] and [b] stepwise.
-    @raise Invalid_argument if they have distinct lengths
+    It is equivalent to  [f a0 b0; …; f a.(length a - 1) b.(length b - 1); ()].
+
+    @raise Invalid_argument if [a] and [b] have distinct lengths.
     @since 0.20 *)
 
 val shuffle : 'a t -> unit
-(** Shuffle randomly the array, in place *)
+(** [shuffle a] randomly shuffles the array [a], in place. *)
 
 val shuffle_with : Random.State.t -> 'a t -> unit
-(** Like shuffle but using a specialized random state *)
+(** [shuffle_with rs a] randomly shuffles the array [a] (like {!shuffle}) but a specialized random
+    state [rs] is used to control the random numbers being produced during shuffling (for reproducibility). *)
 
 val random_choose : 'a t -> 'a random_gen
-(** Choose an element randomly.
+(** [random_choose a rs] randomly chooses an element of [a].
-    @raise Not_found if the array/slice is empty *)
+    @raise Not_found if the array/slice is empty. *)
+
+val to_string : ?sep:string -> ('a -> string) -> 'a array -> string
+(** [to_string ~sep item_to_string a] print [a] to a string using [sep] as a separator
+    between elements of [a].
+    @since 2.7 *)
+
+val to_iter : 'a t -> 'a iter
+(** [to_iter a] returns an [iter] of the elements of an array [a].
+    The input array [a] is shared with the sequence and modification of it will result
+    in modification of the iterator.
+    @since 2.8 *)
+
+val to_seq : 'a t -> 'a Seq.t
+(** [to_seq a] returns a [Seq.t] of the elements of an array [a].
+    The input array [a] is shared with the sequence and modification of it will result
+    in modification of the sequence.
+    Renamed from [to_std_seq] since 3.0.
+    @since 3.0
+*)
 
-val to_seq : 'a t -> 'a sequence
 val to_gen : 'a t -> 'a gen
-val to_klist : 'a t -> 'a klist
+(** [to_gen a] returns a [gen] of the elements of an array [a]. *)
 
 (** {2 IO} *)
 
-val pp: ?sep:string -> 'a printer -> 'a t printer
+val pp :
-(** Print an array of items with printing function *)
+  ?pp_start:unit printer ->
+  ?pp_stop:unit printer ->
+  ?pp_sep:unit printer ->
+  'a printer ->
+  'a t printer
+(** [pp ~pp_start ~pp_stop ~pp_sep pp_item ppf a] formats the array [a] on [ppf].
+    Each element is formatted with [pp_item], [pp_start] is called at the beginning,
+    [pp_stop] is called at the end, [pp_sep] is called between each elements.
+    By defaults [pp_start] and [pp_stop] does nothing and [pp_sep] defaults to
+    (fun out -> Format.fprintf out ",@ "). *)
 
-val pp_i: ?sep:string -> (int -> 'a printer) -> 'a t printer
+val pp_i :
-(** Print an array, giving the printing function both index and item *)
+  ?pp_start:unit printer ->
-
+  ?pp_stop:unit printer ->
-val map : f:('a -> 'b) -> 'a t -> 'b t
+  ?pp_sep:unit printer ->
+  (int -> 'a printer) ->
+  'a t printer
+(** [pp_i ~pp_start ~pp_stop ~pp_sep pp_item ppf a] prints the array [a] on [ppf].
+    The printing function [pp_item] is giving both index and element.
+    [pp_start] is called at the beginning,
+    [pp_stop] is called at the end, [pp_sep] is called between each elements.
+    By defaults [pp_start] and [pp_stop] does nothing and [pp_sep] defaults to
+    (fun out -> Format.fprintf out ",@ "). *)
 
 val map2 : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
-(** Map on two arrays stepwise.
+(** [map2 ~f a b] applies function [f] to all elements of [a] and [b],
-      @raise Invalid_argument if they have distinct lengths
+    and builds an array with the results returned by [f]:
-      @since 0.20 *)
+    [[| f a.(0) b.(0); …; f a.(length a - 1) b.(length b - 1)|]].
+
+    @raise Invalid_argument if [a] and [b] have distinct lengths.
+    @since 0.20 *)
 
 val rev : 'a t -> 'a t
-(** Copy + reverse in place
+(** [rev a] copies the array [a] and reverses it in place.
     @since 0.20 *)
 
 val filter : f:('a -> bool) -> 'a t -> 'a t
-(** Filter elements out of the array. Only the elements satisfying
+(** [filter ~f a] filters elements out of the array [a]. Only the elements satisfying
-    the given predicate will be kept. *)
+    the given predicate [f] will be kept. *)
 
 val filter_map : f:('a -> 'b option) -> 'a t -> 'b t
-(** Map each element into another value, or discard it *)
+(** [filter_map ~f [|a1; …; an|]] calls [(f a1) … (f an)] and returns an array [b] consisting
+    of all elements [bi] such as [f ai = Some bi]. When [f] returns [None], the corresponding
+    element of [a] is discarded. *)
+
+val monoid_product : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
+(** [monoid_product ~f a b] passes all combinaisons of tuples from the two arrays [a] and [b] 
+    to the function [f].
+    @since 2.8 *)
 
 val flat_map : f:('a -> 'b t) -> 'a t -> 'b array
-(** Transform each element into an array, then flatten *)
+(** [flat_map ~f a] transforms each element of [a] into an array, then flattens. *)
-
-val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-(** Infix version of {!flat_map} *)
-
-val (>>|) : 'a t -> ('a -> 'b) -> 'b t
-(** Infix version of {!map}
-    @since 0.8 *)
-
-val (>|=) : 'a t -> ('a -> 'b) -> 'b t
-(** Infix version of {!map}
-    @since 0.8 *)
 
 val except_idx : 'a t -> int -> 'a list
-(** Remove given index, obtaining the list of the other elements *)
+(** [except_idx a i] removes the element of [a] at given index [i], and returns
-
+    the list of the other elements. *)
-val (--) : int -> int -> int t
-(** Range array *)
-
-val (--^) : int -> int -> int t
-(** Range array, excluding right bound
-    @since 0.17 *)
 
 val random : 'a random_gen -> 'a t random_gen
 val random_non_empty : 'a random_gen -> 'a t random_gen
@@ -217,15 +330,48 @@ module type MONO_ARRAY = sig
   type t
 
   val length : t -> int
-
   val get : t -> int -> elt
-
   val set : t -> int -> elt -> unit
 end
 
 val sort_generic :
   (module MONO_ARRAY with type t = 'arr and type elt = 'elt) ->
-  ?cmp:('elt -> 'elt -> int) -> 'arr -> unit
+  cmp:(('elt -> 'elt -> int)[@keep_label]) ->
-(** Sort the array, without allocating (eats stack space though). Performance
+  'arr ->
-    might be lower than {!Array.sort}.
+  unit
+(** [sort_generic (module M) ~cmp a] sorts the array [a], without allocating (eats stack space though).
+    Performance might be lower than {!Array.sort}.
     @since 0.14 *)
+
+(** {3 Infix Operators}
+    It is convenient to [open CCArray.Infix] to access the infix operators
+    without cluttering the scope too much.
+
+    @since 2.7 *)
+
+module Infix : sig
+  val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
+  (** [a >>= f] is the infix version of {!flat_map}. *)
+
+  val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t
+  (** [a >>| f] is the infix version of {!map}.
+      @since 0.8 *)
+
+  val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t
+  (** [a >|= f] is the infix version of {!map}.
+      @since 0.8 *)
+
+  val ( -- ) : int -> int -> int t
+  (** [x -- y] creates an array containing integers in the range [x .. y]. Bounds included. *)
+
+  val ( --^ ) : int -> int -> int t
+  (** [x --^ y] creates an array containing integers in the range [x .. y]. Right bound excluded.
+      @since 0.17 *)
+
+  val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
+  val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
+  val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
+  val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
+end
+
+include module type of Infix

src/core/CCArray_slice.ml

@@ -1,418 +0,0 @@
-
-(* This file is free software, part of containers. See file "license" for more details. *)
-
-(** {1 Array Slice} *)
-
-type 'a sequence = ('a -> unit) -> unit
-type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
-type 'a gen = unit -> 'a option
-type 'a equal = 'a -> 'a -> bool
-type 'a ord = 'a -> 'a -> int
-type 'a random_gen = Random.State.t -> 'a
-type 'a printer = Format.formatter -> 'a -> unit
-
-(*$inject
-  let (--) = CCArray.(--)
-*)
-
-type 'a t = {
-  arr : 'a array;
-  i : int; (** Start index (included) *)
-  j : int;  (** Stop index (excluded) *)
-}
-
-let empty = {
-  arr = [||];
-  i = 0;
-  j = 0;
-}
-
-let make arr i ~len =
-  if i<0||i+len > Array.length arr then invalid_arg "Array_slice.make";
-  { arr; i; j=i+len; }
-
-let of_slice (arr,i,len) = make arr i ~len
-
-let to_slice a = a.arr, a.i, a.j-a.i
-
-let full arr = { arr; i=0; j=Array.length arr; }
-
-let underlying a = a.arr
-
-let length a = a.j - a.i
-
-let copy a = Array.sub a.arr a.i (length a)
-
-let sub a i len = make a.arr (a.i + i) ~len
-(*$=
-  [ 3;4 ] \
-    (let a = make (0--10) 2 5 in sub a 1 2 |> to_list)
-  [ ] \
-    (let a = make (0--10) 2 5 in sub a 1 0 |> to_list)
-  [ 5 ] \
-    (let a = make (0--10) 1 9 in sub a 4 1 |> to_list)
-*)
-
-let rec _foldi f acc a i j =
-  if i = j then acc else _foldi f (f acc i a.(i)) a (i+1) j
-
-let _reverse_in_place a i ~len =
-  if len=0 then ()
-  else
-    for k = 0 to (len-1)/2 do
-      let t = a.(i+k) in
-      a.(i+k) <- a.(i+len-1-k);
-      a.(i+len-1-k) <- t;
-    done
-
-let rec _equal eq a1 i1 j1 a2 i2 j2 =
-  if i1 = j1
-  then (assert (i1=j1 && i2=j2); true)
-  else
-    eq a1.(i1) a2.(i2) && _equal eq a1 (i1+1) j1 a2 (i2+1) j2
-
-let rec _compare cmp a1 i1 j1 a2 i2 j2 =
-  if i1 = j1
-  then if i2=j2 then 0 else -1
-  else if i2=j2
-  then 1
-  else
-    let c = cmp a1.(i1) a2.(i2) in
-    if c = 0
-    then _compare cmp a1 (i1+1) j1 a2 (i2+1) j2
-    else c
-
-let equal eq a b =
-  length a = length b && _equal eq a.arr a.i a.j b.arr b.i b.j
-
-let compare cmp a b =
-  _compare cmp a.arr a.i a.j b.arr b.i b.j
-
-let fold f acc a =
-  let rec _fold acc i j =
-    if i=j then acc
-    else _fold (f acc a.arr.(i)) (i+1) j
-  in _fold acc a.i a.j
-
-let to_list a =
-  let l = fold (fun l x -> x::l) [] a in
-  List.rev l
-
-let foldi f acc a = _foldi f acc a.arr a.i a.j
-
-let fold_while f acc a =
-  let rec fold_while_i f acc i =
-    if i < Array.length a.arr && i < a.j then
-      let acc, cont = f acc a.arr.(i) in
-      match cont with
-        | `Stop -> acc
-        | `Continue -> fold_while_i f acc (i+1)
-    else acc
-  in fold_while_i f acc a.i
-
-let get a i =
-  let j = a.i + i in
-  if i<0 || j>=a.j then invalid_arg "Array_slice.get";
-  a.arr.(j)
-
-let get_safe a i =
-  try Some (get a i)
-  with Invalid_argument _ -> None
-
-(*$inject
-  let sub_a = make [|1;2;3;4;5|] 1 ~len:3
-*)
-
-(*$=
-  (Some 2) (get_safe sub_a 0)
-  (Some 3) (get_safe sub_a 1)
-  (Some 4) (get_safe sub_a 2)
-  None (get_safe sub_a 4)
-  None (get_safe sub_a max_int)
-  None (get_safe sub_a ~-1)
-  None (get_safe sub_a ~-42)
-*)
-
-let set a i x =
-  let j = a.i + i in
-  if i<0 || j>=a.j then invalid_arg "Array_slice.set";
-  a.arr.(j) <- x
-
-let iter f a =
-  for k=a.i to a.j-1 do f a.arr.(k) done
-
-let iteri f a =
-  for k=0 to length a-1 do f k a.arr.(a.i + k) done
-
-let blit a i b j len =
-  if i+len>length a || j+len>length b then invalid_arg "Array_slice.blit";
-  Array.blit a.arr (a.i+i) b.arr (b.i+j) len
-
-let rec _find f a i j =
-  if i = j then None
-  else match f i a.(i) with
-    | Some _ as res -> res
-    | None -> _find f a (i+1) j
-
-let rec _lookup_rec ~cmp k a i j =
-  if i>j then raise Not_found
-  else if i=j
-  then if cmp k a.(i) = 0
-    then i
-    else raise Not_found
-  else
-    let middle = (j+i)/2 in
-    match cmp k a.(middle) with
-      | 0 -> middle
-      | n when n<0 -> _lookup_rec ~cmp k a i (middle-1)
-      | _ -> _lookup_rec ~cmp k a (middle+1) j
-
-let _lookup_exn ~cmp k a i j =
-  if i>j then raise Not_found;
-  match cmp k a.(i) with
-    | 0 -> i
-    | n when n<0 -> raise Not_found (* too low *)
-    | _ when i=j -> raise Not_found (* too high *)
-    | _ ->
-      match cmp k a.(j) with
-        | 0 -> j
-        | n when n<0 -> _lookup_rec ~cmp k a (i+1) (j-1)
-        | _ -> raise Not_found  (* too high *)
-
-let bsearch_ ~cmp x arr i j =
-  let rec aux i j =
-    if i > j
-    then `Just_after j
-    else
-      let middle = i + (j - i) / 2 in (* avoid overflow *)
-      match cmp x arr.(middle) with
-        | 0 -> `At middle
-        | n when n<0 -> aux i (middle - 1)
-        | _ -> aux (middle + 1) j
-  in
-  if i>=j then `Empty
-  else match cmp arr.(i) x, cmp arr.(j) x with
-    | n, _ when n>0 -> `All_bigger
-    | _, n when n<0 -> `All_lower
-    | _ -> aux i j
-
-let rec _for_all p a i j =
-  i = j || (p a.(i) && _for_all p a (i+1) j)
-
-let rec _exists p a i j =
-  i <> j && (p a.(i) || _exists p a (i+1) j)
-
-let rec _for_all2 p a1 a2 i1 i2 ~len =
-  len=0 || (p a1.(i1) a2.(i2) && _for_all2 p a1 a2 (i1+1) (i2+1) ~len:(len-1))
-
-let rec _exists2 p a1 a2 i1 i2 ~len =
-  len>0 && (p a1.(i1) a2.(i2) || _exists2 p a1 a2 (i1+1) (i2+1) ~len:(len-1))
-
-(* shuffle a[i...j[ using the given int random generator
-   See http://en.wikipedia.org/wiki/Fisher-Yates_shuffle *)
-let _shuffle _rand_int a i j =
-  for k = j-1 downto i+1 do
-    let l = _rand_int (k+1) in
-    let tmp = a.(l) in
-    a.(l) <- a.(k);
-    a.(k) <- tmp;
-  done
-
-(*$T
-  let st = Random.State.make [||] in let a = 0--10000 in \
-  let b = Array.copy a in CCArray.shuffle_with st a; a <> b
-*)
-
-let _sort_indices cmp a i j =
-  let len = j-i in
-  let b = Array.init len (fun k->k) in
-  Array.sort (fun k1 k2 -> cmp a.(k1+i) a.(k2+i)) b;
-  b
-
-let _sorted cmp a i j =
-  let len = j-i in
-  let b = Array.sub a i len in
-  Array.sort cmp b;
-  b
-
-let _choose a i j st =
-  if i>=j then raise Not_found;
-  a.(i+Random.State.int st (j-i))
-
-let _pp ~sep pp_item out a i j =
-  for k = i to j - 1 do
-    if k > i then (Format.pp_print_string out sep; Format.pp_print_cut out ());
-    pp_item out a.(k)
-  done
-
-let _pp_i ~sep pp_item out a i j =
-  for k = i to j - 1 do
-    if k > i then (Format.pp_print_string out sep; Format.pp_print_cut out ());
-    pp_item k out a.(k)
-  done
-
-let _to_gen a i j =
-  let k = ref i in
-  fun () ->
-    if !k < j
-    then (
-      let x = a.(!k) in
-      incr k;
-      Some x
-    ) else None
-
-let rec _to_klist a i j () =
-  if i=j then `Nil else `Cons (a.(i), _to_klist a (i+1) j)
-
-let reverse_in_place a = _reverse_in_place a.arr a.i ~len:(length a)
-
-(*$T
-  let a = 1--6 in let s = make a 2 ~len:3 in \
-  reverse_in_place s; a = [| 1; 2; 5; 4; 3; 6 |]
-*)
-
-let sorted cmp a = _sorted cmp a.arr a.i a.j
-
-(*$= & ~cmp:(=) ~printer:Q.Print.(array int)
-  [||] \
-    (let a = 1--6 in let s = make a 2 ~len:0 in \
-     sorted Pervasives.compare s)
-  [|2;3;4|] \
-    (let a = [|6;5;4;3;2;1|] in let s = make a 2 ~len:3 in \
-    sorted Pervasives.compare s)
-*)
-
-(*$Q
-  Q.(array int) (fun a -> \
-  Array.length a > 10 ==> ( Array.length a > 10 && \
-  let s = make a 5 ~len:5 in \
-  let b = Array.sub a 5 5 in \
-  Array.sort Pervasives.compare b; b = sorted Pervasives.compare s))
-*)
-
-let sort_ranking cmp a =
-  let idx = _sort_indices cmp a.arr a.i a.j in
-  let cmp_int : int -> int -> int = Pervasives.compare in
-  let sort_indices cmp a = _sort_indices cmp a 0 (Array.length a) in
-  sort_indices cmp_int idx
-
-(*$= & ~cmp:(=) ~printer:Q.Print.(array int)
-  [||] \
-     (let a = 1--6 in let s = make a 2 ~len:0 in \
-     sort_ranking Pervasives.compare s)
-  [|2;1;3;0|] \
-    (let a = [|"d";"c";"b";"e";"a"|] in let s = make a 1 ~len:4 in \
-    sort_ranking Pervasives.compare s)
-*)
-
-(*$Q
-  Q.(array_of_size Gen.(0--50) printable_string) (fun a -> \
-  Array.length a > 10 ==> ( Array.length a > 10 && \
-  let s = make a 5 ~len:5 in \
-  let b = sort_indices String.compare s in \
-  sorted String.compare s = Array.map (get s) b))
-*)
-
-let sort_indices cmp a = _sort_indices cmp a.arr a.i a.j
-
-(*$= & ~cmp:(=) ~printer:Q.Print.(array int)
-  [||] \
-     (let a = 1--6 in let s = make a 2 ~len:0 in \
-     sort_indices Pervasives.compare s)
-  [|3;1;0;2|] \
-    (let a = [|"d";"c";"b";"e";"a"|] in let s = make a 1 ~len:4 in \
-    sort_indices Pervasives.compare s)
-*)
-
-(*$Q
-  Q.(array_of_size Gen.(0--60) printable_string) (fun a -> \
-  Array.length a > 10 ==> ( Array.length a > 10 && \
-  let s = make a 5 ~len:5 in \
-  let b = sort_ranking String.compare s in \
-  let a_sorted = sorted String.compare s in \
-  copy s = Array.map (Array.get a_sorted) b))
-*)
-
-
-let find f a = _find (fun _ -> f) a.arr a.i a.j
-
-let findi f a = _find (fun i -> f (i-a.i)) a.arr a.i a.j
-
-let find_idx p a =
-  _find (fun i x -> if p x then Some (i-a.i,x) else None) a.arr a.i a.j
-
-(*$=
-  (Some (1,"c")) (find_idx ((=) "c") (make [| "a"; "b"; "c" |] 1 2))
-*)
-
-let lookup_exn ?(cmp=Pervasives.compare) k a =
-  _lookup_exn ~cmp k a.arr a.i (a.j-1) - a.i
-
-let lookup ?(cmp=Pervasives.compare) k a =
-  try Some (_lookup_exn ~cmp k a.arr a.i (a.j-1) - a.i)
-  with Not_found -> None
-
-(*$=
-  (Some 1) (lookup "c" (make [| "a"; "b"; "c" |] 1 2))
-*)
-
-let bsearch ?(cmp=Pervasives.compare) k a =
-  match bsearch_ ~cmp k a.arr a.i (a.j - 1) with
-    | `At m -> `At (m - a.i)
-    | `Just_after m -> `Just_after (m - a.i)
-    | res -> res
-
-let for_all p a = _for_all p a.arr a.i a.j
-
-let exists p a = _exists p a.arr a.i a.j
-
-let for_all2 p a b =
-  length a = length b && _for_all2 p a.arr b.arr a.i b.i ~len:(length a)
-
-let exists2 p a b =
-  _exists2 p a.arr b.arr a.i b.i ~len:(min (length a) (length b))
-
-(*$T
-  exists2 (=) (make [| 1;2;3;4 |] 1 ~len:2) (make [| 0;1;3;4 |] 1 ~len:3)
-*)
-
-let _iter2 f a b i j ~len =
-  for o = 0 to len-1 do
-    f (Array.get a (i+o)) (Array.get b (j+o))
-  done
-
-let iter2 f a b =
-  if length a <> length b then invalid_arg "iter2";
-  _iter2 f a.arr b.arr a.i b.i ~len:(length a)
-
-let _fold2 f acc a b i j ~len =
-  let rec aux acc o =
-    if o=len then acc
-    else
-      let acc = f acc (Array.get a (i+o)) (Array.get b (j+o)) in
-      aux acc (o+1)
-  in
-  aux acc 0
-
-let fold2 f acc a b =
-  if length a <> length b then invalid_arg "fold2";
-  _fold2 f acc a.arr b.arr a.i b.i ~len:(length a)
-
-let shuffle a =
-  _shuffle Random.int a.arr a.i a.j
-
-let shuffle_with st a =
-  _shuffle (Random.State.int st) a.arr a.i a.j
-
-let random_choose a st = _choose a.arr a.i a.j st
-
-let pp ?(sep=", ") pp_item buf a = _pp ~sep pp_item buf a.arr a.i a.j
-
-let pp_i ?(sep=", ") pp_item out a =
-  _pp_i ~sep (fun k out x -> pp_item (k-a.i) out x) out a.arr a.i a.j
-
-let to_seq a k = iter k a
-
-let to_gen a = _to_gen a.arr a.i a.j
-
-let to_klist a = _to_klist a.arr a.i a.j

src/core/CCArray_slice.mli

@@ -1,194 +0,0 @@
-
-(* This file is free software, part of containers. See file "license" for more details. *)
-
-(** {1 Array Slice} *)
-
-type 'a sequence = ('a -> unit) -> unit
-type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
-type 'a gen = unit -> 'a option
-type 'a equal = 'a -> 'a -> bool
-type 'a ord = 'a -> 'a -> int
-type 'a random_gen = Random.State.t -> 'a
-type 'a printer = Format.formatter -> 'a -> unit
-
-type 'a t
-(** Array slice, containing elements of type ['a] *)
-
-val empty : 'a t
-
-val equal : 'a equal -> 'a t equal
-
-val compare : 'a ord -> 'a t ord
-
-val get : 'a t -> int -> 'a
-
-val get_safe : 'a t -> int -> 'a option
-(** [get_safe a i] returns [Some a.(i)] if [i] is a valid index
-    @since 0.18 *)
-
-val make : 'a array -> int -> len:int -> 'a t
-(** Create a slice from given offset and length..
-    @raise Invalid_argument if the slice isn't valid *)
-
-val of_slice : ('a array * int * int) -> 'a t
-(** Make a sub-array from a triple [(arr, i, len)] where [arr] is the array,
-    [i] the offset in [arr], and [len] the number of elements of the slice.
-    @raise Invalid_argument if the slice isn't valid (See {!make}) *)
-
-val to_slice : 'a t -> ('a array * int * int)
-(** Convert into a triple [(arr, i, len)] where [len] is the length of
-    the subarray of [arr] starting at offset [i] *)
-
-val to_list : 'a t -> 'a list
-(** Convert directly to a list
-    @since 1.0 *)
-
-val full : 'a array -> 'a t
-(** Slice that covers the full array *)
-
-val underlying : 'a t -> 'a array
-(** Underlying array (shared). Modifying this array will modify the slice *)
-
-val copy : 'a t -> 'a array
-(** Copy into a new array *)
-
-val sub : 'a t -> int -> int -> 'a t
-(** Sub-slice *)
-
-val set : 'a t -> int -> 'a -> unit
-
-val length : _ t -> int
-
-val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
-
-val foldi : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a
-(** Fold left on array, with index *)
-
-val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a
-(** Fold left on array until a stop condition via [('a, `Stop)] is
-    indicated by the accumulator
-    @since 0.8 *)
-
-val iter : ('a -> unit) -> 'a t -> unit
-
-val iteri : (int -> 'a -> unit) -> 'a t -> unit
-
-val blit : 'a t -> int -> 'a t -> int -> int -> unit
-(** [blit from i into j len] copies [len] elements from the first array
-    to the second. See {!Array.blit}. *)
-
-val reverse_in_place : 'a t -> unit
-(** Reverse the array in place *)
-
-val sorted : ('a -> 'a -> int) -> 'a t -> 'a array
-(** [sorted cmp a] makes a copy of [a] and sorts it with [cmp].
-    @since 1.0 *)
-
-val sort_indices : ('a -> 'a -> int) -> 'a t -> int array
-(** [sort_indices cmp a] returns a new array [b], with the same length as [a],
-    such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a] 
-    appears in [a]. [a] is not modified.
-
-    In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a]. 
-    [sort_indices] yields the inverse permutation of {!sort_ranking}.
-
-    @since 1.0 *)
-
-val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array
-(** [sort_ranking cmp a] returns a new array [b], with the same length as [a],
-    such that [b.(i)] is the index at which the [i]-the element of [a] appears
-    in [sorted cmp a]. [a] is not modified.
-
-    In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a]. 
-    [sort_ranking] yields the inverse permutation of {!sort_indices}.
-
-    In the absence of duplicate elements in [a], we also have
-    [lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)]
-    @since 1.0 *)
-
-val find : ('a -> 'b option) -> 'a t -> 'b option
-(** [find f a] returns [Some y] if there is an element [x] such
-    that [f x = Some y], else it returns [None] *)
-
-val findi : (int -> 'a -> 'b option) -> 'a t -> 'b option
-(** Like {!find}, but also pass the index to the predicate function.
-    @since 0.3.4 *)
-
-val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option
-(** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
-    and [p x] holds. Otherwise returns [None]
-    @since 0.3.4 *)
-
-val lookup : ?cmp:'a ord -> 'a -> 'a t -> int option
-(** Lookup the index of some value in a sorted array.
-    @return [None] if the key is not present, or
-      [Some i] ([i] the index of the key) otherwise *)
-
-val lookup_exn : ?cmp:'a ord -> 'a -> 'a t -> int
-(** Same as {!lookup}, but
-    @raise Not_found if the key is not present *)
-
-val bsearch : ?cmp:('a -> 'a -> int) -> 'a -> 'a t ->
-  [ `All_lower | `All_bigger | `Just_after of int | `Empty | `At of int ]
-(** [bsearch ?cmp x arr] finds the index of the object [x] in the array [arr],
-    provided [arr] is {b sorted} using [cmp]. If the array is not sorted,
-    the result is not specified (may raise Invalid_argument).
-
-    Complexity: O(log n) where n is the length of the array
-    (dichotomic search).
-
-    @return
-    - [`At i] if [cmp arr.(i) x = 0] (for some i)
-    - [`All_lower] if all elements of [arr] are lower than [x]
-    - [`All_bigger] if all elements of [arr] are bigger than [x]
-    - [`Just_after i] if [arr.(i) < x < arr.(i+1)]
-    - [`Empty] if the array is empty
-
-    @raise Invalid_argument if the array is found to be unsorted w.r.t [cmp]
-    @since 0.13 *)
-
-val for_all : ('a -> bool) -> 'a t -> bool
-
-val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
-(** Forall on pairs of arrays.
-    @raise Invalid_argument if they have distinct lengths
-    allow different types @since 0.20 *)
-
-val exists : ('a -> bool) -> 'a t -> bool
-
-val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
-(** Exists on pairs of arrays.
-    @raise Invalid_argument if they have distinct lengths
-    allow different types @since 0.20 *)
-
-val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
-(** Fold on two arrays stepwise.
-    @raise Invalid_argument if they have distinct lengths
-    @since 0.20 *)
-
-val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit
-(** Iterate on two arrays stepwise.
-    @raise Invalid_argument if they have distinct lengths
-    @since 0.20 *)
-
-val shuffle : 'a t -> unit
-(** Shuffle randomly the array, in place *)
-
-val shuffle_with : Random.State.t -> 'a t -> unit
-(** Like shuffle but using a specialized random state *)
-
-val random_choose : 'a t -> 'a random_gen
-(** Choose an element randomly.
-    @raise Not_found if the array/slice is empty *)
-
-val to_seq : 'a t -> 'a sequence
-val to_gen : 'a t -> 'a gen
-val to_klist : 'a t -> 'a klist
-
-(** {2 IO} *)
-
-val pp: ?sep:string -> 'a printer -> 'a t printer
-(** Print an array of items with printing function *)
-
-val pp_i: ?sep:string -> (int -> 'a printer) -> 'a t printer
-(** Print an array, giving the printing function both index and item *)

src/core/CCAtomic.ml

@@ -0,0 +1,69 @@
+[@@@ifge 4.12]
+
+include Atomic
+
+[@@@else_]
+
+open Stdlib (* for == *)
+
+type 'a t = { mutable x: 'a }
+
+let[@inline] make x = { x }
+let[@inline] get { x } = x
+let[@inline] set r x = r.x <- x
+
+let[@inline never] exchange r x =
+  (* atomic *)
+  let y = r.x in
+  r.x <- x;
+  (* atomic *)
+  y
+
+let[@inline never] compare_and_set r seen v =
+  (* atomic *)
+  if r.x == seen then (
+    r.x <- v;
+    (* atomic *)
+    true
+  ) else
+    false
+
+let[@inline never] fetch_and_add r x =
+  (* atomic *)
+  let v = r.x in
+  r.x <- x + r.x;
+  (* atomic *)
+  v
+
+let[@inline never] incr r =
+  (* atomic *)
+  r.x <- 1 + r.x
+(* atomic *)
+
+let[@inline never] decr r =
+  (* atomic *)
+  r.x <- r.x - 1
+(* atomic *)
+
+[@@@endif]
+
+(** Update loop with a compare-and-swap, and some basic backoff behavior.
+    [update_cas atomic f] is, in essence,
+    [let res, x = f !atomic in atomic := x; res]
+    done atomically. [f] might be called multiple times and must be as cheap
+    as possible.
+    @since 3.17 *)
+let update_cas (type res) (self : 'a t) (f : 'a -> res * 'a) : res =
+  let exception Ret of res in
+  let backoff = ref 1 in
+  try
+    while true do
+      let old_val = get self in
+      let res, new_val = f old_val in
+      if compare_and_set self old_val new_val then raise_notrace (Ret res);
+
+      Containers_domain.relax_loop !backoff;
+      backoff := min 128 (2 * !backoff)
+    done;
+    assert false
+  with Ret r -> r

src/core/CCBool.ml

@@ -1,13 +1,29 @@
-
 (* This file is free software, part of containers. See file "license" for more details. *)
 
 type t = bool
 
-let equal (a:bool) b = a=b
+let equal (a : bool) b = Stdlib.( = ) a b
+let compare (a : bool) b = Stdlib.compare a b
 
-let compare (a:bool) b = Pervasives.compare a b
+let if_then f x =
+  if x then
+    Some (f ())
+  else
+    None
 
-let negate = not
+let if_then_else f g x =
+  if x then
+    f ()
+  else
+    g ()
+
+let to_int (x : bool) : int =
+  if x then
+    1
+  else
+    0
+
+let of_int x : t = x <> 0
 
 type 'a printer = Format.formatter -> 'a -> unit
 

src/core/CCBool.mli

@@ -1,18 +1,30 @@
-
 (* This file is free software, part of containers. See file "license" for more details. *)
 
-(** {1 Basic Bool functions} *)
+(** Basic Bool functions *)
 
 type t = bool
 
 val compare : t -> t -> int
-(** Total ordering on booleans, similar to {!Pervasives.compare} *)
+(** [compare b1 b2] is the total ordering on booleans [b1] and [b2], similar to {!Stdlib.compare}. *)
 
 val equal : t -> t -> bool
+(** [equal b1 b2] is [true] if [b1] and [b2] are the same. *)
 
-val negate : t -> t
+val if_then : (unit -> 'a) -> t -> 'a option
-(** Negation on booleans (functional version of [not])
+(** [if_then f x] is [Some (f ())] if [x] is true and None otherwise.
-    @deprecated since 1.3, simply use {!not} instead *)
+    @since 3.13 *)
+
+val if_then_else : (unit -> 'a) -> (unit -> 'a) -> t -> 'a
+(** [if_then_else f g x] is [f ()] if [x] is true and [g ()] otherwise.
+    @since 3.13 *)
+
+val to_int : t -> int
+(** [to_int true = 1], [to_int false = 0].
+    @since 2.7 *)
+
+val of_int : int -> t
+(** [of_int i] is the same as [i <> 0]
+    @since 2.7 *)
 
 type 'a printer = Format.formatter -> 'a -> unit
 

src/core/CCByte_buffer.ml

@@ -0,0 +1,139 @@
+type 'a iter = ('a -> unit) -> unit
+
+type t = {
+  mutable bs: bytes;
+  mutable len: int;
+}
+
+let create ?(cap = 0) () : t =
+  let bs =
+    if cap = 0 then
+      Bytes.unsafe_of_string ""
+    else
+      Bytes.create cap
+  in
+  { len = 0; bs }
+
+let[@inline] capacity self : int = Bytes.length self.bs
+let[@inline] bytes self = self.bs
+let[@inline] length self = self.len
+let[@inline] is_empty self = self.len = 0
+let[@inline] clear self = self.len <- 0
+
+let grow_cap_ self =
+  min Sys.max_string_length
+    (let n = capacity self in
+     n + (n lsl 1) + 5)
+
+let grow_to_ self newcap =
+  if newcap = capacity self then invalid_arg "byte_buf: cannot grow further";
+  let newbytes = Bytes.create newcap in
+  Bytes.blit self.bs 0 newbytes 0 self.len;
+  self.bs <- newbytes
+
+let[@inline never] grow_ self =
+  let newcap = grow_cap_ self in
+  grow_to_ self newcap
+
+let[@inline never] ensure_cap_grow_ self n =
+  (* new capacity, make sure it's at least [grow_cap_] so
+     that repeated calls to [ensure_cap] have the amortized complexity *)
+  let newcap = max n (grow_cap_ self) in
+  grow_to_ self newcap
+
+let[@inline] ensure_cap self n =
+  if n > capacity self then ensure_cap_grow_ self n
+
+let[@inline] ensure_free self n =
+  if n > capacity self - self.len then ensure_cap_grow_ self (self.len + n)
+
+let[@inline] shrink_to self n = if self.len > n then self.len <- n
+
+let append_buf (self : t) buf : unit =
+  let n = Buffer.length buf in
+  ensure_cap self (length self + n);
+  Buffer.blit buf 0 self.bs self.len n;
+  self.len <- self.len + n
+
+let append_subbytes self b off len =
+  ensure_cap self (length self + len);
+  Bytes.blit b off self.bs self.len len;
+  self.len <- self.len + len
+
+let[@inline] append_bytes self b = append_subbytes self b 0 (Bytes.length b)
+let[@inline] append_string self s = append_bytes self (Bytes.unsafe_of_string s)
+
+let[@inline] append_substring self s off len =
+  append_subbytes self (Bytes.unsafe_of_string s) off len
+
+let[@inline] add_char_unsafe_ self c =
+  Bytes.unsafe_set self.bs self.len c;
+  self.len <- self.len + 1
+
+let[@inline] add_char self c =
+  if self.len = capacity self then grow_ self;
+  add_char_unsafe_ self c
+
+let[@inline] unsafe_get self i = Bytes.unsafe_get self.bs i
+let[@inline] unsafe_set self i c = Bytes.unsafe_set self.bs i c
+
+let[@inline] get self i =
+  if i < 0 || i >= self.len then invalid_arg "Byte_buf.get";
+  unsafe_get self i
+
+let[@inline] set self i c =
+  if i < 0 || i >= self.len then invalid_arg "Byte_buf.set";
+  unsafe_set self i c
+
+let[@inline] contents self = Bytes.sub_string self.bs 0 self.len
+let[@inline] contents_bytes self = Bytes.sub self.bs 0 self.len
+let[@inline] append_iter self i = i (add_char self)
+let[@inline] append_seq self seq = Seq.iter (add_char self) seq
+let[@inline] to_slice self = CCByte_slice.create ~len:self.len self.bs
+
+let fold_left f acc self =
+  let { bs; len } = self in
+
+  (* capture current content *)
+  let acc = ref acc in
+  for i = 0 to len do
+    acc := f !acc (Bytes.unsafe_get bs i)
+  done;
+  !acc
+
+let[@inline] iter f self =
+  (* capture current content *)
+  let { bs; len } = self in
+  for i = 0 to len do
+    f (Bytes.unsafe_get bs i)
+  done
+
+let[@inline] iteri f self =
+  let { bs; len } = self in
+  for i = 0 to len do
+    f i (Bytes.unsafe_get bs i)
+  done
+
+let of_seq seq =
+  let self = create ~cap:32 () in
+  append_seq self seq;
+  self
+
+let of_iter iter =
+  let self = create ~cap:32 () in
+  append_iter self iter;
+  self
+
+let to_iter self yield = iter yield self
+
+let to_seq self =
+  let { bs; len } = self in
+  let rec s i () =
+    if i = len then
+      Seq.Nil
+    else
+      Seq.Cons (Bytes.unsafe_get bs i, s (i + 1))
+  in
+  s 0
+
+(* TODO: unicode operators.*)

src/core/CCByte_buffer.mli

@@ -0,0 +1,111 @@
+(** Byte buffer.
+
+    A dynamic vector of bytes that doesn't hide its internal from you.
+    Same use case as [Buffer.t] but with more power.
+    @since 3.7
+*)
+
+type t = {
+  mutable bs: bytes;  (** The backing bytes buffer *)
+  mutable len: int;
+      (** Length of the "active" slice in [bs]. The actual content
+      of the buffer is [bs[0]..bs[len-1]]. What comes after
+      is undefined garbage. *)
+}
+(** The byte buffer.
+    The definition is public since 3.13.1 . *)
+
+type 'a iter = ('a -> unit) -> unit
+
+val create : ?cap:int -> unit -> t
+(** Create a new buffer with given initial capacity. *)
+
+val length : t -> int
+(** Current length. *)
+
+val is_empty : t -> bool
+(** [is_empty b] is [length b=0] *)
+
+val capacity : t -> int
+(** Current capacity (size of the array returned by {!bytes}) *)
+
+val bytes : t -> bytes
+(** Access the underlying byte buffer. This buffer can change after
+    operations that affect the capacity (e.g. {!add_char}). *)
+
+val clear : t -> unit
+(** [clear buf] sets [buf.len <- 0]. This doesn't resize the byte buffer. *)
+
+val ensure_cap : t -> int -> unit
+(** [ensure_cap self n] ensures that [capacity self >= n].
+    @raise Invalid_argument if this requires the buffer to grow beyond system limits. *)
+
+val ensure_free : t -> int -> unit
+(** [ensure_free buf n] ensures that the free space at the end of the
+    buffer is at least [n].
+    @raise Invalid_argument if this requires the buffer to grow beyond system limits. *)
+
+val shrink_to : t -> int -> unit
+(** [shrink_to buf n] reduces [length buf] to at most [n].
+    Does nothing if the length is already <= n. *)
+
+val add_char : t -> char -> unit
+(** Push a character at the end.
+    @raise Invalid_argument if this requires the buffer to grow beyond system limits. *)
+
+val append_bytes : t -> bytes -> unit
+(** Add bytes at the end *)
+
+val append_subbytes : t -> bytes -> int -> int -> unit
+(** Add byte slice at the end *)
+
+val append_string : t -> string -> unit
+(** Add string at the end *)
+
+val append_substring : t -> string -> int -> int -> unit
+(** Add substring at the end *)
+
+val append_buf : t -> Buffer.t -> unit
+(** Add content of the buffer at the end *)
+
+val append_iter : t -> char iter -> unit
+(** Adds characters from the iter *)
+
+val append_seq : t -> char Seq.t -> unit
+(** Adds characters from the seq *)
+
+val get : t -> int -> char
+(** Get the char at the given offset *)
+
+val unsafe_get : t -> int -> char
+(** Get the char at the given offset, unsafe (no bound check) *)
+
+val set : t -> int -> char -> unit
+(** Set the char at the given offset *)
+
+val unsafe_set : t -> int -> char -> unit
+(** Set the char at the given offset, unsafe (no bound check) *)
+
+val to_slice : t -> CCByte_slice.t
+(** [to_slice buf] returns a slice of the current content.
+    The slice shares the same byte array as [buf] (until [buf] is resized).
+    @since 3.13.1 *)
+
+val contents : t -> string
+(** Copy the internal data to a string. Allocates. *)
+
+val contents_bytes : t -> bytes
+(** Copy the internal data to a {!bytes}. Allocates. *)
+
+val iter : (char -> unit) -> t -> unit
+(** Iterate on the content *)
+
+val iteri : (int -> char -> unit) -> t -> unit
+(** Iterate with index.
+    @since 3.13.1 *)
+
+val fold_left : ('a -> char -> 'a) -> 'a -> t -> 'a
+val of_iter : char iter -> t
+val of_seq : char Seq.t -> t
+val to_iter : t -> char iter
+val to_seq : t -> char Seq.t

src/core/CCByte_slice.ml

@@ -0,0 +1,42 @@
+type t = {
+  bs: bytes;
+  mutable off: int;
+  mutable len: int;
+}
+
+let show self = Printf.sprintf "<slice len=%d>" self.len
+let pp out self = Format.pp_print_string out (show self)
+
+let create ?(off = 0) ?len bs =
+  let len =
+    match len with
+    | None -> Bytes.length bs - off
+    | Some n ->
+      if n < 0 || off + n > Bytes.length bs then
+        invalid_arg "Bslice: invalid length";
+      n
+  in
+  { bs; off; len }
+
+let[@inline] unsafe_of_string ?off ?len s =
+  create ?off ?len (Bytes.unsafe_of_string s)
+
+let[@inline] len self = self.len
+let[@inline] contents self = Bytes.sub_string self.bs self.off self.len
+
+let[@inline] get self i : char =
+  if i >= self.len then invalid_arg "Bslice: out of bound access";
+  Bytes.unsafe_get self.bs (self.off + i)
+
+let[@inline] set self i c : unit =
+  if i >= self.len then invalid_arg "Bslice: out of bound access";
+  Bytes.unsafe_set self.bs (self.off + i) c
+
+let sub self off len =
+  if off + len > self.len then invalid_arg "Bslice: invalid length";
+  { bs = self.bs; off = self.off + off; len }
+
+let[@inline] consume self n : unit =
+  if n > self.len then invalid_arg "Bslice: consuming too many bytes";
+  self.off <- self.off + n;
+  self.len <- self.len - n

src/core/CCByte_slice.mli

@@ -0,0 +1,49 @@
+(** A simple byte slice.
+
+    @since 3.13.1 *)
+
+type t = {
+  bs: bytes;  (** The bytes, potentially shared between many slices *)
+  mutable off: int;  (** Offset in [bs] *)
+  mutable len: int;
+      (** Length of the slice. Valid indices are [bs[off]…bs[off+len-1]],
+          inclusive. *)
+}
+
+val show : t -> string
+(** Simple printer (summary, doesn't show the content) *)
+
+val pp : Format.formatter -> t -> unit
+(** Simple printer (summary, doesn't show the content) *)
+
+val create : ?off:int -> ?len:int -> bytes -> t
+(** [create bs] creates a slice of [bs].
+ @param off optional starting offset
+ @param len length of the slice *)
+
+val unsafe_of_string : ?off:int -> ?len:int -> string -> t
+(** [unsafe_of_string s] makes a slice from a string.
+    This is unsafe because mutating the bytes is forbidden
+    (just like with {!Bytes.unsafe_of_string} *)
+
+val len : t -> int
+(** Access the length *)
+
+val get : t -> int -> char
+(** [get sl i] gets the [i]-th byte of the slice. Same as [sl.bs.[sl.off + i]].
+ @raise Invalid_argument if out of bounds. *)
+
+val set : t -> int -> char -> unit
+(** [set sl i c] sets the [i]-th byte to [c].
+ @raise Invalid_argument if out of bounds. *)
+
+val consume : t -> int -> unit
+(** [consume sl n] moves the offset forward by [n] bytes, and
+    reduces [len] by [n] bytes. *)
+
+val contents : t -> string
+(** A copy of the contents of the slice. Allocates. *)
+
+val sub : t -> int -> int -> t
+(** [sub sl off len] makes a new slice with the same
+    backing [bs]. *)

src/core/CCCanonical_sexp.ml

@@ -0,0 +1,297 @@
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** {1 Simple S-expression parsing/printing} *)
+
+type 'a or_error = ('a, string) result
+type 'a gen = unit -> 'a option
+
+module type SEXP = CCSexp_intf.BASIC_SEXP
+module type S = CCSexp_intf.S0
+
+let equal_string (a : string) b = Stdlib.( = ) a b
+let compare_string (a : string) b = Stdlib.compare a b
+
+let _with_in filename f =
+  let ic = open_in filename in
+  try
+    let x = f ic in
+    close_in ic;
+    x
+  with e ->
+    close_in ic;
+    Error (Printexc.to_string e)
+
+let _with_out filename f =
+  let oc = open_out filename in
+  try
+    let x = f oc in
+    close_out oc;
+    x
+  with e ->
+    close_out oc;
+    raise e
+
+module Make (Sexp : SEXP) = struct
+  type t = Sexp.t
+  type sexp = t
+
+  let atom = Sexp.atom
+  let list = Sexp.list
+  let of_int x = Sexp.atom (string_of_int x)
+  let of_float x = Sexp.atom (string_of_float x)
+  let of_bool x = Sexp.atom (string_of_bool x)
+  let of_unit = Sexp.list []
+  let of_list l = Sexp.list l
+  let of_rev_list l = Sexp.list (List.rev l)
+  let of_pair (x, y) = Sexp.list [ x; y ]
+  let of_triple (x, y, z) = Sexp.list [ x; y; z ]
+  let of_quad (x, y, z, u) = Sexp.list [ x; y; z; u ]
+  let of_variant name args = Sexp.list (Sexp.atom name :: args)
+  let of_field name t = Sexp.list [ Sexp.atom name; t ]
+  let of_record l = Sexp.list (List.map (fun (n, x) -> of_field n x) l)
+
+  (** {3 Printing} *)
+
+  let rec to_buf b t =
+    Sexp.match_ t
+      ~atom:(fun s -> Printf.bprintf b "%d:%s" (String.length s) s)
+      ~list:(function
+        | [] -> Buffer.add_string b "()"
+        | [ x ] -> Printf.bprintf b "(%a)" to_buf x
+        | l ->
+          Buffer.add_char b '(';
+          List.iter (to_buf b) l;
+          Buffer.add_char b ')')
+
+  let to_string t =
+    let b = Buffer.create 128 in
+    to_buf b t;
+    Buffer.contents b
+
+  let rec pp_noindent fmt t =
+    Sexp.match_ t
+      ~atom:(fun s -> Format.fprintf fmt "%d:%s" (String.length s) s)
+      ~list:(function
+        | [] -> Format.pp_print_string fmt "()"
+        | [ x ] -> Format.fprintf fmt "(%a)" pp_noindent x
+        | l ->
+          Format.fprintf fmt "(";
+          List.iter (pp_noindent fmt) l;
+          Format.fprintf fmt ")")
+
+  let pp = pp_noindent
+
+  let rec to_chan oc t =
+    Sexp.match_ t
+      ~atom:(fun s -> Printf.fprintf oc "%d:%s" (String.length s) s)
+      ~list:(function
+        | [] -> output_string oc "()"
+        | [ x ] -> Printf.fprintf oc "(%a)" to_chan x
+        | l ->
+          output_char oc '(';
+          List.iter (to_chan oc) l;
+          output_char oc ')')
+
+  let to_file_iter filename iter =
+    _with_out filename (fun oc -> iter (fun t -> to_chan oc t))
+
+  let to_file filename t = to_file_iter filename (fun k -> k t)
+
+  (** {3 Parsing} *)
+
+  module type INPUT = sig
+    exception EOF
+
+    val read_char : unit -> char
+    val read_string : int -> string
+  end
+
+  module Decoder (I : INPUT) = struct
+    let[@inline] is_num_ c =
+      Char.code c >= Char.code '0' && Char.code c <= Char.code '9'
+
+    let[@inline] as_num_ c = Char.code c - Char.code '0'
+
+    let next_ () : sexp or_error * bool =
+      let rec read_string_len n =
+        match I.read_char () with
+        | c when is_num_ c -> read_string_len ((n * 10) + as_num_ c)
+        | ':' ->
+          let s = I.read_string n in
+          atom s
+        | _ -> failwith "expected string length"
+      and eat_colon () =
+        match I.read_char () with
+        | ':' -> ()
+        | _ -> failwith "expected ':'"
+      and read_in_paren acc =
+        match I.read_char () with
+        | ')' -> list (List.rev acc)
+        | c when is_num_ c ->
+          let sexp = read_string_len (as_num_ c) in
+          read_in_paren (sexp :: acc)
+        | '(' ->
+          let sexp = read_in_paren [] in
+          read_in_paren (sexp :: acc)
+        | _ -> failwith "expected list of sexprs"
+      in
+      (* read a S-expr *)
+      try
+        match I.read_char () with
+        | exception I.EOF -> Error "unexpected EOF", true
+        | '(' -> Ok (read_in_paren []), false
+        | '0' ->
+          eat_colon ();
+          Ok (atom ""), false
+        | c when is_num_ c -> Ok (read_string_len (as_num_ c)), false
+        | _ -> Error "unexpected char, expected toplevel sexpr", false
+      with Failure e -> Error e, false
+
+    let to_list () : _ or_error =
+      let rec iter acc =
+        match next_ () with
+        | Error _, true -> Ok (List.rev acc)
+        | Ok x, _ -> iter (x :: acc)
+        | (Error _ as res), _ -> res
+      in
+      try iter [] with e -> Error (Printexc.to_string e)
+
+    let[@inline] next_or_error () : _ or_error = fst (next_ ())
+  end
+  [@@inline]
+
+  module Decoder_str (X : sig
+    val s : string
+  end) =
+  Decoder (struct
+    exception EOF
+
+    let i = ref 0
+    let n = String.length X.s
+
+    let read_char () =
+      if !i >= n then raise_notrace EOF;
+      let c = String.unsafe_get X.s !i in
+      incr i;
+      c
+
+    let read_string len =
+      if !i + len > n then raise_notrace EOF;
+      let res = String.sub X.s !i len in
+      i := !i + len;
+      res
+  end)
+  [@@inline]
+
+  let parse_string s : t or_error =
+    let module D = Decoder_str (struct
+      let s = s
+    end) in
+    D.next_or_error ()
+
+  let parse_string_list s : t list or_error =
+    let module D = Decoder_str (struct
+      let s = s
+    end) in
+    D.to_list ()
+
+  module Decoder_ic (X : sig
+    val ic : in_channel
+  end) =
+  Decoder (struct
+    exception EOF = End_of_file
+
+    let[@inline] read_char () = input_char X.ic
+
+    let read_string n =
+      match n with
+      | 0 -> ""
+      | 1 -> String.make 1 (read_char ())
+      | _ ->
+        let buf = Bytes.make n '\000' in
+        let i = ref 0 in
+        while !i < n do
+          let len = input X.ic buf !i (n - !i) in
+          i := !i + len
+        done;
+        Bytes.unsafe_to_string buf
+  end)
+  [@@inline]
+
+  let parse_chan_ ?file ic : sexp or_error =
+    let module D = Decoder_ic (struct
+      let ic = ic
+    end) in
+    match D.next_or_error (), file with
+    | Error s, Some file -> Error (Printf.sprintf "%s in '%s'" s file)
+    | r, _ -> r
+
+  let parse_chan_list_ ?file ic =
+    let module D = Decoder_ic (struct
+      let ic = ic
+    end) in
+    match D.to_list (), file with
+    | Error s, Some file -> Error (Printf.sprintf "%s in '%s'" s file)
+    | r, _ -> r
+
+  let parse_chan ic = parse_chan_ ic
+  let parse_chan_list ic = parse_chan_list_ ic
+
+  let parse_chan_gen ic =
+    let module D = Decoder_ic (struct
+      let ic = ic
+    end) in
+    fun () ->
+      match D.next_ () with
+      | _, true -> None
+      | Error e, _ -> Some (Error e)
+      | Ok x, _ -> Some (Ok x)
+
+  let parse_file filename = _with_in filename (parse_chan_ ~file:filename)
+
+  let parse_file_list filename =
+    _with_in filename (parse_chan_list_ ~file:filename)
+end
+
+type t =
+  [ `Atom of string
+  | `List of t list
+  ]
+
+let rec equal a b =
+  match a, b with
+  | `Atom s1, `Atom s2 -> equal_string s1 s2
+  | `List l1, `List l2 ->
+    (try List.for_all2 equal l1 l2 with Invalid_argument _ -> false)
+  | `Atom _, _ | `List _, _ -> false
+
+let rec compare_list a b =
+  match a, b with
+  | [], [] -> 0
+  | [], _ :: _ -> -1
+  | _ :: _, [] -> 1
+  | x :: xs, y :: ys ->
+    (match compare x y with
+    | 0 -> compare_list xs ys
+    | c -> c)
+
+and compare a b =
+  match a, b with
+  | `Atom s1, `Atom s2 -> compare_string s1 s2
+  | `List l1, `List l2 -> compare_list l1 l2
+  | `Atom _, _ -> -1
+  | `List _, _ -> 1
+
+module Basic_ = struct
+  type nonrec t = t
+
+  let atom x = `Atom x
+  let list x = `List x
+
+  let match_ x ~atom ~list =
+    match x with
+    | `Atom x -> atom x
+    | `List l -> list l
+end
+
+include (Make (Basic_) : S with type t := t)

src/core/CCCanonical_sexp.mli

@@ -0,0 +1,33 @@
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** Canonical S-expressions
+
+    See {{: https://en.wikipedia.org/wiki/Canonical_S-expressions} wikipedia}.
+    These S-expressions are binary safe.
+
+    @since 3.3
+*)
+
+type 'a or_error = ('a, string) result
+type 'a gen = unit -> 'a option
+
+module type SEXP = CCSexp_intf.BASIC_SEXP
+module type S = CCSexp_intf.S0
+
+(** {2 Parser and printer} *)
+module Make (Sexp : SEXP) : S with type t = Sexp.t
+
+(** {2 Basics} *)
+
+type t =
+  [ `Atom of string
+  | `List of t list
+  ]
+(** A simple, structural representation of S-expressions.
+    Compatible with {!CCSexp}. *)
+
+include S with type t := t
+
+val equal : t -> t -> bool
+val compare : t -> t -> int
+val atom : string -> t

src/core/CCChar.ml

@@ -6,21 +6,29 @@
 
 include Char
 
-let equal (a:char) b = a=b
+let pp_buf = Buffer.add_char
-
+let pp = Format.pp_print_char
-let pp = Buffer.add_char
-let print = Format.pp_print_char
-
 let of_int_exn = Char.chr
-let of_int c = try Some (of_int_exn c) with _ -> None
+let of_int c = try Some (of_int_exn c) with Invalid_argument _ -> None
 let to_int = Char.code
+let to_string c = String.make 1 c
 
-let lowercase_ascii c =
+module Infix = struct
-  if c >= 'A' && c <= 'Z'
+  let ( = ) : t -> t -> bool = Stdlib.( = )
-  then Char.unsafe_chr (Char. code c + 32)
+  let ( <> ) : t -> t -> bool = Stdlib.( <> )
-  else c
+  let ( < ) : t -> t -> bool = Stdlib.( < )
+  let ( > ) : t -> t -> bool = Stdlib.( > )
+  let ( <= ) : t -> t -> bool = Stdlib.( <= )
+  let ( >= ) : t -> t -> bool = Stdlib.( >= )
+end
 
-let uppercase_ascii c =
+include Infix
-  if c >= 'a' && c <= 'z'
+
-  then Char.unsafe_chr (Char.code c - 32)
+let is_uppercase_ascii c = c > '\064' && c < '\091'
-  else c
+let is_lowercase_ascii c = c > '\096' && c < '\123'
+
+let is_letter_ascii c =
+  (is_lowercase_ascii [@inlined]) c || (is_uppercase_ascii [@inlined]) c
+
+let is_digit_ascii c = c > '\047' && c < '\058'
+let is_whitespace_ascii c = c = '\032' || (c > '\008' && c < '\014')

src/core/CCChar.mli

@@ -1,34 +1,93 @@
 (* This file is free software, part of containers. See file "license" for more details. *)
 
-(** {1 Utils around char}
+(** Utils around char
 
     @since 0.14 *)
 
-include module type of Char
+(** @inline *)
+include module type of struct
+  include Char
+end
 
-val equal : t -> t -> bool
 val compare : t -> t -> int
-
+(** The comparison function for characters, with the same specification as
-val lowercase_ascii : t -> t
+    {!Stdlib.compare}.  Along with the type [t], this function [compare]
-(** See {!Char}
+    allows the module [Char] to be passed as argument to the functors
-    @since 0.20 *)
+    {!Set.Make} and {!Map.Make}. *)
-
-val uppercase_ascii : t -> t
-(** See {!Char}
-    @since 0.20 *)
 
 val of_int_exn : int -> t
-(** Alias to {!Char.chr}
+(** Alias to {!Char.chr}.
-    @raise Invalid_argument if the int is not within [0,...,255]
+    Return the character with the given ASCII code.
+    @raise Invalid_argument if the int is not within [0 … 255].
     @since 1.0 *)
 
 val of_int : int -> t option
-(** Safe version of {!of_int}
+(** Safe version of {!of_int_exn}.
     @since 1.0 *)
 
 val to_int : t -> int
-(** Alias to {!Char.code}
+(** Alias to {!Char.code}.
+    Return the ASCII code of the argument.
     @since 1.0 *)
 
-val pp : Buffer.t -> t -> unit
+val to_string : t -> string
-val print : Format.formatter -> t -> unit
+(** [to_string c] returns a string containing [c]
+    @since 2.7 *)
+
+val pp_buf : Buffer.t -> t -> unit
+(** Renamed from [pp] since 2.0. *)
+
+val pp : Format.formatter -> t -> unit
+(** Renamed from [print] since 2.0. *)
+
+val is_uppercase_ascii : t -> bool
+(** [is_uppercase_ascii c] is true exactly when  [c] is an
+    uppercase ASCII character, i.e. ['\064'] < [c] < ['\091'].
+    @since 3.16 *)
+
+val is_lowercase_ascii : t -> bool
+(** [is_lowercase_ascii c] is true exactly when [c] is a
+    lowercase ASCII character, i.e. ['\096'] < [c] < ['\123'].
+    @since 3.16 *)
+
+val is_letter_ascii : t -> bool
+(** [is_letter_ascii c] is true exactly when [c] is an ASCII
+    letter, i.e. [is_uppercase_ascii c || is_lowercase_ascii c].
+    @since 3.16 *)
+
+val is_digit_ascii : t -> bool
+(** [is_digit_ascii c] is true exactly when [c] is an
+    ASCII digit, i.e. ['\047'] < [c] < ['\058'].
+    @since 3.16 *)
+
+val is_whitespace_ascii : t -> bool
+(** [is_whitespace_ascii c] is true exactly when [c] is an ASCII
+    whitespace character as defined by Unicode, i.e. either [c = ' ']
+    or ['\008'] < [c] < ['\014'].
+    @since 3.16 *)
+
+(** {2 Infix Operators}
+
+    @since 3.3 *)
+
+module Infix : sig
+  val ( = ) : t -> t -> bool
+  (** @since 3.3 *)
+
+  val ( <> ) : t -> t -> bool
+  (** @since 3.3 *)
+
+  val ( < ) : t -> t -> bool
+  (** @since 3.3 *)
+
+  val ( > ) : t -> t -> bool
+  (** @since 3.3 *)
+
+  val ( <= ) : t -> t -> bool
+  (** @since 3.3 *)
+
+  val ( >= ) : t -> t -> bool
+  (** @since 3.3 *)
+end
+
+include module type of Infix

src/core/CCEither.ml

@@ -0,0 +1,69 @@
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+type 'a iter = ('a -> unit) -> unit
+type 'a equal = 'a -> 'a -> bool
+type 'a ord = 'a -> 'a -> int
+type 'a printer = Format.formatter -> 'a -> unit
+
+(** {2 Basics} *)
+
+type ('a, 'b) t = ('a, 'b) Either.t =
+  | Left of 'a
+  | Right of 'b
+
+let left l = Left l
+let right r = Right r
+
+let is_left = function
+  | Left _ -> true
+  | Right _ -> false
+
+let is_right = function
+  | Left _ -> false
+  | Right _ -> true
+
+let find_left = function
+  | Left l -> Some l
+  | Right _ -> None
+
+let find_right = function
+  | Left _ -> None
+  | Right r -> Some r
+
+let map_left f = function
+  | Left l -> Left (f l)
+  | Right r -> Right r
+
+let map_right f = function
+  | Left l -> Left l
+  | Right r -> Right (f r)
+
+let map ~left ~right = function
+  | Left l -> Left (left l)
+  | Right r -> Right (right r)
+
+let fold ~left ~right = function
+  | Left l -> left l
+  | Right r -> right r
+
+let iter = fold
+let for_all = fold
+
+let equal ~left ~right e1 e2 =
+  match e1, e2 with
+  | Left l1, Left l2 -> left l1 l2
+  | Right r1, Right r2 -> right r1 r2
+  | _ -> false
+
+let compare ~left ~right e1 e2 =
+  match e1, e2 with
+  | Left _, Right _ -> -1
+  | Right _, Left _ -> 1
+  | Left l1, Left l2 -> left l1 l2
+  | Right r1, Right r2 -> right r1 r2
+
+(** {2 IO} *)
+
+let pp ~left ~right fmt = function
+  | Left l -> Format.fprintf fmt "Left@ (@[%a@])" left l
+  | Right r -> Format.fprintf fmt "Right@ (@[%a@])" right r

src/core/CCEither.mli

@@ -0,0 +1,76 @@
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** Either Monad
+
+    Module that is compatible with Either from OCaml 4.12 but can be use with any
+    ocaml version compatible with container
+
+    @since 3.2
+*)
+
+type 'a iter = ('a -> unit) -> unit
+type 'a equal = 'a -> 'a -> bool
+type 'a ord = 'a -> 'a -> int
+type 'a printer = Format.formatter -> 'a -> unit
+
+(** {2 Basics} *)
+
+type ('a, 'b) t = ('a, 'b) Either.t =
+  | Left of 'a
+  | Right of 'b
+
+val left : 'a -> ('a, 'b) t
+(** [left l] is [Left l] *)
+
+val right : 'b -> ('a, 'b) t
+(** [right r] is [Right r] *)
+
+val is_left : ('a, 'b) t -> bool
+(** [is_left x] checks if [x = Left _] *)
+
+val is_right : ('a, 'b) t -> bool
+(** [is_right x] checks if [x = Right _] *)
+
+val find_left : ('a, 'b) t -> 'a option
+(** [find_left x] returns [l] if [x = Left l] and [None] otherwise. *)
+
+val find_right : ('a, 'b) t -> 'b option
+(** [find_right x] returns [r] if [x = Left r] and [None] otherwise. *)
+
+val map_left : ('a1 -> 'a2) -> ('a1, 'b) t -> ('a2, 'b) t
+(** Map of the Left variant. *)
+
+val map_right : ('b1 -> 'b2) -> ('a, 'b1) t -> ('a, 'b2) t
+(** Map of the Right variant. *)
+
+val map :
+  left:('a1 -> 'a2) -> right:('b1 -> 'b2) -> ('a1, 'b1) t -> ('a2, 'b2) t
+(** Map using [left] or [right]. *)
+
+val fold : left:('a -> 'c) -> right:('b -> 'c) -> ('a, 'b) t -> 'c
+(** Fold using [left] or [right]. *)
+
+val iter : left:('a -> unit) -> right:('b -> unit) -> ('a, 'b) t -> unit
+(** Iter using [left] or [right]. *)
+
+val for_all : left:('a -> bool) -> right:('b -> bool) -> ('a, 'b) t -> bool
+(** Check some property on [Left] or [Right] variant. *)
+
+val equal :
+  left:('a -> 'a -> bool) ->
+  right:('b -> 'b -> bool) ->
+  ('a, 'b) t ->
+  ('a, 'b) t ->
+  bool
+
+val compare :
+  left:('a -> 'a -> int) ->
+  right:('b -> 'b -> int) ->
+  ('a, 'b) t ->
+  ('a, 'b) t ->
+  int
+
+(** {2 IO} *)
+
+val pp : left:'a printer -> right:'b printer -> ('a, 'b) t printer
+(** Pretty printer. *)

src/core/CCEqual.ml

@@ -1,50 +1,46 @@
-
 (* This file is free software, part of containers. See file "license" for more details. *)
 
 (** {1 Equality Combinators} *)
 
 type 'a t = 'a -> 'a -> bool
 
-let poly = (=)
+let poly = Stdlib.( = )
-
+let physical = Stdlib.( == )
-let int : int t = (=)
+let int : int t = ( = )
-let string : string t = (=)
+let string : string t = Stdlib.( = )
-let bool : bool t = (=)
+let bool : bool t = Stdlib.( = )
-let float : float t = (=)
+let float : float t = Stdlib.( = )
 let unit () () = true
 
-let rec list f l1 l2 = match l1, l2 with
+let rec list f l1 l2 =
+  match l1, l2 with
   | [], [] -> true
   | [], _ | _, [] -> false
-  | x1::l1', x2::l2' -> f x1 x2 && list f l1' l2'
+  | x1 :: l1', x2 :: l2' -> f x1 x2 && list f l1' l2'
 
 let array eq a b =
   let rec aux i =
-    if i = Array.length a then true
+    if i = Array.length a then
-    else eq a.(i) b.(i) && aux (i+1)
+      true
+    else
+      eq a.(i) b.(i) && aux (i + 1)
   in
-  Array.length a = Array.length b
+  Array.length a = Array.length b && aux 0
-  &&
-  aux 0
 
-let option f o1 o2 = match o1, o2 with
+let option f o1 o2 =
+  match o1, o2 with
   | None, None -> true
-  | Some _, None
+  | Some _, None | None, Some _ -> false
-  | None, Some _ -> false
   | Some x, Some y -> f x y
 
-let pair f g (x1,y1)(x2,y2) = f x1 x2 && g y1 y2
+let pair f g (x1, y1) (x2, y2) = f x1 x2 && g y1 y2
-let triple f g h (x1,y1,z1)(x2,y2,z2) = f x1 x2 && g y1 y2 && h z1 z2
+let triple f g h (x1, y1, z1) (x2, y2, z2) = f x1 x2 && g y1 y2 && h z1 z2
-
 let map f eq x y = eq (f x) (f y)
-
+let always_eq _ _ = true
-(*$Q
+let never_eq _ _ = false
-  Q.(let p = small_list (pair small_int bool) in pair p p) (fun (l1,l2) -> \
-    CCEqual.(list (pair int bool)) l1 l2 = (l1=l2))
-*)
 
 module Infix = struct
-  let (>|=) x f = map f x
+  let ( >|= ) x f = map f x
 end
 
 include Infix

src/core/CCEqual.mli

@@ -1,7 +1,8 @@
+(*  AUTOGENERATED FROM CCEqualLabels.mli  *)
 
 (* This file is free software, part of containers. See file "license" for more details. *)
 
-(** {1 Equality Combinators} *)
+(** Equality Combinators *)
 
 (** @since 1.2 *)
 
@@ -9,17 +10,19 @@ type 'a t = 'a -> 'a -> bool
 (** Equality function. Must be transitive, symmetric, and reflexive. *)
 
 val poly : 'a t
-(** Standard polymorphic equality *)
+(** Standard polymorphic equality. *)
+
+val physical : 'a t
+(** Standard physical equality.
+    @since 2.0 *)
 
 val int : int t
 val string : string t
 val bool : bool t
 val float : float t
 val unit : unit t
-
 val list : 'a t -> 'a list t
 val array : 'a t -> 'a array t
-
 val option : 'a t -> 'a option t
 val pair : 'a t -> 'b t -> ('a * 'b) t
 val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
@@ -32,9 +35,19 @@ val map : ('a -> 'b) -> 'b t -> 'a t
     [map fst int] compares values of type [(int * 'a)]  by their
       first component. *)
 
-val (>|=) : 'b t -> ('a -> 'b) -> 'a t
+val always_eq : _ t
-(** Infix equivalent of {!map} *)
+(** Always returns true. All values are equal.
+    @since 3.0 *)
+
+val never_eq : _ t
+(** Always returns false. No values are, so this
+    is not even reflexive (i.e. [x=x] is false).
+    Be careful!
+    @since 3.0 *)
 
 module Infix : sig
-  val (>|=) : 'b t -> ('a -> 'b) -> 'a t
+  val ( >|= ) : 'b t -> ('a -> 'b) -> 'a t
+  (** Infix equivalent of {!map}. *)
 end
+
+include module type of Infix

src/core/CCEqualLabels.ml

@@ -0,0 +1,3 @@
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+include CCEqual

src/core/CCEqualLabels.mli

@@ -0,0 +1,51 @@
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** Equality Combinators (Labeled version of {!CCEqual}) *)
+
+(** @since 1.2 *)
+
+type 'a t = 'a -> 'a -> bool
+(** Equality function. Must be transitive, symmetric, and reflexive. *)
+
+val poly : 'a t
+(** Standard polymorphic equality. *)
+
+val physical : 'a t
+(** Standard physical equality.
+    @since 2.0 *)
+
+val int : int t
+val string : string t
+val bool : bool t
+val float : float t
+val unit : unit t
+val list : 'a t -> 'a list t
+val array : 'a t -> 'a array t
+val option : 'a t -> 'a option t
+val pair : 'a t -> 'b t -> ('a * 'b) t
+val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
+
+val map : f:('a -> 'b) -> 'b t -> 'a t
+(** [map f eq] is the equality function that, given objects [x] and [y],
+    projects [x] and [y] using [f] (e.g. using a record field) and then
+    compares those projections with [eq].
+    Example:
+    [map fst int] compares values of type [(int * 'a)]  by their
+      first component. *)
+
+val always_eq : _ t
+(** Always returns true. All values are equal.
+    @since 3.9 *)
+
+val never_eq : _ t
+(** Always returns false. No values are, so this
+    is not even reflexive (i.e. [x=x] is false).
+    Be careful!
+    @since 3.9 *)
+
+module Infix : sig
+  val ( >|= ) : 'b t -> ('a -> 'b) -> 'a t
+  (** Infix equivalent of {!map}. *)
+end
+
+include module type of Infix

src/core/CCFloat.ml

@@ -1,46 +1,74 @@
-
 (* This file is free software, part of containers. See file "license" for more details. *)
 
 type t = float
-type fpclass = Pervasives.fpclass =
+
+type fpclass = Stdlib.fpclass =
   | FP_normal
   | FP_subnormal
   | FP_zero
   | FP_infinite
   | FP_nan
 
-let nan = Pervasives.nan
+module Infix = struct
+  let ( = ) : t -> t -> bool = Stdlib.( = )
+  let ( <> ) : t -> t -> bool = Stdlib.( <> )
+  let ( < ) : t -> t -> bool = Stdlib.( < )
+  let ( > ) : t -> t -> bool = Stdlib.( > )
+  let ( <= ) : t -> t -> bool = Stdlib.( <= )
+  let ( >= ) : t -> t -> bool = Stdlib.( >= )
+  let ( ~- ) : t -> t = Stdlib.( ~-. )
+  let ( + ) : t -> t -> t = Stdlib.( +. )
+  let ( - ) : t -> t -> t = Stdlib.( -. )
+  let ( * ) : t -> t -> t = Stdlib.( *. )
+  let ( / ) : t -> t -> t = Stdlib.( /. )
+end
 
-let infinity = Pervasives.infinity
+include Infix
-let neg_infinity = Pervasives.neg_infinity
 
+[@@@ocaml.warning "-32"]
+
+let nan = Stdlib.nan
+let infinity = Stdlib.infinity
+let neg_infinity = Stdlib.neg_infinity
 let max_value = infinity
 let min_value = neg_infinity
-
+let max_finite_value = Stdlib.max_float
-let max_finite_value = Pervasives.max_float
+let epsilon = Stdlib.epsilon_float
-
+let pi = 0x1.921fb54442d18p+1
-let epsilon = Pervasives.epsilon_float
+let is_nan x = Stdlib.(classify_float x = Stdlib.FP_nan)
-
+let add = ( +. )
-let is_nan x = (x : t) <> x
+let sub = ( -. )
-
+let mul = ( *. )
-let add = (+.)
+let div = ( /. )
-let sub = (-.)
+let neg = ( ~-. )
-let neg = (~-.)
+let abs = Stdlib.abs_float
-let abs = Pervasives.abs_float
 let scale = ( *. )
 
 let min (x : t) y =
-  if is_nan x || is_nan y then nan
+  match Stdlib.classify_float x, Stdlib.classify_float y with
-  else if x < y then x else y
+  | FP_nan, _ -> y
+  | _, FP_nan -> x
+  | _ ->
+    if x < y then
+      x
+    else
+      y
 
 let max (x : t) y =
-  if is_nan x || is_nan y then nan
+  match Stdlib.classify_float x, Stdlib.classify_float y with
-  else if x > y then x else y
+  | FP_nan, _ -> y
+  | _, FP_nan -> x
+  | _ ->
+    if x > y then
+      x
+    else
+      y
 
-let equal (a:float) b = a=b
+let equal (a : float) b = a = b
+let hash : t -> int = Hashtbl.hash
+let compare (a : float) b = Stdlib.compare a b
 
-let hash = Hashtbl.hash
+[@@@ocaml.warning "+32"]
-let compare (a:float) b = Pervasives.compare a b
 
 type 'a printer = Format.formatter -> 'a -> unit
 type 'a random_gen = Random.State.t -> 'a
@@ -48,49 +76,39 @@ type 'a random_gen = Random.State.t -> 'a
 let pp = Format.pp_print_float
 
 let fsign a =
-  if is_nan a then nan
+  if is_nan a then
-  else if a = 0. then a
+    nan
-  else Pervasives.copysign 1. a
+  else if a = 0. then
+    a
+  else
+    Stdlib.copysign 1. a
 
 exception TrapNaN of string
 
-let sign_exn (a:float) =
+let sign_exn (a : float) =
-  if is_nan a then raise (TrapNaN "sign_exn")
+  if is_nan a then
-  else compare a 0.
+    raise (TrapNaN "sign_exn")
+  else
+    compare a 0.
 
 let round x =
   let low = floor x in
   let high = ceil x in
-  if x-.low > high-.x then high else low
+  if x -. low > high -. x then
+    high
+  else
+    low
 
-(*$=
+let to_int (a : float) = Stdlib.int_of_float a
-  2. (round 1.6)
+let of_int (a : int) = Stdlib.float_of_int a
-  1. (round 1.4)
+let to_string (a : float) = Stdlib.string_of_float a
-  0. (round 0.)
+let of_string_exn (a : string) = Stdlib.float_of_string a
-*)
-
-let to_int (a:float) = Pervasives.int_of_float a
-let of_int (a:int) = Pervasives.float_of_int a
-
-let to_string (a:float) = Pervasives.string_of_float a
-let of_string_exn (a:string) = Pervasives.float_of_string a
-let of_string (a:string) = Pervasives.float_of_string a
 
+let of_string_opt (a : string) =
+  try Some (Stdlib.float_of_string a) with Failure _ -> None
 
 let random n st = Random.State.float st n
 let random_small = random 100.0
-let random_range i j st = i +. random (j-.i) st
+let random_range i j st = i +. random (j -. i) st
-
+let equal_precision ~epsilon a b = abs_float (a -. b) < epsilon
-let equal_precision ~epsilon a b = abs_float (a-.b) < epsilon
+let classify = Stdlib.classify_float
-
-let classify = Pervasives.classify_float
-
-module Infix = struct
-  let (=) = Pervasives.(=)
-  let (<>) = Pervasives.(<>)
-  let (<) = Pervasives.(<)
-  let (>) = Pervasives.(>)
-  let (<=) = Pervasives.(<=)
-  let (>=) = Pervasives.(>=)
-end
-include Infix

src/core/CCFloat.mli

@@ -1,11 +1,11 @@
-
 (* This file is free software, part of containers. See file "license" for more details. *)
 
-(** {1 Basic Float functions}
+(** Basic operations on floating-point numbers
     @since 0.6.1 *)
 
 type t = float
-type fpclass = Pervasives.fpclass =
+
+type fpclass = Stdlib.fpclass =
   | FP_normal
   | FP_subnormal
   | FP_zero
@@ -13,41 +13,61 @@ type fpclass = Pervasives.fpclass =
   | FP_nan
 
 val nan : t
+(** [nan] is Not a Number (NaN). Equal to {!Stdlib.nan}. *)
 
 val max_value : t
+(** [max_value] is Positive infinity. Equal to {!Stdlib.infinity}. *)
+
 val min_value : t
+(** [min_value] is Negative infinity. Equal to {!Stdlib.neg_infinity}. *)
 
 val max_finite_value : t
+(** [max_finite_value] is the largest finite float value. Equal to {!Stdlib.max_float}. *)
 
 val epsilon : t
+(** [epsilon] is the smallest positive float x such that [1.0 +. x <> 1.0].
+    Equal to {!Stdlib.epsilon_float}. *)
+
+val pi : t
+(** [pi] is the constant pi. The ratio of a circumference to its diameter.
+    @since 3.0 *)
 
 val is_nan : t -> bool
+(** [is_nan f] returns [true] if f is NaN, [false] otherwise. *)
 
 val add : t -> t -> t
+(** [add x y] is equal to [x +. y]. *)
 
 val sub : t -> t -> t
+(** [sub x y] is equal to [x -. y]. *)
 
 val neg : t -> t
+(** [neg x] is equal to [~-. x]. *)
 
 val abs : t -> t
+(** [abs x] is the absolute value of the floating-point number [x].
+    Equal to {!Stdlib.abs_float}. *)
 
 val scale : t -> t -> t
+(** [scale x y] is equal to [x *. y]. *)
 
 val min : t -> t -> t
+(** [min x y] returns the min of the two given values [x] and [y]. *)
 
 val max : t -> t -> t
+(** [max x y] returns the max of the two given values [x] and [y]. *)
 
 val equal : t -> t -> bool
+(** [equal x y] is [true] if [x] and [y] are the same. *)
 
 val compare : t -> t -> int
+(** [compare x y] is {!Stdlib.compare x y}. *)
 
 type 'a printer = Format.formatter -> 'a -> unit
 type 'a random_gen = Random.State.t -> 'a
 
 val pp : t printer
-
 val hash : t -> int
-
 val random : t -> t random_gen
 val random_small : t random_gen
 val random_range : t -> t -> t random_gen
@@ -57,13 +77,15 @@ val fsign : t -> t
     @since 0.7 *)
 
 val round : t -> t
-(** [round f] returns the closest integer value, either above or below
+(** [round x] returns the closest integer value, either above or below.
+    For [n + 0.5], [round] returns [n].
     @since 0.20 *)
 
 exception TrapNaN of string
+
 val sign_exn : t -> int
 (** [sign_exn x] will return the sign of [x] as [1, 0] or [-1], or raise an
-    exception [TrapNaN] if [x] is a NaN.
+    exception [TrapNaN] if [x] is NaN.
     Note that infinities have defined signs in OCaml.
     @since 0.7 *)
 
@@ -72,46 +94,67 @@ val to_int : t -> int
     Unspecified if outside of the range of integers. *)
 
 val of_int : int -> t
-(** Alias to {!float_of_int} *)
+(** Alias to {!float_of_int}. *)
 
 val to_string : t -> string
 
 val of_string_exn : string -> t
-(** Alias to {!float_of_string}
+(** Alias to {!float_of_string}.
-    @raise Failure in case of failure
+    @raise Failure in case of failure.
     @since 1.2 *)
 
-val of_string : string -> t
+val of_string_opt : string -> t option
-(** Alias to {!float_of_string}.
+(** @since 3.0 *)
-    @deprecated since 1.2, use {!of_string_exn} instead
-    @raise Failure in case of failure *)
 
 val equal_precision : epsilon:t -> t -> t -> bool
-(** Equality with allowed error up to a non negative epsilon value *)
+(** Equality with allowed error up to a non negative epsilon value. *)
 
 val classify : t -> fpclass
+(** [classify x] returns the class of the given floating-point number [x]:
+    normal, subnormal, zero, infinite or nan (not a number). *)
 
 (** {2 Infix Operators}
 
     @since 0.17 *)
+
 module Infix : sig
-  val (=) : t -> t -> bool
+  val ( = ) : t -> t -> bool
   (** @since 0.17 *)
 
-  val (<>) : t -> t -> bool
+  val ( <> ) : t -> t -> bool
   (** @since 0.17 *)
 
-  val (<) : t -> t -> bool
+  val ( < ) : t -> t -> bool
   (** @since 0.17 *)
 
-  val (>) : t -> t -> bool
+  val ( > ) : t -> t -> bool
   (** @since 0.17 *)
 
-  val (<=) : t -> t -> bool
+  val ( <= ) : t -> t -> bool
   (** @since 0.17 *)
 
-  val (>=) : t -> t -> bool
+  val ( >= ) : t -> t -> bool
   (** @since 0.17 *)
+
+  val ( + ) : t -> t -> t
+  (** Addition.
+      @since 2.1 *)
+
+  val ( - ) : t -> t -> t
+  (** Subtraction.
+      @since 2.1 *)
+
+  val ( ~- ) : t -> t
+  (** Unary negation.
+      @since 2.1 *)
+
+  val ( * ) : t -> t -> t
+  (** Multiplication.
+      @since 2.1 *)
+
+  val ( / ) : t -> t -> t
+  (** Division.
+      @since 2.1 *)
 end
 
 include module type of Infix

src/core/CCFormat.ml

@@ -1,126 +1,113 @@
-
 (* This file is free software, part of containers. See file "license" for more details. *)
 
 (** {1 Helpers for Format} *)
 
-type 'a sequence = ('a -> unit) -> unit
+type 'a iter = ('a -> unit) -> unit
+
+include Format
 
 type t = Format.formatter
-type 'a printer = t -> 'a -> unit
+type -'a printer = t -> 'a -> unit
 
 (** {2 Combinators} *)
 
 let silent _fmt _ = ()
-
 let return fmt_str out () = Format.fprintf out "%(%)" fmt_str
-
-(*$inject
-  let to_string_test s = CCFormat.sprintf_no_color "@[<h>%a@]%!" s ()
-*)
-
-(*$= & ~printer:(fun s->CCFormat.sprintf "%S" s)
-  "a b" (to_string_test (return "a@ b"))
-  ", " (to_string_test (return ",@ "))
-  "and then" (to_string_test (return "@{<Red>and then@}@,"))
-  "a b" (to_string_test (return "@[<h>a@ b@]"))
-*)
-
 let unit fmt () = Format.pp_print_string fmt "()"
 let int fmt i = Format.pp_print_string fmt (string_of_int i)
 let string = Format.pp_print_string
 let bool = Format.pp_print_bool
 let float3 fmt f = Format.fprintf fmt "%.3f" f
 let float fmt f = Format.pp_print_string fmt (string_of_float f)
-
 let char = Format.pp_print_char
 let int32 fmt n = Format.fprintf fmt "%ld" n
 let int64 fmt n = Format.fprintf fmt "%Ld" n
 let nativeint fmt n = Format.fprintf fmt "%nd" n
 let string_quoted fmt s = Format.fprintf fmt "\"%s\"" s
 let flush = Format.pp_print_flush
-
+let space = Format.pp_print_space
+let cut = Format.pp_print_cut
+let break fmt (m, n) = Format.pp_print_break fmt m n
 let newline = Format.pp_force_newline
+let substring out (s, i, len) : unit = string out (String.sub s i len)
+let text = Format.pp_print_text
 
-let substring out (s,i,len): unit =
+let string_lines out (s : string) : unit =
-  string out (String.sub s i len)
+  fprintf out "@[<v>";
-
-let text out (s:string): unit =
-  let len = String.length s in
   let i = ref 0 in
-  let search_ c =
+  let n = String.length s in
-    try Some (String.index_from s !i c) with Not_found -> None
+  while !i < n do
-  in
+    let j = try String.index_from s !i '\n' with Not_found -> n in
-  while !i < len do
+    if !i > 0 then fprintf out "@,";
-    let j_newline = search_ '\n' in
+    substring out (s, !i, j - !i);
-    let j_space = search_ ' ' in
+    i := j + 1
-    let on_newline j =
+  done;
-      substring out (s, !i, j - !i);
+  fprintf out "@]"
-      newline out ();
-      i := j + 1
-    and on_space j =
-      substring out (s, !i, j - !i);
-      Format.pp_print_space out ();
-      i := j + 1
-    in
-    begin match j_newline, j_space with
-      | None, None ->
-        (* done *)
-        substring out (s, !i, len - !i);
-        i := len
-      | Some j, None -> on_newline j
-      | None, Some j -> on_space j
-      | Some j1, Some j2 ->
-        if j1<j2 then on_newline j1 else on_space j2
-    end
-  done
 
-(*$= & ~printer:(fun s->CCFormat.sprintf "%S" s)
+let list ?(sep = return ",@ ") pp fmt l =
-  "a\nb\nc" (sprintf_no_color "@[<v>%a@]%!" text "a b c")
+  let rec pp_list l =
-  "a b\nc" (sprintf_no_color "@[<h>%a@]%!" text "a b\nc")
+    match l with
-*)
+    | x :: (_ :: _ as l) ->
-
-let list ?(sep=return ",@ ") pp fmt l =
-  let rec pp_list l = match l with
-    | x::((_::_) as l) ->
       pp fmt x;
       sep fmt ();
       pp_list l
-    | x::[] -> pp fmt x
+    | [ x ] -> pp fmt x
     | [] -> ()
   in
   pp_list l
 
-let array ?(sep=return ",@ ") pp fmt a =
+let array ?(sep = return ",@ ") pp fmt a =
   for i = 0 to Array.length a - 1 do
     if i > 0 then sep fmt ();
     pp fmt a.(i)
   done
 
-let arrayi ?(sep=return ",@ ") pp fmt a =
+let arrayi ?(sep = return ",@ ") pp fmt a =
   for i = 0 to Array.length a - 1 do
     if i > 0 then sep fmt ();
     pp fmt (i, a.(i))
   done
 
-let seq ?(sep=return ",@ ") pp fmt seq =
+let seq ?(sep = return ",@ ") pp fmt seq =
   let first = ref true in
-  seq
+  CCSeq.iter
     (fun x ->
-       if !first then first := false else sep fmt ();
+      if !first then
-       pp fmt x)
+        first := false
+      else
+        sep fmt ();
+      pp fmt x)
+    seq
 
-let opt pp fmt x = match x with
+let iter ?(sep = return ",@ ") pp fmt seq =
+  let first = ref true in
+  seq (fun x ->
+      if !first then
+        first := false
+      else
+        sep fmt ();
+      pp fmt x)
+
+let opt pp fmt x =
+  match x with
   | None -> Format.pp_print_string fmt "none"
   | Some x -> Format.fprintf fmt "some %a" pp x
 
-let pair ?(sep=return ",@ ") ppa ppb fmt (a, b) =
+let pair ?(sep = return ",@ ") ppa ppb fmt (a, b) =
   Format.fprintf fmt "%a%a%a" ppa a sep () ppb b
 
-let triple ?(sep=return ",@ ") ppa ppb ppc fmt (a, b, c) =
+let triple ?(sep = return ",@ ") ppa ppb ppc fmt (a, b, c) =
   Format.fprintf fmt "%a%a%a%a%a" ppa a sep () ppb b sep () ppc c
 
-let quad ?(sep=return ",@ ") ppa ppb ppc ppd fmt (a, b, c, d) =
+let quad ?(sep = return ",@ ") ppa ppb ppc ppd fmt (a, b, c, d) =
-  Format.fprintf fmt "%a%a%a%a%a%a%a" ppa a sep () ppb b sep () ppc c sep () ppd d
+  Format.fprintf fmt "%a%a%a%a%a%a%a" ppa a sep () ppb b sep () ppc c sep () ppd
+    d
+
+let append ppa ppb fmt () =
+  ppa fmt ();
+  ppb fmt ()
+
+let append_l ppl fmt () = List.iter (fun pp -> pp fmt ()) ppl
 
 let within a b p out x =
   string out a;
@@ -131,17 +118,17 @@ let map f pp fmt x =
   pp fmt (f x);
   ()
 
-let vbox ?(i=0) pp out x =
+let vbox ?(i = 0) pp out x =
   Format.pp_open_vbox out i;
   pp out x;
   Format.pp_close_box out ()
 
-let hovbox ?(i=0) pp out x =
+let hovbox ?(i = 0) pp out x =
   Format.pp_open_hovbox out i;
   pp out x;
   Format.pp_close_box out ()
 
-let hvbox ?(i=0) pp out x =
+let hvbox ?(i = 0) pp out x =
   Format.pp_open_hvbox out i;
   pp out x;
   Format.pp_close_box out ()
@@ -152,13 +139,23 @@ let hbox pp out x =
   Format.pp_close_box out ()
 
 let of_to_string f out x = Format.pp_print_string out (f x)
-
+let exn = of_to_string Printexc.to_string
 let const pp x out () = pp out x
 
 let some pp out = function
   | None -> ()
   | Some x -> pp out x
 
+let const_string s out _ = string out s
+let opaque out _ = string out "opaque"
+let lazy_force pp out (lazy x) = pp out x
+
+let lazy_or ?(default = return "<lazy>") pp out x =
+  if Lazy.is_val x then
+    pp out (Lazy.force x)
+  else
+    default out ()
+
 (** {2 IO} *)
 
 let output fmt pp x = pp fmt x
@@ -171,10 +168,8 @@ let to_string pp x =
   Buffer.contents buf
 
 let fprintf = Format.fprintf
-
 let stdout = Format.std_formatter
 let stderr = Format.err_formatter
-
 let of_chan = Format.formatter_of_out_channel
 
 let with_out_chan oc f =
@@ -192,134 +187,184 @@ let tee a b =
   let fb = Format.pp_get_formatter_out_functions b () in
   Format.make_formatter
     (fun str i len ->
-       fa.Format.out_string str i len;
+      fa.Format.out_string str i len;
-       fb.Format.out_string str i len)
+      fb.Format.out_string str i len)
-    (fun () -> fa.Format.out_flush (); fb.Format.out_flush ())
+    (fun () ->
-
+      fa.Format.out_flush ();
-(*$R
+      fb.Format.out_flush ())
-  let buf1 = Buffer.create 42 in
-  let buf2 = Buffer.create 42 in
-  let f1 = Format.formatter_of_buffer buf1 in
-  let f2 = Format.formatter_of_buffer buf2 in
-  let fmt = tee f1 f2 in
-  Format.fprintf fmt "coucou@.";
-  assert_equal ~printer:CCFun.id "coucou\n" (Buffer.contents buf1);
-  assert_equal ~printer:CCFun.id "coucou\n" (Buffer.contents buf2);
-*)
 
 let to_file filename format =
   let oc = open_out filename in
   let fmt = Format.formatter_of_out_channel oc in
   Format.kfprintf
-    (fun fmt -> Format.pp_print_flush fmt (); close_out_noerr oc)
+    (fun fmt ->
+      Format.pp_print_flush fmt ();
+      close_out_noerr oc)
     fmt format
 
-type color =
+module ANSI_codes = struct
-  [ `Black
+  type color =
-  | `Red
+    [ `Black
-  | `Yellow
+    | `Red
-  | `Green
+    | `Yellow
-  | `Blue
+    | `Green
-  | `Magenta
+    | `Blue
-  | `Cyan
+    | `Magenta
-  | `White
+    | `Cyan
-  ]
+    | `White
+    ]
 
-let int_of_color_ = function
+  let int_of_color_ = function
-  | `Black -> 0
+    | `Black -> 0
-  | `Red -> 1
+    | `Red -> 1
-  | `Green -> 2
+    | `Green -> 2
-  | `Yellow -> 3
+    | `Yellow -> 3
-  | `Blue -> 4
+    | `Blue -> 4
-  | `Magenta -> 5
+    | `Magenta -> 5
-  | `Cyan -> 6
+    | `Cyan -> 6
-  | `White -> 7
+    | `White -> 7
 
-type style =
+  type style =
-  [ `FG of color (* foreground *)
+    [ `FG of color (* foreground *)
-  | `BG of color (* background *)
+    | `BG of color (* background *)
-  | `Bold
+    | `Bold
-  | `Reset
+    | `Reset
-  ]
+    ]
 
-let code_of_style : style -> int = function
+  let code_of_style : style -> int = function
-  | `FG c -> 30 + int_of_color_ c
+    | `FG c -> 30 + int_of_color_ c
-  | `BG c -> 40 + int_of_color_ c
+    | `BG c -> 40 + int_of_color_ c
-  | `Bold -> 1
+    | `Bold -> 1
-  | `Reset -> 0
+    | `Reset -> 0
 
-let ansi_l_to_str_ = function
+  let string_of_style a = Printf.sprintf "\x1b[%dm" (code_of_style a)
-  | [] -> "\x1b[0m"
+  let clear_line = "\x1b[2K\r"
-  | [a] -> Printf.sprintf "\x1b[%dm" (code_of_style a)
+  let reset = string_of_style `Reset
-  | [a;b] -> Printf.sprintf "\x1b[%d;%dm" (code_of_style a) (code_of_style b)
-  | l ->
-    let buf = Buffer.create 16 in
-    let pp_num c = Buffer.add_string buf (string_of_int (code_of_style c)) in
-    Buffer.add_string buf "\x1b[";
-    List.iteri
-      (fun i c ->
-         if i>0 then Buffer.add_char buf ';';
-         pp_num c)
-      l;
-    Buffer.add_string buf "m";
-    Buffer.contents buf
 
-(* parse a tag *)
+  let string_of_style_list = function
-let style_of_tag_ s = match String.trim s with
+    | [] -> reset
-  | "reset" -> [`Reset]
+    | [ a ] -> string_of_style a
-  | "black" -> [`FG `Black]
+    | [ a; b ] ->
-  | "red" -> [`FG `Red]
+      Printf.sprintf "\x1b[%d;%dm" (code_of_style a) (code_of_style b)
-  | "green" -> [`FG `Green]
+    | [ a; b; c ] ->
-  | "yellow" -> [`FG `Yellow]
+      Printf.sprintf "\x1b[%d;%d;%dm" (code_of_style a) (code_of_style b)
-  | "blue" -> [`FG `Blue]
+        (code_of_style c)
-  | "magenta" -> [`FG `Magenta]
+    | l ->
-  | "cyan" -> [`FG `Cyan]
+      let buf = Buffer.create 32 in
-  | "white" -> [`FG `White]
+      let pp_num c = Buffer.add_string buf (string_of_int (code_of_style c)) in
-  | "bold" -> [`Bold]
+      Buffer.add_string buf "\x1b[";
-  | "Black" -> [`FG `Black; `Bold]
+      List.iteri
-  | "Red" -> [`FG `Red; `Bold]
+        (fun i c ->
-  | "Green" -> [`FG `Green; `Bold]
+          if i > 0 then Buffer.add_char buf ';';
-  | "Yellow" -> [`FG `Yellow; `Bold]
+          pp_num c)
-  | "Blue" -> [`FG `Blue; `Bold]
+        l;
-  | "Magenta" -> [`FG `Magenta; `Bold]
+      Buffer.add_string buf "m";
-  | "Cyan" -> [`FG `Cyan; `Bold]
+      Buffer.contents buf
-  | "White" -> [`FG `White; `Bold]
+
-  | s -> failwith ("unknown style: " ^ s)
+  exception No_such_style
+
+  (* parse a string tag. *)
+  let style_of_tag_ s =
+    match String.trim s with
+    | "reset" -> [ `Reset ]
+    | "black" -> [ `FG `Black ]
+    | "red" -> [ `FG `Red ]
+    | "green" -> [ `FG `Green ]
+    | "yellow" -> [ `FG `Yellow ]
+    | "blue" -> [ `FG `Blue ]
+    | "magenta" -> [ `FG `Magenta ]
+    | "cyan" -> [ `FG `Cyan ]
+    | "white" -> [ `FG `White ]
+    | "bold" -> [ `Bold ]
+    | "Black" -> [ `FG `Black; `Bold ]
+    | "Red" -> [ `FG `Red; `Bold ]
+    | "Green" -> [ `FG `Green; `Bold ]
+    | "Yellow" -> [ `FG `Yellow; `Bold ]
+    | "Blue" -> [ `FG `Blue; `Bold ]
+    | "Magenta" -> [ `FG `Magenta; `Bold ]
+    | "Cyan" -> [ `FG `Cyan; `Bold ]
+    | "White" -> [ `FG `White; `Bold ]
+    | _ -> raise No_such_style
+end
 
 let color_enabled = ref false
 
-(* either prints the tag of [s] or delegate to [or_else] *)
+let mark_open_style st style =
-let mark_open_tag st ~or_else s =
+  Stack.push style st;
-  try
+  if !color_enabled then
-    let style = style_of_tag_ s in
+    ANSI_codes.string_of_style_list style
-    Stack.push style st;
+  else
-    if !color_enabled then ansi_l_to_str_ style else ""
+    ""
-  with Not_found -> or_else s
 
-let mark_close_tag st ~or_else s =
+let mark_close_style st : string =
+  let style =
+    try
+      ignore (Stack.pop st);
+      (* pop current style (if well-scoped …) *)
+      Stack.top st
+      (* look at previous style *)
+    with Stack.Empty -> [ `Reset ]
+  in
+  if !color_enabled then
+    ANSI_codes.string_of_style_list style
+  else
+    ""
+
+type stag += Style of ANSI_codes.style list
+
+let pp_open_tag out s = pp_open_stag out (String_tag s)
+let pp_close_tag out () = pp_close_stag out ()
+
+(* either prints the tag of [s] or delegate to [or_else] *)
+let mark_open_stag st ~or_else (tag : stag) : string =
+  match tag with
+  | Style style -> mark_open_style st style
+  | String_tag s ->
+    let open ANSI_codes in
+    (try
+       let style = style_of_tag_ s in
+       mark_open_style st style
+     with No_such_style -> or_else tag)
+  | _ -> or_else tag
+
+let mark_close_stag st ~or_else (tag : stag) : string =
+  match tag with
+  | Style _ -> mark_close_style st
+  | String_tag s ->
+    let open ANSI_codes in
+    (* check if it's indeed about color *)
+    (match style_of_tag_ s with
+    | _ -> mark_close_style st
+    | exception No_such_style -> or_else tag)
+  | _ -> or_else tag
+
+let with_styling stl out f =
+  pp_open_stag out (Style stl);
   try
-    let _ = style_of_tag_ s in (* check if it's indeed about color *)
+    let x = f () in
-    let style =
+    pp_close_stag out ();
-      try
+    x
-        ignore (Stack.pop st); (* pop current style (if well-scoped...) *)
+  with e ->
-        Stack.top st (* look at previous style *)
+    pp_close_stag out ();
-      with Stack.Empty ->
+    raise e
-        [`Reset]
+
-    in
+let styling stl pp out x = with_styling stl out @@ fun () -> pp out x
-    if !color_enabled then ansi_l_to_str_ style else ""
-  with Not_found -> or_else s
 
 (* add color handling to formatter [ppf] *)
 let set_color_tag_handling ppf =
-  let open Format in
+  let st = Stack.create () in
-  let functions = pp_get_formatter_tag_functions ppf () in
+  (* stack of styles *)
-  let st = Stack.create () in (* stack of styles *)
+  pp_set_mark_tags ppf true;
-  let functions' = {functions with
+  (* enable tags *)
-                      mark_open_tag=(mark_open_tag st ~or_else:functions.mark_open_tag);
+  let funs = pp_get_formatter_stag_functions ppf () in
-                      mark_close_tag=(mark_close_tag st ~or_else:functions.mark_close_tag);
+  let funs' =
-                   } in
+    {
-  pp_set_mark_tags ppf true; (* enable tags *)
+      funs with
-  pp_set_formatter_tag_functions ppf functions'
+      mark_open_stag = mark_open_stag st ~or_else:funs.mark_open_stag;
+      mark_close_stag = mark_close_stag st ~or_else:funs.mark_close_stag;
+    }
+  in
+  pp_set_formatter_stag_functions ppf funs'
 
 let set_color_default =
   let first = ref true in
@@ -329,30 +374,19 @@ let set_color_default =
       if !first then (
         first := false;
         set_color_tag_handling stdout;
-        set_color_tag_handling stderr;
+        set_color_tag_handling stderr
-      );
+      )
-    ) else if not b && !color_enabled then color_enabled := false
+    ) else if (not b) && !color_enabled then
-
+      color_enabled := false
-(*$R
-  set_color_default true;
-  let s = sprintf
-    "what is your @{<White>favorite color@}? @{<blue>blue@}! No, @{<red>red@}! Ahhhhhhh@."
-  in
-  assert_equal ~printer:CCFun.id
-    "what is your \027[37;1mfavorite color\027[0m? \027[34mblue\027[0m! No, \027[31mred\027[0m! Ahhhhhhh\n"
-    s
-*)
 
 let with_color s pp out x =
-  Format.pp_open_tag out s;
+  pp_open_tag out s;
   pp out x;
-  Format.pp_close_tag out ()
+  pp_close_tag out ()
 
 let with_colorf s out fmt =
-  Format.pp_open_tag out s;
+  pp_open_tag out s;
-  Format.kfprintf
+  Format.kfprintf (fun out -> pp_close_tag out ()) out fmt
-    (fun out -> Format.pp_close_tag out ())
-    out fmt
 
 (* c: whether colors are enabled *)
 let sprintf_ c format =
@@ -360,58 +394,50 @@ let sprintf_ c format =
   let fmt = Format.formatter_of_buffer buf in
   if c && !color_enabled then set_color_tag_handling fmt;
   Format.kfprintf
-    (fun _fmt -> Format.pp_print_flush fmt (); Buffer.contents buf)
+    (fun _fmt ->
-    fmt
+      Format.pp_print_flush fmt ();
-    format
+      Buffer.contents buf)
+    fmt format
 
 let with_color_ksf ~f s fmt =
   let buf = Buffer.create 64 in
   let out = Format.formatter_of_buffer buf in
   if !color_enabled then set_color_tag_handling out;
-  Format.pp_open_tag out s;
+  pp_open_tag out s;
   Format.kfprintf
     (fun out ->
-       Format.pp_close_tag out ();
+      pp_close_tag out ();
-       Format.pp_print_flush out ();
+      Format.pp_print_flush out ();
-       f (Buffer.contents buf))
+      f (Buffer.contents buf))
     out fmt
 
-let with_color_sf s fmt = with_color_ksf ~f:(fun s->s) s fmt
+let with_color_sf s fmt = with_color_ksf ~f:(fun s -> s) s fmt
-
 let sprintf fmt = sprintf_ true fmt
 let sprintf_no_color fmt = sprintf_ false fmt
 let sprintf_dyn_color ~colors fmt = sprintf_ colors fmt
 
 let fprintf_dyn_color ~colors out fmt =
   let old_tags = Format.pp_get_mark_tags out () in
-  Format.pp_set_mark_tags out colors; (* enable/disable tags *)
+  Format.pp_set_mark_tags out colors;
-  Format.kfprintf
+  (* enable/disable tags *)
-    (fun out -> Format.pp_set_mark_tags out old_tags)
+  Format.kfprintf (fun out -> Format.pp_set_mark_tags out old_tags) out fmt
-    out fmt
 
-(*$T
+let ksprintf ?margin ~f fmt =
-  sprintf "yolo %s %d" "a b" 42 = "yolo a b 42"
-  sprintf "%d " 0 = "0 "
-  sprintf_no_color "%d " 0 = "0 "
-*)
-
-(*$R
-  set_color_default true;
-  assert_equal "\027[31myolo\027[0m" (sprintf "@{<red>yolo@}");
-  assert_equal "yolo" (sprintf_no_color "@{<red>yolo@}");
-*)
-
-let ksprintf ~f fmt =
   let buf = Buffer.create 32 in
   let out = Format.formatter_of_buffer buf in
   if !color_enabled then set_color_tag_handling out;
+  (match margin with
+  | None -> ()
+  | Some m -> pp_set_margin out m);
   Format.kfprintf
-    (fun _ -> Format.pp_print_flush out (); f (Buffer.contents buf))
+    (fun _ ->
+      Format.pp_print_flush out ();
+      f (Buffer.contents buf))
     out fmt
 
-
 module Dump = struct
   type 'a t = 'a printer
+
   let unit = unit
   let int = int
   let string = string_quoted
@@ -423,23 +449,26 @@ module Dump = struct
   let nativeint = nativeint
   let list pp = within "[" "]" (hovbox (list ~sep:(return ";@,") pp))
   let array pp = within "[|" "|]" (hovbox (array ~sep:(return ";@,") pp))
-  let option pp out x = match x with
+
+  let option pp out x =
+    match x with
     | None -> Format.pp_print_string out "None"
     | Some x -> Format.fprintf out "Some %a" pp x
+
   let pair p1 p2 = within "(" ")" (hovbox (pair p1 p2))
   let triple p1 p2 p3 = within "(" ")" (hovbox (triple p1 p2 p3))
   let quad p1 p2 p3 p4 = within "(" ")" (hovbox (quad p1 p2 p3 p4))
+
   let result' pok perror out = function
-    | Result.Ok x -> Format.fprintf out "(@[Ok %a@])" pok x
+    | Ok x -> Format.fprintf out "(@[Ok %a@])" pok x
-    | Result.Error e -> Format.fprintf out "(@[Error %a@])" perror e
+    | Error e -> Format.fprintf out "(@[Error %a@])" perror e
+
   let result pok = result' pok string
   let to_string = to_string
 end
 
-(*$= & ~printer:(fun s->s)
+module Infix = struct
-  "[1;2;3]" (to_string Dump.(list int) [1;2;3])
+  let ( ++ ) = append
-  "Some 1" (to_string Dump.(option int) (Some 1))
+end
-  "[None;Some \"a b\"]" (to_string Dump.(list (option string)) [None; Some "a b"])
+
-  "[(Ok \"a b c\");(Error \"nope\")]" \
+include Infix
-    (to_string Dump.(list (result string)) [Result.Ok "a b c"; Result.Error "nope"])
-*)

src/core/CCFormat.mli

@@ -1,21 +1,30 @@
-
 (* This file is free software, part of containers. See file "license" for more details. *)
 
-(** {1 Helpers for Format}
+(** Helpers for Format
 
     @since 0.8 *)
 
-type 'a sequence = ('a -> unit) -> unit
+type 'a iter = ('a -> unit) -> unit
+
+(* include Format, and alias all its types.
+   see https://discuss.ocaml.org/t/extend-existing-module/1389/4
+*)
+
+(** @inline *)
+include module type of struct
+  include Format
+end
 
 type t = Format.formatter
-type 'a printer = t -> 'a -> unit
+type -'a printer = t -> 'a -> unit
 
 (** {2 Combinators} *)
 
-val silent : 'a printer (** Prints nothing *)
+val silent : 'a printer
+(** Prints nothing. *)
 
 val unit : unit printer
-(** Prints "()" *)
+(** Prints "()". *)
 
 val int : int printer
 val string : string printer
@@ -23,12 +32,28 @@ val bool : bool printer
 val float3 : float printer (* 3 digits after . *)
 val float : float printer
 
+val exn : exn printer
+(** Printer using {!Printexc.to_string}.
+    @since 3.0 *)
+
+val space : unit printer
+(** Alias to {!pp_print_space}.
+    @since 3.2 *)
+
+val cut : unit printer
+(** Alias to {!pp_print_cut}.
+    @since 3.2 *)
+
+val break : (int * int) printer
+(** Tuple-ized {!printer} form of {!pp_print_break}.
+    @since 3.2 *)
+
 val newline : unit printer
-(** Force newline (see {!Format.pp_force_newline})
+(** Force newline (see {!Format.pp_force_newline}).
     @since 1.2 *)
 
 val substring : (string * int * int) printer
-(** Print the substring [(s,i,len)], where [i] is the offset
+(** [substring (s,i,len)] prints the substring [(s,i,len)], where [i] is the offset
     in [s] and [len] the number of bytes in the substring.
     @raise Invalid_argument if the triple [(s,i,len)] does not
     describe a proper substring.
@@ -40,10 +65,25 @@ val text : string printer
     See [pp_print_text] on recent versions of OCaml.
     @since 1.2 *)
 
-val char : char printer (** @since 0.14 *)
+val string_lines : string printer
-val int32 : int32 printer (** @since 0.14 *)
+(** [string_lines out s] prints [s] with all newlines (['\n']) replaced by
-val int64 : int64 printer (** @since 0.14 *)
+    a cut, in a vertical box. It does {b NOT} insert breakable spaces in
-val nativeint : nativeint printer (** @since 0.14 *)
+    place of spaces, unlike {!text}.
+    This means an already formatted string can be displayed inside another
+    formatter without mangling the indentation.
+    @since 3.3 *)
+
+val char : char printer
+(** @since 0.14 *)
+
+val int32 : int32 printer
+(** @since 0.14 *)
+
+val int64 : int64 printer
+(** @since 0.14 *)
+
+val nativeint : nativeint printer
+(** @since 0.14 *)
 
 val flush : unit printer
 (** Alias to {!Format.pp_print_flush}.
@@ -56,20 +96,41 @@ val string_quoted : string printer
 val list : ?sep:unit printer -> 'a printer -> 'a list printer
 val array : ?sep:unit printer -> 'a printer -> 'a array printer
 val arrayi : ?sep:unit printer -> (int * 'a) printer -> 'a array printer
-val seq : ?sep:unit printer -> 'a printer -> 'a sequence printer
+val seq : ?sep:unit printer -> 'a printer -> 'a Seq.t printer
+val iter : ?sep:unit printer -> 'a printer -> 'a iter printer
 
 val opt : 'a printer -> 'a option printer
 (** [opt pp] prints options as follows:
-    [Some x] will become "some foo" if [pp x ---> "foo"]
+    - [Some x] will become "some foo" if [pp x ---> "foo"].
-    [None] will become "none" *)
+    - [None] will become "none". *)
 
-(** In the tuple printers, the [sep] argument is only available
+(** In the tuple printers, the [sep] argument is only available.
     @since 0.17 *)
 
 val pair : ?sep:unit printer -> 'a printer -> 'b printer -> ('a * 'b) printer
-val triple : ?sep:unit printer -> 'a printer -> 'b printer -> 'c printer -> ('a * 'b * 'c) printer
+
-val quad : ?sep:unit printer -> 'a printer -> 'b printer ->
+val triple :
-  'c printer -> 'd printer -> ('a * 'b * 'c * 'd) printer
+  ?sep:unit printer ->
+  'a printer ->
+  'b printer ->
+  'c printer ->
+  ('a * 'b * 'c) printer
+
+val quad :
+  ?sep:unit printer ->
+  'a printer ->
+  'b printer ->
+  'c printer ->
+  'd printer ->
+  ('a * 'b * 'c * 'd) printer
+
+val append : unit printer -> unit printer -> unit printer
+(** [append ppa ppb] first prints [ppa ()], then prints [ppb ()].
+    @since 3.2 *)
+
+val append_l : unit printer list -> unit printer
+(** [append_l pps] runs the printers in [pps] sequentially.
+    @since 3.2 *)
 
 val within : string -> string -> 'a printer -> 'a printer
 (** [within a b p] wraps [p] inside the strings [a] and [b]. Convenient,
@@ -79,22 +140,22 @@ val within : string -> string -> 'a printer -> 'a printer
 val map : ('a -> 'b) -> 'b printer -> 'a printer
 
 val vbox : ?i:int -> 'a printer -> 'a printer
-(** Wrap the printer in a vertical box
+(** Wrap the printer in a vertical box.
-    @param i level of indentation within the box (default 0)
+    @param i level of indentation within the box (default 0).
     @since 0.16 *)
 
 val hvbox : ?i:int -> 'a printer -> 'a printer
-(** Wrap the printer in a horizontal/vertical box
+(** Wrap the printer in a horizontal/vertical box.
-    @param i level of indentation within the box (default 0)
+    @param i level of indentation within the box (default 0).
     @since 0.16 *)
 
 val hovbox : ?i:int -> 'a printer -> 'a printer
-(** Wrap the printer in a horizontal or vertical box
+(** Wrap the printer in a horizontal or vertical box.
-    @param i level of indentation within the box (default 0)
+    @param i level of indentation within the box (default 0).
     @since 0.16 *)
 
 val hbox : 'a printer -> 'a printer
-(** Wrap the printer in an horizontal box
+(** Wrap the printer in an horizontal box.
     @since 0.16 *)
 
 val return : ('a, _, _, 'a) format4 -> unit printer
@@ -110,11 +171,11 @@ val return : ('a, _, _, 'a) format4 -> unit printer
 
 val of_to_string : ('a -> string) -> 'a printer
 (** [of_to_string f] converts its input to a string using [f],
-    then prints the string
+    then prints the string.
     @since 1.0 *)
 
 val const : 'a printer -> 'a -> unit printer
-(** [const pp x] is a unit printer that uses [pp] on [x]
+(** [const pp x] is a unit printer that uses [pp] on [x].
     @since 1.0 *)
 
 val some : 'a printer -> 'a option printer
@@ -124,6 +185,25 @@ val some : 'a printer -> 'a option printer
     @since 1.0
 *)
 
+val const_string : string -> 'a printer
+(** [const_string s] is a printer that ignores its input and
+    always prints [s].
+    @since 3.5 *)
+
+val opaque : 'a printer
+(** [opaque] is [const_string "opaque"].
+    The exact string used is not stable.
+    @since 3.5 *)
+
+val lazy_force : 'a printer -> 'a lazy_t printer
+(** [lazy_force pp out x] forces [x] and prints the result with [pp].
+    @since 2.0 *)
+
+val lazy_or : ?default:unit printer -> 'a printer -> 'a lazy_t printer
+(** [lazy_or ?default pp out x] prints [default] if [x] is not
+    evaluated yet, or uses [pp] otherwise.
+    @since 2.0 *)
+
 (** {2 ANSI codes}
 
     Use ANSI escape codes https://en.wikipedia.org/wiki/ANSI_escape_code
@@ -166,7 +246,7 @@ val some : 'a printer -> 'a option printer
     @since 0.15 *)
 
 val set_color_tag_handling : t -> unit
-(** adds functions to support color tags to the given formatter.
+(** Add functions to support color tags to the given formatter.
     @since 0.15 *)
 
 val set_color_default : bool -> unit
@@ -177,28 +257,34 @@ val set_color_default : bool -> unit
 val with_color : string -> 'a printer -> 'a printer
 (** [with_color "Blue" pp] behaves like the printer [pp], but with the given
     style.
+
     {b status: unstable}
     @since 0.16 *)
 
 val with_colorf : string -> t -> ('a, t, unit, unit) format4 -> 'a
 (** [with_colorf "Blue" out "%s %d" "yolo" 42] will behave like {!Format.fprintf},
-    but wrapping the content with the given style
+    but wrapping the content with the given style.
+
     {b status: unstable}
     @since 0.16 *)
 
 val with_color_sf : string -> ('a, t, unit, string) format4 -> 'a
 (** [with_color_sf "Blue" out "%s %d" "yolo" 42] will behave like
-    {!sprintf}, but wrapping the content with the given style
+    {!sprintf}, but wrapping the content with the given style.
+
     Example:
     {[
       CCFormat.with_color_sf "red" "%a" CCFormat.Dump.(list int) [1;2;3] |> print_endline;;
     ]}
+
     {b status: unstable}
     @since 0.21 *)
 
-val with_color_ksf : f:(string -> 'b) -> string -> ('a, t, unit, 'b) format4 -> 'a
+val with_color_ksf :
+  f:(string -> 'b) -> string -> ('a, t, unit, 'b) format4 -> 'a
 (** [with_color_ksf "Blue" ~f "%s %d" "yolo" 42] will behave like
-    {!ksprintf}, but wrapping the content with the given style
+    {!ksprintf}, but wrapping the content with the given style.
+
     Example:
     the following with raise [Failure] with a colored message
     {[
@@ -206,13 +292,90 @@ val with_color_ksf : f:(string -> 'b) -> string -> ('a, t, unit, 'b) format4 ->
     ]}
     @since 1.2 *)
 
+(** ANSI escape codes. This contains lower level functions for them.
+    @since 3.5 *)
+module ANSI_codes : sig
+  type color =
+    [ `Black
+    | `Red
+    | `Yellow
+    | `Green
+    | `Blue
+    | `Magenta
+    | `Cyan
+    | `White
+    ]
+  (** An ANSI color *)
+
+  type style =
+    [ `FG of color  (** foreground *)
+    | `BG of color  (** background *)
+    | `Bold
+    | `Reset
+    ]
+  (** A style. Styles can be composed in a list. *)
+
+  val clear_line : string
+  (** [clear_line] is an escape code to clear the current line. It
+      is very useful for progress bars; for example:
+
+      {[
+        let pp_progress i =
+          Printf.printf "%sprogress at %d%!" ANSI_codes.clear_line i
+      ]}
+      if called repeatedly this will print successive progress messages
+      on a single line.
+  *)
+
+  val reset : string
+  (** The escape code to reset style (colors, bold, etc.) *)
+
+  val string_of_style : style -> string
+  (** [string_of_style st] is an escape code to set the current style
+      to [st]. It can be printed as is on any output that is a
+      compatible terminal. *)
+
+  val string_of_style_list : style list -> string
+  (** [string_of_style_list styles] is an escape code
+      for multiple styles at once.
+      For example [string_of_style_list ANSI_codes.([`FG `Red; `BG `Green; `Bold])]
+      is a very shiny style. *)
+end
+
+val styling : ANSI_codes.style list -> 'a printer -> 'a printer
+(** [styling st p] is the same printer as [p], except it locally sets
+    the style [st].
+
+    Example:
+    {[
+
+    open CCFormat;
+    set_color_default true;
+    sprintf
+      "what is your %a? %a! No, %a! Ahhhhhhh@."
+      (styling [`FG `White; `Bold] string) "favorite color"
+      (styling [`FG `Blue] string) "blue"
+      (styling [`FG `Red] string) "red"
+    ]}
+
+    Available only on OCaml >= 4.08.
+    @since 3.7 *)
+
+val with_styling : ANSI_codes.style list -> t -> (unit -> 'a) -> 'a
+(** [with_styling style fmt f] sets the given style on [fmt],
+    calls [f()], then restores the previous style.
+    It is useful in imperative-style printers (a sequence of "print a; print b; …").
+
+    Available only on OCaml >= 4.08.
+    @since 3.7 *)
+
 (** {2 IO} *)
 
 val output : t -> 'a printer -> 'a -> unit
 val to_string : 'a printer -> 'a -> string
 
 val of_chan : out_channel -> t
-(** Alias to {!Format.formatter_of_out_channel}
+(** Alias to {!Format.formatter_of_out_channel}.
     @since 1.2 *)
 
 val with_out_chan : out_channel -> (t -> 'a) -> 'a
@@ -230,14 +393,15 @@ val tee : t -> t -> t
 
 val sprintf : ('a, t, unit, string) format4 -> 'a
 (** Print into a string any format string that would usually be compatible
-    with {!fprintf}. Similar to {!Format.asprintf}. *)
+    with {!fprintf}. Like {!Format.asprintf}. *)
 
 val sprintf_no_color : ('a, t, unit, string) format4 -> 'a
-(** Similar to {!sprintf} but never prints colors
+(** Like {!sprintf} but never prints colors.
     @since 0.16 *)
 
 val sprintf_dyn_color : colors:bool -> ('a, t, unit, string) format4 -> 'a
-(** Similar to {!sprintf} but enable/disable colors depending on [colors].
+(** Like {!sprintf} but enable/disable colors depending on [colors].
+
     Example:
     {[
       (* with colors *)
@@ -250,29 +414,26 @@ val sprintf_dyn_color : colors:bool -> ('a, t, unit, string) format4 -> 'a
     ]}
     @since 0.21 *)
 
-val fprintf : t -> ('a, t, unit ) format -> 'a
+val fprintf : t -> ('a, t, unit) format -> 'a
-(** Alias to {!Format.fprintf}
+(** Alias to {!Format.fprintf}.
     @since 0.14 *)
 
-val fprintf_dyn_color : colors:bool -> t -> ('a, t, unit ) format -> 'a
+val fprintf_dyn_color : colors:bool -> t -> ('a, t, unit) format -> 'a
-(** Similar to {!fprintf} but enable/disable colors depending on [colors]
+(** Like {!fprintf} but enable/disable colors depending on [colors].
     @since 0.21 *)
 
 val ksprintf :
+  ?margin:int ->
   f:(string -> 'b) ->
   ('a, Format.formatter, unit, 'b) format4 ->
   'a
 (** [ksprintf fmt ~f] formats using [fmt], in a way similar to {!sprintf},
     and then calls [f] on the resulting string.
+    @param margin set margin (since 2.1)
     @since 0.14 *)
 
-(*$= & ~printer:CCFormat.(to_string (opt string))
-  (Some "hello world") \
-    (ksprintf "hello %a" CCFormat.string "world" ~f:(fun s -> Some s))
-*)
-
 val to_file : string -> ('a, t, unit, unit) format4 -> 'a
-(** Print to the given file *)
+(** Print to the given file. *)
 
 (** {2 Dump}
 
@@ -291,6 +452,7 @@ val to_file : string -> ('a, t, unit, unit) format4 -> 'a
 
 module Dump : sig
   type 'a t = 'a printer
+
   val unit : unit t
   val int : int t
   val string : string t
@@ -305,11 +467,18 @@ module Dump : sig
   val option : 'a t -> 'a option t
   val pair : 'a t -> 'b t -> ('a * 'b) t
   val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
-  val quad :
+  val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
-    'a t -> 'b t -> 'c t -> 'd t ->
+  val result : 'a t -> ('a, string) result t
-    ('a * 'b * 'c * 'd) t
+  val result' : 'a t -> 'e t -> ('a, 'e) result t
-  val result : 'a t -> ('a, string) Result.result t
+
-  val result' : 'a t -> 'e t -> ('a, 'e) Result.result t
   val to_string : 'a t -> 'a -> string
-  (** Alias to {!CCFormat.to_string} *)
+  (** Alias to {!CCFormat.to_string}. *)
 end
+
+module Infix : sig
+  val ( ++ ) : unit printer -> unit printer -> unit printer
+  (** Alias to {!append}.
+      @since 3.2 *)
+end
+
+include module type of Infix

src/core/CCFun.ml

@@ -1,43 +1,30 @@
-
 (* This file is free software, part of containers. See file "license" for more details. *)
 
 (** {1 Basic Functions} *)
 
-(* default implem for some operators *)
-
-let (|>) x f = f x
-let (@@) f x = f x
-
-let opaque_identity x = x
-
 (* import standard implementations, if any *)
 
 include Sys
-include Pervasives
+include Stdlib
+include Fun
 
-let compose f g x = g (f x)
+let[@inline] and_pred f g x = f x && g x
+let[@inline] or_pred f g x = f x || g x
+let[@inline] compose f g x = g (f x)
+let[@inline] compose_binop f g x y = g (f x) (f y)
+let[@inline] curry f x y = f (x, y)
+let[@inline] uncurry f (x, y) = f x y
 
-let compose_binop f g x y = g (f x) (f y)
+let[@inline] tap f x =
-
+  ignore (f x);
-let flip f x y = f y x
+  x
-
-let curry f x y = f (x,y)
-
-let id x = x
-
-let const x _ = x
-
-let uncurry f (x,y) = f x y
-
-let tap f x = ignore (f x); x
-
-let (%>) = compose
-
-let (%) f g x = f (g x)
 
 let lexicographic f1 f2 x y =
   let c = f1 x y in
-  if c <> 0 then c else f2 x y
+  if c <> 0 then
+    c
+  else
+    f2 x y
 
 let finally ~h ~f =
   try
@@ -66,9 +53,40 @@ let finally2 ~h f x y =
     ignore (h ());
     raise e
 
-module Monad(X : sig type t end) = struct
+let rec iterate n f x =
-  type 'a t = X.t -> 'a
+  if n < 0 then
-  let return x _ = x
+    invalid_arg "CCFun.iterate"
-  let (>|=) f g x = g (f x)
+  else if n = 0 then
-  let (>>=) f g x = g (f x) x
+    x
+  else
+    iterate (n - 1) f (f x)
+
+let[@inline] with_return (type ret) f : ret =
+  let exception E of ret in
+  let return x = raise_notrace (E x) in
+  match f return with
+  | res -> res
+  | exception E res -> res
+
+module Infix = struct
+  (* default implem for some operators *)
+  let ( %> ) = compose
+  let[@inline] ( % ) f g x = f (g x)
+  let ( let@ ) = ( @@ )
+  let ( ||> ) (a, b) f = f a b
+  let ( |||> ) (a, b, c) f = f a b c
 end
+
+include Infix
+
+module Monad (X : sig
+  type t
+end) =
+struct
+  type 'a t = X.t -> 'a
+
+  let[@inline] return x _ = x
+  let[@inline] ( >|= ) f g x = g (f x)
+  let[@inline] ( >>= ) f g x = g (f x) x
+end
+[@@inline]