feat: add CCAtomic.update_cas

Patch CBor round-trip QCheck test to hold for nan's too

.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,30 +0,0 @@
-S src/core
-S src/data/
-S src/io
-S src/iter/
-S src/advanced/
-S src/lwt/
-S src/sexp/
-S src/threads/
-S src/misc
-S src/string
-S src/bigarray
-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 bigarray
-PKG sequence
-PKG hamt
-PKG gen
-PKG qcheck
-FLG -w +a -w -4 -w -44

.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,34 +0,0 @@
-#use "topfind";;
-#thread
-#require "bigarray";;
-#require "unix";;
-#require "sequence";;
-#directory "_build/src/core";;
-#directory "_build/src/misc";;
-#directory "_build/src/pervasives/";;
-#directory "_build/src/string";;
-#directory "_build/src/io";;
-#directory "_build/src/unix";;
-#directory "_build/src/iter";;
-#directory "_build/src/data";;
-#directory "_build/src/advanced/";;
-#directory "_build/src/sexp";;
-#directory "_build/src/bigarray/";;
-#directory "_build/src/threads";;
-#directory "_build/src/top/";;
-#directory "_build/tests/";;
-#load "containers.cma";;
-#load "containers_iter.cma";;
-#load "containers_data.cma";;
-#load "containers_advanced.cma";;
-#load "containers_io.cma";;
-#load "containers_unix.cma";;
-#load "containers_sexp.cma";;
-#load "containers_string.cma";;
-#load "containers_pervasives.cma";;
-#load "containers_bigarray.cma";;
-#load "containers_top.cma";;
-#thread;;
-#load "containers_thread.cma";;
-(* vim:syntax=ocaml:
-*)

AUTHORS.adoc

@@ -1,16 +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
-- octachron (Florian Angeletti)
-- Johannes Kloos

CHANGELOG.adoc

@@ -1,564 +0,0 @@
-= Changelog
-
-== 0.19
-
-- add regression test for #75
-- Fix `CCString.Split.{left,right}` (#75)
-- additional functions in `CCMultiSet`
-- show ocaml array type concretely in `CCRingBuffer.Make` sig
-- cleanup and more tests in `CCHeap`
-- fix bugs in `CCFlatHashtbl`, add some tests
-- add more generic printers for `CCError` and `CCResult` (close #73)
-- add `CCstring.of_char`
-- update headers
-
-== 0.18
-
-- update implem of `CCVector.equal`
-- add `CCOpt.get_or` with label, deprecates `get`
-- add `CCArray.get_safe` (close #70)
-- add `CCGraph.is_dag`
-- add aliases to deprecated  functions from `String`, add `Fun.opaque_identity`
-- add `CCLazy_list.take`
-- add `Lazy_list.filter`
-- add `CCList.range_by`
-
-== 0.17
-
-=== potentially breaking
-
-- change the semantics of `CCString.find_all` (allow overlaps)
-
-=== Additions
-
-- add `CCString.pad` for more webscale
-- add `(--^)` to CCRAl, CCFQueue, CCKlist (closes #56); add `CCKList.Infix`
-- add monomorphic signatures in `CCInt` and `CCFloat`
-- add `CCList.{sorted_insert,is_sorted}`
-- add `CCLazy_list` in containers.iter (with a few functions)
-- add `CCTrie.longest_prefix`
-- provide additional ordering properties in `CCTrie.{above,below}`
-- add `CCOpt.if_`
-- have
-  * `CCRandom.split_list` fail on `len=0`
-  * `CCRandom.sample_without_replacement` fail if `n<=0`
-- add `CCOpt.{for_all, exists}`
-- add `CCRef.{get_then_incr,incr_then_get}`
-- add `Result.{to,of}_err`
-- add `CCFormat.within`
-- add `map/mapi` to some of the map types.
-- add `CCString.{drop,take,chop_prefix,chop_suffix,filter,filter_map}`
-- add `CCList.fold_filter_map`
-- add `CCIO.File.with_temp` for creating temporary files
-- add `{CCArray,CCVector,CCList}.(--^)` for right-open ranges
-- add `Containers.{Char,Result}`
-- modify `CCPersistentHashtbl.merge` and add `CCMap.merge_safe`
-- add `CCHet`, heterogeneous containers (table/map) indexed by keys
-- add `CCString.rev`
-- add `CCImmutArray` into containers.data
-- add `CCList.Assoc.remove`
-
-=== Fixes, misc
-
-- Make `CCPersistentHashtbl.S.merge` more general.
-- optimize KMP search in `CCString.Find` (hand-specialize code)
-- bugfix in `CCFormat.to_file` (fd was closed too early)
-
-- add a special case for pattern of length 1 in `CCString.find`
-- more tests, bugfixes, and benchs for KMP in CCString
-- in CCString, use KMP for faster sub-string search; add `find_all{,_l}`
-
-others:
-
-- `watch` target should build all
-- add version constraint on sequence
-- migrate to new qtest
-- add an `IO` section to the tutorial
-- enable `-j 0` for ocamlbuild
-
-== 0.16
-
-=== breaking
-
-- change the signature of `CCHeap.{of_gen,of_seq,of_klist}`
-- change the API of `CCMixmap`
-- make type `CCHash.state` abstract (used to be `int64`)
-- optional argument `~eq` to `CCGraph.Dot.pp`
-- rename `CCFuture` into `CCPool`
-
-=== deprecations
-
-- deprecate `containers.bigarray`
-- deprecate `CCHashtbl.{Counter,Default}` tables
-- deprecate `CCLinq` in favor of standalone `OLinq` (to be released)
-
-=== bugfixes
-
-- fix wrong signature of `CCHashtbl.Make.{keys,values}_list`
-- missing constraint in `CCSexpM.ID_MONAD`
-
-=== new features
-
-- add a tutorial file
-- add a printer into CCHeap
-- add `{CCList,CCOpt}.Infix` modules
-- add `CCOpt.map_or`, deprecating `CCopt.maybe`
-- add `CCFormat.sprintf_no_color`
-- add `CCFormat.{h,v,hov,hv}box` printer combinators
-- add `CCFormat.{with_color, with_colorf}`
-- add `CCList.hd_tl`
-- add `CCResult.{map_or,get_or}`
-- add `CCGraph.make` and utils
-- add `CCHashtbl.add_list`
-- add counter function in `CCHashtbl`, to replace `CCHashtbl.Counter`
-- add `CCPair.make`
-- add `CCString.Split.{left,right}_exn`
-- add `CCIO.File.{read,write,append}` for quickly handling files
-- add `CCRandom.pick_{list,array}`
-- add `CCList.Assoc.update`
-- add `CCList.Assoc.mem`
-- add `{CCMap,CCHashtbl}.get_or` for lookup with default value
-- add `CCLock.{decr_then_get, get_then_{decr,set,clear}}`
-- rename `CCFuture` into `CCPool`, expose the thread pool
-- split `CCTimer` out of `CCFuture`, a standalone 1-thread timer
-- move `CCThread.Queue` into `CCBlockingQueue`
-- add `CCResult`, with dependency on `result` for retrocompat
-- add `CCThread.spawn{1,2}`
-- add many helpers in `CCUnix` (for sockets, files, and processes)
-- add `CCFun.finally{1,2}`, convenience around `finally`
-- add `CCLock.update_map`
-- add `CCLock.{incr_then_get,get_then_incr}`
-- add breaking space in `CCFormat.{pair,triple,quad}`
-- update `examples/id_sexp` so it can read on stdin
-- add `CCList.fold_map2`
-
-== 0.15
-
-=== breaking changes
-
-- remove deprecated `CCFloat.sign`
-- remove deprecated `CCSexpStream`
-
-=== other changes
-
-- basic color handling in `CCFormat`, using tags and ANSI codes
-- add `CCVector.ro_vector` as a convenience alias
-- add `CCOrd.option`
-- add `CCMap.{keys,values}`
-- add wip `CCAllocCache`, an allocation cache for short-lived arrays
-- add `CCError.{join,both}` applicative functions for CCError
-- opam: depend on ecamlbuild
-- work on `CCRandom` by octachron:
-  * add an uniformity test
-  * Make `split_list` uniform
-  * Add sample_without_replacement
-
-- bugfix: forgot to export `{Set.Map}.OrderedType` in `Containers`
-
-== 0.14
-
-=== 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
-
-- 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`
-- 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`
-- add `CCString.replace` and tests
-- add `CCPersistentHashtbl.stats`
-- reimplementation of `CCPersistentHashtbl`
-- add `make watch` target
-- add `CCVector.rev_iter`
-- add `CCVector.append_list`
-- add `CCVector.ensure_with`
-- add `CCVector.return`
-- add `CCVector.find_map`
-- add `CCVector.flat_map_list`
-- add `Containers.Hashtbl` with most combinators of `CCHashtbl`
-- many more functions in `CCList.Zipper`
-- large update of `CCList.Zipper`
-- add `CCHashtbl.update`
-- improve `CCHashtbl.MakeCounter`
-- add `CCList.fold_flat_map`
-- add module `CCChar`
-- add functions in `CCFormat`
-- add `CCPrint.char`
-- add `CCVector.to_seq_rev`
-- doc and tests for `CCLevenshtein`
-- expose blocking decoder in `CCSexpM`
-- add `CCList.fold_map`
-- add `CCError.guard_str_trace`
-- add `CCError.of_exn_trace`
-- add `CCKlist.memoize` for costly computations
-- add `CCLevenshtein.Index.{of,to}_{gen,seq}` and `cardinal`
-
-- small bugfix in `CCSexpM.print`
-- fix broken link to changelog (fix #51)
-- fix doc generation for `containers.string`
-- bugfix in `CCString.find`
-- raise exception in `CCString.replace` if `sub=""`
-- bugfix in hashtable printing
-- bugfix in `CCKList.take`, it was slightly too eager
-
-== 0.13
-
-=== Breaking changes
-
-- big refactoring of `CCLinq` (now simpler and cleaner)
-- changed the types `input` and `ParseError`  in `CCParse`
-- move `containers.misc` and `containers.lwt` into their own repo
-- change the exceptions in `CCVector`
-- change signature of `CCDeque.of_seq`
-
-=== 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 `CCHashSet` into `containers.data`, a mutable set
-- add module `CCInt64`
-- move module `RAL` into `containers.data` as `CCRAL`
-- new module `CCThread` in `containers.thread`, utils for threading (+ blocking queue)
-- new module `CCSemaphore` in `containers.thread`, with simple semaphore
-- add `containers.top`, a small library that installs printers
-
-- add `CCParse.memo` for memoization (changes `CCParse.input`)
-- add `CCString.compare_versions`
-- update `CCHash` with a functor and module type for generic hashing
-- add `CCList.{take,drop}_while`; improve map performance
-- add `CCList.cons_maybe`
-- add `CCArray.bsearch` (back from batteries)
-- add fair functions to `CCKList`
-- deprecate `CCList.split`, introduce `CCList.take_drop` instead.
-- add `CCKtree.force`
-- add tests to `CCIntMap`; now flagged "stable" (for the API)
-- add `CCOpt.choice_seq`
-- add `CCOpt.print`
-- add `CCIntMap.{equal,compare,{of,to,add}_{gen,klist}}`
-- add `CCThread.Barrier` for simple synchronization
-- add `CCPersistentArray.{append,flatten,flat_map,of_gen,to_gen}`
-- add `CCDeque.clear`
-- add `CCDeque.{fold,append_{front,back},{of,to}_{gen,list}}` and others
-- add `CCKList.{zip, unzip}`
-- add `CCKList.{of_array,to_array}`
-- add `CCKList.{head,tail,mapi,iteri}`
-- add `CCKList.{unfold,of_gen}`
-- add `CCParse.{input_of_chan,parse_file,parse_file_exn}`
-- modify `CCParse.U.list` to skip newlines
-- add `CCDeque.print`
-- add `CCBV.print`
-- add printer to `CCHashtbl`
-
-- bugfix in `CCSexpM`
-- new tests in `CCTrie`; bugfix in `CCTrie.below`
-- lots of new tests
-- more benchmarks; cleanup of benchmarks
-- migration of tests to 100% qtest
-- migration markdown to asciidoc for doc (readme, etc.)
-- add tests to `CCIntMap`, add type safety, and fix various bugs in `{union,inter}`
-- more efficient `CCThread.Queue.{push,take}_list`
-- slightly different implem for `CCThread.Queue.{take,push}`
-- new implementation for `CCDeque`, more efficient
-- update makefile (target devel)
-
-== 0.12
-
-=== breaking
-
-- change type of `CCString.blit` so it writes into `Bytes.t`
-- better default opening flags for `CCIO.with_{in, out}`
-
-=== non-breaking
-
-NOTE: use of `containers.io` is deprecated (its only module has moved to `containers`)
-
-- add `CCString.mem`
-- add `CCString.set` for updating immutable strings
-- add `CCList.cons` function
-- enable `-safe-string` on the project; fix `-safe-string` issues
-- move `CCIO` from `containers.io` to `containers`, add dummy module in `containers.io`
-- add `CCIO.read_all_bytes`, reading a whole file into a `Bytes.t`
-- add `CCIO.with_in_out` to read and write a file
-- add `CCArray1` in containers.bigarray, a module on 1-dim bigarrays (experimental)
-- add module `CCGraph` in `containers.data`, a simple graph abstraction similar to `LazyGraph`
-- add a lot of string functions in `CCString`
-- add `CCError.catch`, in prevision of the future standard `Result.t` type
-- add `CCError.Infix` module
-- add `CCHashconsedSet` in `containers.data` (set with maximal struct sharing)
-
-- fix: use the proper array module in `CCRingBuffer`
-- bugfix: `CCRandom.float_range`
-
-== 0.11
-
-- add `CCList.{remove,is_empty}`
-- add `CCOpt.is_none`
-- remove packs for `containers_string` and `containers_advanced`
-- add `Containers_string.Parse`, very simple monadic parser combinators
-- add `CCList.{find_pred,find_pred_exn}`
-- bugfix in `CCUnix.escape_str`
-- add methods and accessors to `CCUnix`
-- in `CCUnix`, use `Unix.environment` as the default environment
-- add `CCList.partition_map`
-- `RingBuffer.{of_array, to_array}` convenience functions
-- `containers.misc.RAL`: more efficient in memory (unfold list)
-- add `CCInt.pow` (thanks to bernardofpc)
-- add `CCList.group_succ`
-- `containers.data.CCMixset`, set of values indexed by poly keys
-- disable warning 32 (unused val) in .merlin
-- some infix operators for `CCUnix`
-- add `CCUnix.async_call` for spawning and communicating with subprocess
-- add `CCList.Set.{add,remove}`
-- fix doc of `CCstring.Split.list_`
-
-== 0.10
-
-- add `containers.misc.Puf.iter`
-- add `CCString.{lines,unlines,concat_gen}`
-- `CCUnix` (with a small subprocess API)
-- add `CCList.{sorted_merge_uniq, uniq_succ}`
-- breaking: fix documentation of `CCList.sorted_merge` (different semantics)
-- `CCPersistentArray` (credit to @gbury and Jean-Christophe Filliâtre)
-- `CCIntMap` (big-endian patricia trees) in containers.data
-- bugfix in `CCFQueue.add_seq_front`
-- add `CCFQueue.{rev, --}`
-- add `App_parse` in `containers.string`, experimental applicative parser combinators
-- remove `containers.pervasives`, add the module `Containers` to core
-- bugfix in `CCFormat.to_file`
-
-== 0.9
-
-- add `Float`, `Ref`, `Set`, `Format` to `CCPervasives`
-- `CCRingBuffer.append` (simple implementation)
-- `containers.data` now depends on bytes
-- new `CCRingBuffer` module, imperative deque with batch (blit) operations,
-  mostly done by Carmelo Piccione
-- new `Lwt_pipe` and `Lwt_klist` streams for Lwt, respectively (un)bounded
-  synchronized queues and lazy lists
-- `CCKTree.print`, a simple S-expressions printer for generic trees
-- Add `CCMixmap` in containers.data (close #40), functional alternative to `CCMixtbl`
-- remove old META file
-- simplified `CCTrie` implementation
-- use "compiledObject: best" in `_oasis` for binaries
-- document some invariants in `CCCache` (see #38)
-- tests for `CCCache.lru`
-- fix `CCFormat.seq` combinator
-- add `CCSet` module in core/
-- add `CCRef` module in core/
-
-== 0.8
-
-- add `@Emm` to authors
-- refactored heavily `CCFuture` (much simpler, cleaner, basic API and thread pool)
-- add `CCLock` in containers.thread
-- 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)
-- use benchmark 1.4, with the upstreamed tree system
-- test `ccvector.iteri`
-- add `CCFormat` into core/
-- infix map operators for `CCArray`
-- `fold_while` impl for `CCList` and `CCArray`
-- Added `CCBigstring.length` for more consistency with the `CCString` module.
-- Added name and dev fields in the OPAM file for local pinning.
-- Fix `CCIO.remove*` functions.
-- Added `CCIO.remove_safe`.
-- only build doc if all the required flags are enabled
-- `CCHashtbl.{keys,values}_list` in the functor as well. Better doc.
-- `CCHashtbl.{keys,values}_list`
-- more accurate type for `CCHashtbl.Make`
-
-== 0.7
-
-=== breaking
-
-- remove `cgi`/
-- removed useless Lwt-related module
-- remove `CCGen` and `CCsequence` (use the separate libraries)
-- split the library into smaller pieces (with `containers.io`, `containers.iter`,
-    `containers.sexp`, `containers.data`)
-
-=== 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`
-    * add `CCSexpM` for a simpler, monadic parser of S-expressions (deprecating `CCSexpStream`)
-- `core`:
-    * `CCString.fold`
-    * `CCstring.suffix`
-    * more efficient `CCString.init`
-    * fix errors in documentation of `CCString` (slightly over-reaching sed)
-    * add `CCFloat.{fsign, sign_exn}` (thanks @bernardofpc)
-- new `containers.bigarray`, with `CCBigstring`
-- `CCHashtbl.map_list`
-- `io`:
-    * `CCIO.read_all` now with ?size parameter
-    * use `Bytes.extend` (praise modernity!)
-    * bugfix in `CCIO.read_all` and `CCIO.read_chunks`
-- use `-no-alias-deps`
-
-== 0.6.1
-
-- use subtree `gen/` for `CCGen` (symlink) rather than a copy.
-- Add benchmarks for the function `iter` of iterators.
-- `CCKTree`: more printers (to files), `Format` printer
-- `CCOpt.get_lazy` convenience function
-- introduce `CCFloat`, add float functions to `CCRandom` (thanks to @struktured)
-
-== 0.6
-
-=== breaking changes
-
-- new `CCIO` module, much simpler, but incompatible interface
-- renamed `CCIO` to `advanced.CCMonadIO`
-
-=== other changes
-
-- `CCMultiSet.{add_mult,remove_mult,update}`
-- `CCVector.{top,top_exn}`
-- `CCFun.compose_binop` (binary composition)
-- `CCList.init`
-- `CCError.map2` has a more general type (thanks to @hcarty)
-- new module `CCCache`
-    * moved from `misc`
-    * add `CCache`.{size,iter}
-    * incompatible interface (functor -> values), much simpler to use
-- `lwt/Lwt_actor` stub, for erlang-style concurrency (albeit much much more naive)
-- `misc/Mixtbl` added from its old repository
-- more benchmarks, with a more general system to select/run them
-- more efficient versions of `CCList.{flatten,append,flat_map}`, some functions
-  are now tailrec
-
-
-== 0.5
-
-=== breaking changes
-
-- dependency on `cppo` (thanks to @whitequark, see `AUTHORS.md`) and `bytes`
-- `CCError`:
-    * now polymorphic on the error type
-    * some retro-incompatibilies (wrap,guard)
-- `CCPervasives.Opt` -> `CCPervasives.Option`
-- `Levenshtein.Index.remove` changed signature (useless param removed)
-
-=== other changes
-
-- stronger inlining for `CCVector` (so that e.g. push is inline)
-- more tests for `CCVector`
-- removed many warnings
-- `CCSequence` now provides some bytes-dependent operations
-- `CCList.(>|=)` map operator
-- `CCOpt.filter`
-- `CCInt.neg`
-- `CCMap` wrapper to the standard `Map` module
-- make some functions in `CCFun` and `CCString` depend on ocaml version
-- thanks to @whitequark, could use cppo for preprocessing files
-- add Format printers to `CCString`
-- `AUTHORS.md`
-
-== 0.4.1
-
-- `CCOpt.get`
-- new functions in `CCSexp.Traverse`
-- comments in `CCMultiSet.mli`, to explain meet/intersection/union
-- `CCMultiset`: Add meet
-- update of readme
-- generate doc for `containers.advanced`
-
-== 0.4
-
-- `core/CCSexp` for fast and lightweight S-expressions parsing/printing
-- moved `CCLinq`, `CCBatch` and `CCat` from core/ to advanced/
-- ensure compatibility with ocaml 4.00
-- get rid of deprecated `Array.create`
-- move benchmarks to benchs/ so they are separate from tests
-- `CCError.{iter,get_exn}`
-- `CCPair.print`
-- some small improvements to `CCRandom`
-- moved `CCHashtbl` to `CCFlatHashtbl`; new module `CCHashtbl` that
-  wraps and extends the standard hashtable
-- `CCPervasives` module, replacing modules of the standard library
-- removed type alias `CCString.t` (duplicate of String.t which already exists)
-
-== 0.3.4
-
-- subtree for `sequence` repo
-- `CCSequence` is now a copy of `sequence`
-- `CCOpt.wrap{1,2}`
-- `CCList.findi`, `CCArray.findi` and `CCArray.find_idx`
-- better `Format` printers (using break hints)
-- specialize some comparison functions
-- `CCOrd.map`
-
-== 0.3.3
-
-- readme: add ci hook (to http://ci.cedeela.fr)
-- `CCIO`: monad for IO actions-as-values
-    - explicit finalizer system, to use a `>>>=` operator rather than callbacks
-    - `File` for basic filenames manipulations
-    - `Seq` for streams
-- `CCMultiMap`: functor for bidirectional mappings
-- `CCMultiSet`: sequence
-- renamed threads/future to threads/CCFuture
-- big upgrade of `RAL` (random access lists)
-- `CCList.Ref` to help use references on lists
-- `CCKList`: `group,uniq,sort,sort_uniq,repeat` and `cycle`, infix ops, applicative,product
-- `CCTrie.above/below`: ranges of items
-- more functions in `CCPair`
-- `CCCat`: funny (though useless) definitions inspired from Haskell
-- `CCList`: applicative instance
-- `CCString.init`
-- `CCError.fail_printf`
-
-== 0.3.2
-
-- small change in makefile
-- conversions for `CCString`
-- `CCHashtbl`: open-addressing table (Robin-Hood hashing)
-- registered printers for `CCError`.guard,wrap1,etc.
-- monadic operator in `CCList`: `map_m_par`
-- simple interface to `PrintBox` now more powerful
-- constructors for 1 or 2 elements fqueues
-- bugfixes in BTree (insertion should work now)
-- `CCFQueue`: logarithmic access by index
-- add BTree partial implementation (not working yet)
-- fix bug in `CCPrint.to_file`
-- `CCArray.lookup` for divide-and-conquer search
-- `CCList.sort_uniq`
-- `CCError`: retry and choose combinators
-- stub for monadic IO in `CCPrint`
-- `CCopt.pure`
-- updated `CCPersistentHashtbl` with new functions; updated doc, simplified code
-- move `CCString` into core/, since it deals with a basic type; also add some features to `CCString` (Sub and Split modules to deal with slices and splitting by a string)
-- `CCArray.blit`, `.Sub.to_slice`; some bugfixes
-- applicative and lifting operators for `CCError`
-- `CCError.map2`
-- more combinators in `CCError`
-
-== 0.3.1
-
-- test for `CCArray.shuffle`
-- bugfix in `CCArray.shuffle`
-- `CCOpt.get_exn`
-- `CCOpt.sequence_l`
-- mplus instance for `CCOpt`
-- monad instance for `CCFun`
-- updated description in `_oasis`
-- `CCTrie`, a compressed functorial persistent trie structure
-- fix `CCPrint.unit`, add `CCPrint.silent`
-- fix type mismatch
-
-NOTE: `git log --no-merges previous_version..HEAD --pretty=%s`

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.md` (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,137 +1,44 @@
-# OASIS_START
-# DO NOT EDIT (digest: 9a60866e2fa295c5e33a3fe33b8f3a32)
+PACKAGES=containers,containers-data
 
-SETUP = ./setup.exe
+all: build test
 
-build: setup.data $(SETUP)
-	$(SETUP) -build $(BUILDFLAGS)
+build:
+	dune build @install -p $(PACKAGES)
 
-doc: setup.data $(SETUP) build
-	$(SETUP) -doc $(DOCFLAGS)
+test: build
+	# 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
-	$(SETUP) -test $(TESTFLAGS)
+clean:
+	dune clean
 
-all: $(SETUP)
-	$(SETUP) -all $(ALLFLAGS)
+doc:
+	dune build @doc
 
-install: setup.data $(SETUP)
-	$(SETUP) -install $(INSTALLFLAGS)
+examples:
+	dune build examples/id_sexp.exe
 
-uninstall: setup.data $(SETUP)
-	$(SETUP) -uninstall $(UNINSTALLFLAGS)
+format:
+	@dune build $(DUNE_OPTS) @fmt --auto-promote
 
-reinstall: setup.data $(SETUP)
-	$(SETUP) -reinstall $(REINSTALLFLAGS)
+format-check:
+	@dune build $(DUNE_OPTS) @fmt --display=quiet
 
-clean: $(SETUP)
-	$(SETUP) -clean $(CLEANFLAGS)
 
-distclean: $(SETUP)
-	$(SETUP) -distclean $(DISTCLEANFLAGS)
-	$(RM) $(SETUP)
-
-setup.data: $(SETUP)
-	$(SETUP) -configure $(CONFIGUREFLAGS)
-
-configure: $(SETUP)
-	$(SETUP) -configure $(CONFIGUREFLAGS)
-
-setup.exe: setup.ml
-	ocamlfind ocamlopt -o $@ -linkpkg -package oasis.dynrun $< || ocamlfind ocamlc -o $@ -linkpkg -package oasis.dynrun $< || 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/
-
-DONTTEST=myocamlbuild.ml setup.ml $(wildcard src/**/*.cppo.*)
-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/io/*.ml) \
-	$(wildcard src/io/*.mli) \
-	$(wildcard src/unix/*.ml) \
-	$(wildcard src/unix/*.mli) \
-	$(wildcard src/sexp/*.ml) \
-	$(wildcard src/sexp/*.mli) \
-	$(wildcard src/advanced/*.ml) \
-	$(wildcard src/advanced/*.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)
+VERSION=$(shell awk '/^version:/ {print $$2}' containers.opam)
 
 update_next_tag:
 	@echo "update version to $(VERSION)..."
-	zsh -c 'sed -i "s/NEXT_VERSION/$(VERSION)/g" **/*.ml **/*.mli'
-	zsh -c 'sed -i "s/NEXT_RELEASE/$(VERSION)/g" **/*.ml **/*.mli'
-
-devel:
-	./configure --enable-bench --enable-tests --enable-unix \
-		--enable-bigarray --enable-thread --enable-advanced
-	make all
+	sed -i "s/NEXT_VERSION/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli)
+	sed -i "s/NEXT_RELEASE/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli)
 
+WATCH?=@src/check @tests/runtest
 watch:
-	while find src/ benchs/ -print0 | xargs -0 inotifywait -e delete_self -e modify ; do \
-		echo "============ at `date` ==========" ; \
-		make all; \
-	done
+	@dune build $(WATCH) -w
 
-.PHONY: examples push_doc tags qtest-gen qtest-clean devel update_next_tag
+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: all test clean build doc update_next_tag watch examples

README.adoc

@@ -1,276 +0,0 @@
-= OCaml-containers =
-:toc: macro
-:source-highlighter: pygments
-
-What is _containers_? (take a look at the link:TUTORIAL.adoc[tutorial]!
-or the http://cedeela.fr/~simon/software/containers[documentation])
-In `containers` and `containers.data`, all modules abide by
-_pay for what you use_: only modules that are used are linked (there are no
-cross-module dependencies).
-
-- 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 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.io:: (deprecated)
-  containers.iter:: with list-like and tree-like iterators;
-  containers.string:: (in directory `string`) with
-    a few packed modules that deal with strings (Levenshtein distance,
-    KMP search algorithm, and a few naive utils). Again, modules are independent
-    and sometimes parametric on the string and char types (so they should
-    be able to deal with your favorite unicode library).
-
-- A sub-library with complicated abstractions, `containers.advanced` (with
-  a LINQ-like query module, batch operations using GADTs, and others).
-- Utilities around the `unix` library in `containers.unix` (mainly to spawn
-  sub-processes)
-- A bigstring module using `bigarray` in `containers.bigarray` (*deprecated*)
-- A lightweight S-expression printer and streaming parser in `containers.sexp`
-
-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.
-
-image:https://ci.cedeela.fr/buildStatus/icon?job=containers[alt="Build Status", link="http://ci.cedeela.fr/job/containers/"]
-
-toc::[]
-
-image::media/logo.png[logo]
-
-== Change Log
-
-See link:CHANGELOG.adoc[this file].
-
-== Finding help
-
-- *new*: 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
-
-Start with the link:TUTORIAL.adoc[tutorial]
-
-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.
-
-The logo (`media/logo.png`) is
-CC-SA3 http://en.wikipedia.org/wiki/File:Hypercube.svg[wikimedia].
-
-== Contents
-
-The library contains a <<core,Core part>> that mostly extends the stdlib
-and adds a few very common structures (heap, vector), and sub-libraries
-that deal with either more specific things, or require additional dependencies.
-
-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 = [`Error of string | `Ok of 'a]` is a error type
-  that is used in other libraries, too. The reference module in containers
-  is `CCError`.
-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.
-
-[[core]]
-=== Core Modules (extension of the standard library)
-
-the core library, `containers`, now depends on
-https://github.com/mjambon/cppo[cppo] and `base-bytes` (provided
-by ocamlfind).
-
-Documentation http://cedeela.fr/~simon/software/containers[here].
-
-- `CCHeap`, a purely functional heap structure
-- `CCVector`, a growable array (pure OCaml, no C) with mutability annotations
-- `CCList`, functions on lists, including tail-recursive implementations of `map` and `append` and many other things
-- `CCArray`, utilities on arrays and slices
-- `CCHashtbl`, `CCMap` extensions of the standard modules `Hashtbl` and `Map`
-- `CCInt`
-- `CCString` (basic string operations)
-- `CCPair` (cartesian products)
-- `CCOpt` (options, very useful)
-- `CCFun` (function combinators)
-- `CCBool`
-- `CCFloat`
-- `CCOrd` (combinators for total orderings)
-- `CCRandom` (combinators for random generators)
-- `CCPrint` (printing combinators)
-- `CCHash` (hashing combinators)
-- `CCError` (monadic error handling, very useful)
-- `CCIO`, basic utilities for IO (channels, files)
-- `CCInt64,` utils for `int64`
-- `CCChar`, utils for `char`
-- `CCFormat`, pretty-printing utils around `Format`
-
-=== Containers.data
-
-- `CCBitField`, bitfields embedded in integers
-- `CCBloom`, a bloom filter
-- `CCCache`, memoization caches, LRU, etc.
-- `CCFlatHashtbl`, a flat (open-addressing) hashtable functorial implementation
-- `CCTrie`, a prefix tree
-- `CCHashTrie`, a map where keys are hashed and put in a trie by hash
-- `CCMultimap` and `CCMultiset`, functors defining persistent structures
-- `CCFQueue`, a purely functional double-ended queue structure
-- `CCBV`, mutable bitvectors
-- `CCHashSet`, mutable set
-- `CCPersistentHashtbl` and `CCPersistentArray`, a semi-persistent array and hashtable
-  (similar to https://www.lri.fr/~filliatr/ftp/ocaml/ds/parray.ml.html[persistent arrays])
-- `CCMixmap`, `CCMixtbl`, `CCMixset`, containers of universal types (heterogenous containers)
-- `CCRingBuffer`, a double-ended queue on top of an array-like structure,
-  with batch operations
-- `CCIntMap`, map specialized for integer keys based on Patricia Trees,
-  with fast merges
-- `CCHashconsedSet`, a set structure with sharing of sub-structures
-- `CCGraph`, a small collection of graph algorithms
-- `CCBitField`, a type-safe implementation of bitfields that fit in `int`
-- `CCWBTree`, a weight-balanced tree, implementing a map interface
-- `CCRAL`, a random-access list structure, with `O(1)` cons/hd/tl and `O(ln(n))`
-  access to elements by their index.
-- `CCImmutArray`, immutable interface to arrays
-
-=== Containers.io
-
-*deprecated*, `CCIO` is now a <<core,core>> module. You can still install it and
-depend on it but it contains no useful module.
-
-=== Containers.unix
-
-- `CCUnix`, utils for `Unix`
-
-=== Containers.sexp
-
-A small S-expression library.
-
-- `CCSexp`, a small S-expression library
-
-=== Containers.iter
-
-Iterators:
-
-- `CCKList`, a persistent iterator structure (akin to a lazy list, without memoization)
-- `CCKTree`, an abstract lazy tree structure
-
-=== String
-
-See http://cedeela.fr/~simon/software/containers/Containers_string[doc].
-
-In the module `Containers_string`:
-- `Levenshtein`: edition distance between two strings
-- `KMP`: Knuth-Morris-Pratt substring algorithm
-- `Parse`: simple parser combinators
-
-=== Advanced
-
-See http://cedeela.fr/~simon/software/containers/Containers_advanced[doc].
-
-In the module `Containers_advanced`:
-- `CCLinq`, high-level query language over collections
-- `CCCat`, a few categorical structures
-- `CCBatch`, to combine operations on collections into one traversal
-
-=== Thread
-
-In the library `containers.thread`, for preemptive system threads:
-
-- `CCFuture`, a set of tools for preemptive threading, including a thread pool,
-  monadic futures, and MVars (concurrent boxes)
-- `CCLock`, values protected by locks
-- `CCSemaphore`, a simple implementation of semaphores
-- `CCThread` basic wrappers for `Thread`
-
-=== Misc
-
-The library has moved to https://github.com/c-cube/containers-misc .
-
-=== Others
-
-`containers.lwt` has moved to https://github.com/c-cube/containers-lwt .
-
-[[build]]
-== Build
-
-You will need OCaml `>=` 4.00.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 --enable-bigarray
-    $ 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 welcome (patches by email too, if you prefer so).
-
-A few guidelines:
-
-- no dependencies between basic modules (even just for signatures);
-- add `@since` tags for new functions;
-- add tests if possible (using `qtest`).
-
-Powered by image:http://oasis.forge.ocamlcore.org/oasis-badge.png[alt="OASIS", style="border: none;", link="http://oasis.forge.ocamlcore.org/"]
-
-== Documentation by version
-
-- http://c-cube.github.io/ocaml-containers/0.17/[0.17]

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>

TUTORIAL.adoc

@@ -1,275 +0,0 @@
-= Tutorial
-:source-highlighter: pygments
-
-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`, `CCError`, `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`.
-CCError::
-  An error type for making error handling more explicit (an error monad,
-  really, if you're not afraid of the "M"-word). It is similar to the
-  more recent `CCResult`, but works with polymorphic variants for
-  compatibility with the numerous libraries that use the same type,
-  that is, `type ('a, 'b) CCError.t = [`Ok of 'a | `Error of 'b]`.
-CCResult::
-  It uses the new `result` type from the standard library (or from
-  the retrocompatibility package on opam), and presents an interface
-  similar to `CCError`. In an indeterminate amount of time, it will
-  totally replace `CCError`.
-
-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])
-
-----
-

_oasis

@@ -1,207 +0,0 @@
-OASISFormat: 0.4
-Name:        containers
-Version:     0.19
-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
-
-XOCamlbuildExtraArgs: "-j 0"
-
-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:      false
-
-Flag "thread"
-  Description:  Build modules that depend on threads
-  Default:      true
-
-Flag "bench"
-  Description:  Build and run benchmarks
-  Default:      true
-
-Flag "bigarray"
-  Description:  Build modules that depend on bigarrays
-  Default:      true
-
-Flag "advanced"
-  Description:  Build advanced combinators (requires "sequence")
-  Default:      true
-
-Library "containers"
-  Path:             src/core
-  Modules:          CCVector, CCPrint, CCError, CCHeap, CCList, CCOpt, CCPair,
-                    CCFun, CCHash, CCInt, CCBool, CCFloat, CCArray, CCRef, CCSet,
-                    CCOrd, CCRandom, CCString, CCHashtbl, CCMap, CCFormat, CCIO,
-                    CCInt64, CCChar, CCResult, Containers
-  BuildDepends:     bytes, result
-  # BuildDepends:     bytes, bisect_ppx
-
-Library "containers_io"
-  Path:             src/io
-  Modules:          Containers_io_is_deprecated
-  BuildDepends:     bytes
-  FindlibParent:    containers
-  FindlibName:      io
-
-Library "containers_unix"
-  Path:             src/unix
-  Modules:          CCUnix
-  BuildDepends:     bytes, unix
-  FindlibParent:    containers
-  FindlibName:      unix
-
-Library "containers_sexp"
-  Path:             src/sexp
-  Modules:          CCSexp, CCSexpM
-  BuildDepends:     bytes
-  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, CCHashconsedSet, CCGraph, CCHashSet, CCBitField,
-                    CCHashTrie, CCBloom, CCWBTree, CCRAL, CCAllocCache,
-                    CCImmutArray, CCHet
-  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_string"
-  Path:             src/string
-  Modules:          Containers_string, CCKMP, CCLevenshtein, CCApp_parse, CCParse
-  BuildDepends:     bytes
-  FindlibName:      string
-  FindlibParent:    containers
-
-Library "containers_advanced"
-  Path:             src/advanced
-  Modules:          Containers_advanced, CCLinq, CCBatch, CCCat, CCMonadIO
-  Build$:           flag(advanced)
-  Install$:         flag(advanced)
-  FindlibName:      advanced
-  FindlibParent:    containers
-  BuildDepends:     containers, sequence
-
-Library "containers_bigarray"
-  Path:             src/bigarray
-  Modules:          CCBigstring, CCArray1
-  FindlibName:      bigarray
-  FindlibParent:    containers
-  BuildDepends:     containers, bigarray, bytes
-
-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.bigarray, containers.string,
-                    containers.unix, containers.sexp, containers.iter
-
-Document containers
-  Title:                Containers docs
-  Type:                 ocamlbuild (0.3)
-  BuildTools+:          ocamldoc
-  Build$:               flag(docs) && flag(advanced) && flag(bigarray) && flag(unix)
-  Install:              true
-  XOCamlbuildPath:      .
-  XOCamlbuildExtraArgs:
-    "-docflags '-colorize-code -short-functors -charset utf-8'"
-  XOCamlbuildLibraries:
-    containers, containers.iter, containers.data,
-    containers.string, containers.bigarray, containers.thread,
-    containers.advanced, containers.io, containers.unix, containers.sexp
-
-Executable run_benchs
-  Path:             benchs/
-  Install:          false
-  CompiledObject:   best
-  Build$:           flag(bench)
-  MainIs:           run_benchs.ml
-  BuildDepends:     containers, containers.advanced, qcheck,
-                    containers.data, containers.string, containers.iter,
-                    containers.thread, sequence, gen, benchmark, hamt
-
-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(bigarray) && flag(unix) && flag(advanced)
-  BuildDepends:     containers, containers.string, containers.iter,
-                    containers.io, containers.advanced, containers.sexp,
-                    containers.bigarray, 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) && flag(advanced) && flag(bigarray)
-
-Executable mem_measure
-  Path:             benchs/
-  Install:          false
-  CompiledObject:   native
-  MainIs:           mem_measure.ml
-  Build$:           flag(bench)
-  BuildDepends:     sequence, unix, containers, containers.data, hamt
-
-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,161 +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/**/*.ml> and not <src/misc/*.ml>: warn_A, warn(-4), warn(-44)
-true: no_alias_deps, safe_string, short_paths

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/mem_measure.ml

@@ -1,119 +0,0 @@
-
-(* goal: measure memory consumption *)
-
-(* number of words allocated *)
-let mem_allocated () =
-  let gc = Gc.stat () in
-  gc.Gc.minor_words +. gc.Gc.major_words -. gc.Gc.promoted_words
-
-(* overhead in memory *)
-let mem_occupied x = Objsize.size_kb (Obj.repr x)
-
-type stats = {
-  time: float;
-  occ: int;
-  alloc: float;
-}
-
-let measure_time_mem f =
-  let mem_alloc1 = mem_allocated () in
-  let start = Unix.gettimeofday() in
-  let x = f () in
-  let stop  = Unix.gettimeofday() in
-  Gc.compact ();
-  let mem_alloc2 = mem_allocated () in
-  let mem_occupied = mem_occupied x in
-  ignore x;
-  { occ=mem_occupied;
-    alloc=mem_alloc2-.mem_alloc1;
-    time=stop -. start;
-  }
-
-let spf = Printf.sprintf
-
-let do_test ~name f =
-  Format.printf "test %s...@." name;
-  let res = measure_time_mem f in
-  Format.printf "  allocated:%.2f MB, occupied:%d kB, time: %.2f s@."
-    (res.alloc *. 8. /. 1_000_000.)
-    res.occ
-    res.time
-
-let test_hashtrie n =
-  let module M = CCHashTrie.Make(CCInt) in
-  do_test ~name:(spf "hashtrie(%d)" n)
-    (fun () ->
-      let m = M.of_seq Sequence.(1 -- n |> map (fun x-> x,x)) in
-      m
-    )
-
-let test_hamt n =
-  let module M = Hamt.Make'(CCInt) in
-  do_test ~name:(spf "hamt(%d)" n)
-    (fun () ->
-      let m = Sequence.(1 -- n
-        |> map (fun x-> x,x)
-        |> fold (fun m (k,v) -> M.add k v m) M.empty
-      ) in
-      m
-    )
-
-let test_map n =
-  let module M = CCMap.Make(CCInt) in
-  do_test ~name:(spf "map(%d)" n)
-    (fun () ->
-      let m = M.of_seq Sequence.(1 -- n |> map (fun x-> x,x)) in
-      m
-    )
-
-let test_wbt n =
-  let module M = CCWBTree.Make(CCInt) in
-  do_test ~name:(spf "wbt(%d)" n)
-    (fun () ->
-      let m = M.of_seq Sequence.(1 -- n |> map (fun x-> x,x)) in
-      m
-    )
-
-let test_hashtbl n =
-  let module H = CCHashtbl.Make(CCInt) in
-  do_test ~name:(spf "hashtbl(%d)" n)
-    (fun () ->
-      let m = H.of_seq Sequence.(1 -- n |> map (fun x-> x,x)) in
-      m
-    )
-
-let test_intmap n =
-  let module M = CCIntMap in
-  do_test ~name:(spf "intmap(%d)" n)
-    (fun () ->
-      let m = M.of_seq Sequence.(1 -- n |> map (fun x-> x,x)) in
-      m
-    )
-
-let tests_ =
-  [ "hashtrie", test_hashtrie
-  ; "map", test_map
-  ; "hamt", test_hamt
-  ; "wbt", test_wbt
-  ; "hashtbl", test_hashtbl
-  ; "intmap", test_intmap
-  ]
-
-let run_test ~n name = List.assoc name tests_ n
-
-let print_list () =
-  Format.printf "@[<v2>tests:@ %a@]@."
-    (CCList.print CCString.print) (List.map fst tests_)
-
-let () =
-  let to_test = ref [] in
-  let n = ref 1_000_000 in
-  let options = Arg.align
-    [ "-n", Arg.Set_int n, " size of the collection"
-  ] in
-  Arg.parse options (CCList.Ref.push to_test) "usage: mem_measure [name*]";
-  match !to_test with
-    | [] ->
-        print_list ();
-        exit 0
-    | _ -> List.iter (run_test ~n:!n) (List.rev !to_test)

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(
-  struct 
-    type t = Obj.t 
-    let equal = (==) 
-    let hash o = Hashtbl.hash (magic o : int)
-  end)
-	     
+module H = Hashtbl.Make (struct
+  type t = Obj.t
+
+  let equal = ( == )
+  let hash o = Hashtbl.hash (magic o : int)
+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
-	count := !count + 1 + n;
-	for i = 0 to n - 1 do
-      	  let f = field t i in 
-	  if is_block f then traverse f
-	done
-      end else if tag = string_tag then
-	count := !count + 1 + n 
+      if tag < no_scan_tag then (
+        count := !count + 1 + n;
+        for i = 0 to n - 1 do
+          let f = field t i in
+          if is_block f then traverse f
+        done
+      ) else if tag = string_tag then
+        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
-    end
-  end
+        incr count
+    )
+  )
 
 (*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_kb o = (size_w o) / (8192 / Sys.word_size)
-
-
+let size_b o = size_w o * (Sys.word_size / 8)
+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 Table = Hashtbl.Make(H)
-    (** Imperative hashtable *)
+module PersistentHashtbl (H : Hashtbl.HashedType) = struct
+  module Table = Hashtbl.Make (H)
+  (** Imperative hashtable *)
 
   type key = H.t
+
   type 'a t = 'a zipper ref
+
   and 'a zipper =
-    | Table of 'a Table.t         (** Concrete table *)
-    | Add of key * 'a * 'a t      (** Add key *)
+    | Table of 'a Table.t  (** Concrete table *)
+    | 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 *)
-
-  let create i =
-    ref (Table (Table.create i))
+    | Remove of key * 'a t  (** As the table, but without given key *)
 
+  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
-  | Table tbl -> k tbl  (* done *)
-  | Add (key, v, t') ->
-    _reroot t'
-      (fun tbl ->
-        t' := Remove (key, t);
-        Table.add tbl key v;
-        t := Table tbl;
-        k tbl)
-  | Replace (key, v, t') ->
-    _reroot t'
-      (fun tbl ->
-        let v' = Table.find tbl key in
-        t' := Replace (key, v', t);
-        t := Table tbl;
-        Table.replace tbl key v;
-        k tbl)
-  | Remove (key, t') ->
-    _reroot t'
-      (fun tbl ->
-        let v = Table.find tbl key in
-        t' := Add (key, v, t);
-        t := Table tbl;
-        Table.remove tbl key;
-        k tbl)
+  let rec _reroot t k =
+    match !t with
+    | Table tbl -> k tbl (* done *)
+    | Add (key, v, t') ->
+      _reroot t' (fun tbl ->
+          t' := Remove (key, t);
+          Table.add tbl key v;
+          t := Table tbl;
+          k tbl)
+    | Replace (key, v, t') ->
+      _reroot t' (fun tbl ->
+          let v' = Table.find tbl key in
+          t' := Replace (key, v', t);
+          t := Table tbl;
+          Table.replace tbl key v;
+          k tbl)
+    | Remove (key, t') ->
+      _reroot t' (fun tbl ->
+          let v = Table.find tbl key in
+          t' := Add (key, v, t);
+          t := Table 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
-      t := Replace (k, v', t')
-    with Not_found ->
-      t := Remove (k, t')
-    );
+       let v' = Table.find tbl k in
+       t := Replace (k, v', t')
+     with Not_found -> 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'
-      ) tbl;
+        | Some v' -> Table.replace res k v')
+      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
-      (fun k v1 ->
+    iter t1 (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
-      (fun k v2 ->
-        if not (mem t1 k) then match f k None (Some v2) with
+    iter t2 (fun k v2 ->
+        if not (mem t1 k) then (
+          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 =
-    fun k ->
-      let tbl = reroot t in
-      Table.iter (fun x y -> k (x,y)) tbl
+  let to_seq t k =
+    let tbl = reroot t in
+    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
-      (fun k v -> match get k t2 with
-        | None -> false
-        | Some v' -> eq v v'
-      ) t1
+    && for_all
+         (fun k v ->
+           match get k t2 with
+           | None -> false
+           | Some v' -> eq v v')
+         t1
 
   let pp pp_k pp_v buf t =
     Buffer.add_string buf "{";
     let first = ref true in
-    iter t
-      (fun k v ->
-        if !first then first:=false else Buffer.add_string buf ", ";
-        Printf.bprintf buf "%a -> %a" pp_k k pp_v v
-      );
+    iter t (fun k v ->
+        if !first then
+          first := false
+        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
-      (fun k v ->
-        if !first then first:=false
-        else (Format.pp_print_string fmt ", "; Format.pp_print_cut fmt ());
-        Format.fprintf fmt "%a -> %a" pp_k k pp_v v
-      );
+    iter t (fun k v ->
+        if !first then
+          first := false
+        else (
+          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,61 +4,53 @@ 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 ->
-    CCList.random_len len random_tree
-  )
+    fix ~base:(return Empty)
+      ~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 _, _
-  | _, Node _ -> false
+  | Node (i1, l1), Node (i2, l2) -> i1 = i2 && CCList.equal eq l1 l2
+  | Node _, _ | _, Node _ -> false
 
-let rec hash_tree t h = match t with
-  | Empty -> CCHash.string_ "empty" h
-  | Node (i, l) ->
-      CCHash.list_ hash_tree l (CCHash.int_ i (CCHash.string_ "node" h))
+let rec hash_tree t =
+  match t with
+  | Empty -> CCHash.string "empty"
+  | Node (i, 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 = CCHash.apply hash_tree
+  let hash = hash_tree
 end)
 
 let print_hashcons_stats st =
   let open Hashtbl in
-    CCPrint.printf
-      "tbl stats: %d elements, num buckets: %d, max bucket: %d\n"
-      st.num_bindings st.num_buckets st.max_bucket_length;
-    Array.iteri
-      (fun i n -> CCPrint.printf "  %d\t buckets have length %d\n" n i)
-      st.bucket_histogram
+  Format.printf "tbl stats: %d elements, num buckets: %d, max bucket: %d@."
+    st.num_bindings st.num_buckets st.max_bucket_length;
+  Array.iteri
+    (fun i n -> Format.printf "  %d\t buckets have length %d@." n i)
+    st.bucket_histogram
 
 let () =
   let st = Random.State.make_self_init () in
   let n = 50_000 in
-  CCPrint.printf "generate %d elements...\n" n;
+  Format.printf "generate %d elements...\n" n;
   let l = CCRandom.run ~st (CCList.random_len n random_tree) in
   (* with custom hashtable *)
-  CCPrint.printf "### custom hashtable\n";
+  Format.printf "### custom hashtable\n";
   let tbl = H.create 256 in
   List.iter (fun t -> H.replace tbl t ()) l;
   print_hashcons_stats (H.stats tbl);
   (* with default hashtable *)
-  CCPrint.printf "### default hashtable\n";
+  Format.printf "### default hashtable\n";
   let tbl' = Hashtbl.create 256 in
   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,27 +0,0 @@
-#!/bin/sh
-
-# OASIS_START
-# DO NOT EDIT (digest: 6f7b8221311e800a7093dc3b793f67ca)
-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
-
-make configure CONFIGUREFLAGS="$*"
-# 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.15"
+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.15"
+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

@@ -0,0 +1,81 @@
+# More about OCaml-containers
+
+This document contains more information on some modules of Containers.
+
+```ocaml
+# #require "containers";;
+```
+
+## Hash combinators: `CCHash`
+
+Although OCaml provides polymorphic hash tables (`('a,'b) Hashtbl.t`)
+using the polymorphic equality `(=)` and hash `Hashtbl.hash`, it is often
+safer and more efficient to use `Hashtbl.Make` (or the extended `CCHashtbl.Make`)
+with custom equality and hash functions.
+
+`CCHash` provides combinators for writing hash functions:
+
+```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
+# 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`
+
+The module `CCParse` defines basic parser combinators on strings.
+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.
+
+```ocaml
+open CCParse.Infix
+module P = CCParse
+
+let parens p = P.try_ (P.char '(') *> p <* P.char ')'
+let add = P.char '+' *> P.return (+)
+let sub = P.char '-' *> P.return (-)
+let mul = P.char '*' *> P.return ( * )
+let div = P.char '/' *> P.return ( / )
+let integer =
+  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)
+
+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))
+```
+
+Now we can parse strings using `expr`:
+
+```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,181 +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
-{{:https://github.com/mjambon/cppo}cppo} and base-bytes (provided
-by ocamlfind).
-
-{4 Core Modules (extension of the standard library)}
-
-{b findlib name}: containers
-
-{!modules:
-CCArray
-CCBool
-CCChar
-CCError
-CCFloat
-CCFun
-CCFormat
-CCHash
-CCHashtbl
-CCHeap
-CCInt
-CCInt64
-CCIO
-CCList
-CCMap
-CCOpt
-CCOrd
-CCPair
-CCPrint
-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:
-CCAllocCache
-CCBitField
-CCBloom
-CCBV
-CCCache
-CCDeque
-CCFQueue
-CCFlatHashtbl
-CCGraph
-CCHashSet
-CCHashTrie
-CCImmutArray
-CCIntMap
-CCMixmap
-CCMixset
-CCMixtbl
-CCMultiMap
-CCMultiSet
-CCPersistentArray
-CCPersistentHashtbl
-CCRAL
-CCRingBuffer
-CCTrie
-CCWBTree
-}
-
-{4 Containers.io}
-
-{b deprecated} use {!CCIO} directly from the set of core modules.
-
-{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
-CCSexpM
-}
-
-{4 Containers.iter}
-
-Iterators:
-
-{!modules:
-CCKList
-CCKTree
-CCLazy_list}
-
-{4 String}
-
-{b findlib name}: containers.string
-
-{!modules:
-CCApp_parse
-CCKMP
-CCLevenshtein
-CCParse
-}
-
-{4 Bigarrays}
-
-{b deprecated} (use package bigstring instead)
-Use bigarrays to hold large strings and map files directly into memory.
-
-{!modules: CCBigstring CCArray1}
-
-{4 Advanced}
-
-{b findlib name}: containers.advanced
-
-This module is qualified with [Containers_advanced]. It
-requires {{:https://github.com/c-cube/sequence} Sequence}.
-
-{!modules: CCLinq CCCat CCBatch}
-
-{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,42 @@
+(lang dune 3.0)
+(name containers)
+(generate_opam_files true)
+
+(version 3.15)
+(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,18 +1,14 @@
-
-let pp_sexp s = match s with
-  | `Ok l ->
-      List.iter
-        (fun s -> Format.printf "@[%a@]@." CCSexpM.print s)
-        l
-  | `Error msg ->
-      Format.printf "error: %s@." msg
+let pp_sexp s =
+  match s with
+  | 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 = CCSexpM.parse_chan_list stdin in
-      pp_sexp s
+    let s = CCSexp.parse_chan_list stdin in
+    pp_sexp s
   | [| _; file |] ->
-      let s = CCSexpM.parse_file_list file in
-      pp_sexp s
+    let s = CCSexp.parse_file_list file in
+    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,726 +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 ->
-      (* replace with Ocamlbuild_cppo.dispatch when 4.00 is not supported
-         anymore *)
-      let dep_cppo = "%(name).cppo.ml" in
-      let prod1 = "%(name: <*> and not <*.cppo>).ml" in
-      let prod2 = "%(name: <**/*> and not <**/*.cppo>).ml" in
-      let f prod env _build =
-        let dep = env dep_cppo in
-        let prod = env prod in
-        let tags = tags_of_pathname prod ++ "cppo" in
-        Cmd (S[A "cppo"; T tags; S [A "-o"; P prod]; P dep ])
-      in
-      rule "cppo1" ~dep:dep_cppo ~prod:prod1 (f prod1) ;
-      rule "cppo2" ~dep:dep_cppo ~prod:prod2 (f prod2) ;
-      pflag ["cppo"] "cppo_D" (fun s -> S [A "-D"; A s]) ;
-      pflag ["cppo"] "cppo_U" (fun s -> S [A "-U"; A s]) ;
-      pflag ["cppo"] "cppo_I" (fun s ->
-        if Pathname.is_directory s then S [A "-I"; P s]
-        else S [A "-I"; P (Pathname.dirname s)]
-      ) ;
-      pdep ["cppo"] "cppo_I" (fun s ->
-        if Pathname.is_directory s then [] else [s]) ;
-      flag ["cppo"; "cppo_q"] (A "-q") ;
-      flag ["cppo"; "cppo_s"] (A "-s") ;
-      flag ["cppo"; "cppo_n"] (A "-n") ;
-      pflag ["cppo"] "cppo_x" (fun s -> S [A "-x"; A s]);
-      (* end replace *)
-
-      let major, minor = Scanf.sscanf Sys.ocaml_version "%d.%d.%d"
-        (fun major minor patchlevel -> major, minor)
-      in
-      let ocaml_major = "OCAML_MAJOR " ^ string_of_int major in
-      let ocaml_minor = "OCAML_MINOR " ^ string_of_int minor in
-
-      flag ["cppo"] & S[A"-D"; A ocaml_major; A"-D"; A ocaml_minor] ;
-
-      (* 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,46 +0,0 @@
-opam-version: "1.2"
-name: "containers"
-version: "dev"
-author: "Simon Cruanes"
-maintainer: "simon.cruanes@inria.fr"
-build: [
-    ["./configure"
-        "--prefix" prefix
-        "--%{base-threads:enable}%-thread"
-        "--disable-bench"
-        "--disable-tests"
-        "--%{base-bigarray:enable}%-bigarray"
-        "--%{sequence:enable}%-advanced"
-        "--%{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"
-    "cppo" {build}
-    "ocamlbuild" {build}
-]
-depopts: [ "sequence" "base-bigarray" "base-unix" "base-threads" "qtest" { test } ]
-conflicts: [
-  "sequence" { < "0.5" }
-  "qtest" { < "2.2" }
-  "qcheck"
-]
-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.00.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,30 +0,0 @@
-(* setup.ml generated for the first time by OASIS v0.4.4 *)
-
-(* OASIS_START *)
-(* DO NOT EDIT (digest: 172e37fc4b327922311f6cf9389bc560) *)
-(******************************************************************************)
-(* OASIS: architecture for building OCaml libraries and applications          *)
-(*                                                                            *)
-(* Copyright (C) 2011-2013, 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
-
-(* OASIS_STOP *)
-let () = setup ();;

src/advanced/CCBatch.ml

@@ -1,237 +0,0 @@
-(*
-copyright (c) 2013-2014, Simon Cruanes, Gabriel Radanne
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {1 Batch Operations on Collections} *)
-
-module type COLLECTION = sig
-  type 'a t
-
-  val empty : 'a t
-  val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
-  val map : ('a -> 'b) -> 'a t -> 'b t
-  val filter : ('a -> bool) -> 'a t -> 'a t
-  val filter_map : ('a -> 'b option) -> 'a t -> 'b t
-  val flat_map : ('a -> 'b t) -> 'a t -> 'b t
-end
-
-module type S = sig
-  type 'a t
-
-  type ('a,'b) op
-  (** Operation that converts a ['a t] into a ['b t] *)
-
-  val apply : ('a,'b) op -> 'a t -> 'b t
-  (** Apply the operation to the collection. *)
-
-  val apply_fold : ('a, 'b) op -> ('c -> 'b -> 'c) -> 'c -> 'a t -> 'c
-  (** Apply the operation plus a fold to the collection. *)
-
-  val apply' : 'a t -> ('a,'b) op -> 'b t
-  (** Flip of {!apply} *)
-
-  (** {6 Combinators} *)
-
-  val id : ('a, 'a) op
-
-  val map : ('a -> 'b) -> ('a, 'b) op
-
-  val filter : ('a -> bool) -> ('a,'a) op
-
-  val filter_map : ('a -> 'b option) -> ('a,'b) op
-
-  val flat_map : ('a -> 'b t) -> ('a,'b) op
-
-  val extern : ('a t -> 'b t) -> ('a,'b) op
-
-  val compose : ('b,'c) op -> ('a,'b) op -> ('a,'c) op
-  val (>>>) : ('a,'b) op -> ('b,'c) op -> ('a,'c) op
-end
-
-module Make(C : COLLECTION) = struct
-  type 'a t = 'a C.t
-  type (_,_) op =
-    | Nil : ('a,'a) op
-    | Compose : ('a,'b) base_op * ('b, 'c) op -> ('a, 'c) op
-  and (_,_) base_op =
-    | Map : ('a -> 'b) -> ('a, 'b) base_op
-    | Filter : ('a -> bool) -> ('a, 'a) base_op
-    | FilterMap : ('a -> 'b option) -> ('a,'b) base_op
-    | FlatMap : ('a -> 'b t) -> ('a,'b) base_op
-    | Extern : ('a t -> 'b t) -> ('a,'b) base_op
-
-  (* associativity: put parenthesis on the right *)
-  let rec _compose : type a b c. (a,b) op -> (b,c) op -> (a,c) op
-  = fun f g -> match f with
-    | Compose (f1, Nil) -> Compose (f1, g)
-    | Compose (f1, f2) -> Compose (f1, _compose f2 g)
-    | Nil -> g
-
-  (* After optimization, the op is a list of flatmaps and external operations,
-      with maybe something else at the end *)
-  type (_,_) optimized_op =
-    | OptNil : ('a, 'a) optimized_op
-    | OptBase : ('a,'b) base_op * ('b, 'c) optimized_op -> ('a,'c) optimized_op
-    | OptFlatMap : ('a -> 'b t) * ('b, 'c) optimized_op -> ('a, 'c) optimized_op
-    | OptExtern : ('a t -> 'b t) * ('b, 'c) optimized_op -> ('a, 'c) optimized_op
-
-  (* As compose, but optimize recursively on the way. *)
-  let rec optimize_compose
-  : type a b c. (a,b) base_op -> (b,c) op -> (a,c) optimized_op
-  = fun base_op op -> match base_op, op with
-    | f, Nil -> OptBase (f, OptNil)
-    | Map f, Compose (Map g, cont) ->
-        optimize_compose (Map (fun x -> g (f x))) cont
-    | Map f, Compose (Filter p, cont) ->
-        optimize_compose
-          (FilterMap (fun x -> let y = f x in if p y then Some y else None)) cont
-    | Map f, Compose (FilterMap f', cont) ->
-        optimize_compose
-          (FilterMap (fun x -> f' (f x))) cont
-    | Map f, Compose (FlatMap f', cont) ->
-        optimize_compose
-          (FlatMap (fun x -> f' (f x))) cont
-    | Filter p, Compose (Filter p', cont) ->
-        optimize_compose (Filter (fun x -> p x && p' x)) cont
-    | Filter p, Compose (Map g, cont) ->
-        optimize_compose
-          (FilterMap (fun x -> if p x then Some (g x) else None)) cont
-    | Filter p, Compose (FilterMap f', cont) ->
-        optimize_compose
-          (FilterMap (fun x -> if p x then f' x else None)) cont
-    | Filter p, Compose (FlatMap f', cont) ->
-        optimize_compose
-          (FlatMap (fun x -> if p x then f' x else C.empty)) cont
-    | FilterMap f, Compose (FilterMap f', cont) ->
-        optimize_compose
-          (FilterMap
-            (fun x -> match f x with None -> None | Some y -> f' y))
-          cont
-    | FilterMap f, Compose (Filter p, cont) ->
-        optimize_compose
-          (FilterMap
-            (fun x -> match f x with
-              | (Some y) as res when p y -> res
-              | _ -> None))
-          cont
-    | FilterMap f, Compose (Map f', cont) ->
-        optimize_compose
-          (FilterMap
-            (fun x -> match f x with
-              | None -> None
-              | Some y -> Some (f' y)))
-          cont
-    | FilterMap f, Compose (FlatMap f', cont) ->
-        optimize_compose
-          (FlatMap
-            (fun x -> match f x with
-              | None -> C.empty
-              | Some y -> f' y))
-          cont
-    | FlatMap f, Compose (f', tail) ->
-        merge_flat_map f (optimize_compose f' tail)
-    | Extern f, Compose (f', tail) ->
-        OptExtern (f, optimize_compose f' tail)
-    | op, Compose (Extern f', cont) ->
-        OptBase (op, optimize_compose (Extern f') cont)
-
-  and merge_flat_map
-  : type a b c. (a -> b C.t) -> (b,c) optimized_op -> (a,c) optimized_op =
-  fun f op -> match op with
-    | OptNil -> OptFlatMap (f, op)
-    | OptFlatMap (f', cont) ->
-        merge_flat_map
-          (fun x ->
-              let a = f x in
-              C.flat_map f' a)
-          cont
-    | OptExtern  _ -> OptFlatMap (f, op)
-    | OptBase _ -> OptFlatMap (f, op)
-
-  (* Optimize a batch operation by fusion *)
-  let optimize : type a b. (a,b) op -> (a,b) optimized_op
-  = fun op -> match op with
-    | Compose (a, b) -> optimize_compose a b
-    | Nil -> OptNil
-
-  let rec apply_optimized : type a b. (a,b) optimized_op -> a t -> b t
-  = fun op a -> match op with
-    | OptNil -> a
-    | OptBase (f,c) -> apply_optimized c (apply_base f a)
-    | OptFlatMap (f,c) -> apply_optimized c (C.flat_map f a)
-    | OptExtern (f,c) -> apply_optimized c (f a)
-  and apply_base : type a b. (a,b) base_op -> a t -> b t
-  = fun op a -> match op with
-    | Map f -> C.map f a
-    | Filter p -> C.filter p a
-    | FlatMap f -> C.flat_map f a
-    | FilterMap f -> C.filter_map f a
-    | Extern f -> f a
-
-  let fusion_fold : type a b c. (a,b) base_op -> (c -> b -> c) -> c -> a -> c
-  = fun op f' -> match op with
-    | Map f -> (fun z x -> f' z (f x))
-    | Filter p -> (fun z x -> if p x then f' z x else z)
-    | FlatMap f -> (fun z x -> C.fold f' z (f x))
-    | FilterMap f -> (fun z x -> match f x with Some x' -> f' z x' | None -> z)
-    | Extern _ -> assert false
-
-  let rec apply_optimized_with_fold
-  : type a b c. (a,b) optimized_op -> (c -> b -> c) -> c -> a t -> c
-  = fun op fold z a -> match op with
-    | OptNil -> C.fold fold z a
-    | OptBase (Extern f, OptNil) ->
-        C.fold fold z (f a)
-    | OptBase (f,OptNil) ->
-        (* terminal fold *)
-        C.fold (fusion_fold f fold) z a
-    | OptBase (f,c) ->
-        (* make intermediate collection and continue *)
-        apply_optimized_with_fold c fold z (apply_base f a)
-    | OptExtern (f,c) -> apply_optimized_with_fold c fold z (f a)
-    | OptFlatMap (f,c) -> apply_optimized_with_fold c fold z (C.flat_map f a)
-
-  (* Optimize and run *)
-  let apply op a =
-    let op' = optimize op in
-    apply_optimized op' a
-
-  let apply_fold op fold z a =
-    let op' = optimize op in
-    apply_optimized_with_fold op' fold z a
-
-  let apply' a op = apply op a
-
-  (** {6 Combinators} *)
-
-  let id = Nil
-  let map f = Compose (Map f, Nil)
-  let filter p = Compose (Filter p, Nil)
-  let filter_map f = Compose (FilterMap f, Nil)
-  let flat_map f = Compose (FlatMap f, Nil)
-  let extern f = Compose (Extern f, Nil)
-
-  let compose f g = _compose g f
-  let (>>>) f g = _compose f g
-end

src/advanced/CCBatch.mli

@@ -1,80 +0,0 @@
-(*
-copyright (c) 2013-2014, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {1 Batch Operations on Collections}
-Define and combine operations on a collection of elements, then
-run the composition of those operations on some collection. The
-composition is optimized to minimize the number of intermediate
-collections *)
-
-(** {2 Definition of a Collection} *)
-module type COLLECTION = sig
-  type 'a t
-
-  val empty : 'a t
-  val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
-  val map : ('a -> 'b) -> 'a t -> 'b t
-  val filter : ('a -> bool) -> 'a t -> 'a t
-  val filter_map : ('a -> 'b option) -> 'a t -> 'b t
-  val flat_map : ('a -> 'b t) -> 'a t -> 'b t
-end
-
-(** {2 Definition of a Batch operations} *)
-module type S = sig
-  type 'a t
-
-  type ('a,'b) op
-  (** Operation that converts a ['a t] into a ['b t] *)
-
-  val apply : ('a,'b) op -> 'a t -> 'b t
-  (** Apply the operation to the collection. *)
-
-  val apply_fold : ('a, 'b) op -> ('c -> 'b -> 'c) -> 'c -> 'a t -> 'c
-  (** Apply the operation plus a fold to the collection. *)
-
-  val apply' : 'a t -> ('a,'b) op -> 'b t
-  (** Flip of {!apply} *)
-
-  (** {6 Combinators} *)
-
-  val id : ('a, 'a) op
-
-  val map : ('a -> 'b) -> ('a, 'b) op
-
-  val filter : ('a -> bool) -> ('a,'a) op
-
-  val filter_map : ('a -> 'b option) -> ('a,'b) op
-
-  val flat_map : ('a -> 'b t) -> ('a,'b) op
-
-  val extern : ('a t -> 'b t) -> ('a,'b) op
-  (** Use a specific function that won't be optimized *)
-
-  val compose : ('b,'c) op -> ('a,'b) op -> ('a,'c) op
-  val (>>>) : ('a,'b) op -> ('b,'c) op -> ('a,'c) op
-end
-
-(** {2 Functor} *)
-module Make(C : COLLECTION) : S with type 'a t = 'a C.t

src/advanced/CCCat.ml

@@ -1,144 +0,0 @@
-(*
-copyright (c) 2013-2014, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {1 Categorical Constructs} *)
-
-(** {2 Signatures} *)
-
-module type MONOID = sig
-  type t
-  val empty : t
-  val append : t -> t -> t
-end
-
-module type FUNCTOR = sig
-  type +'a t
-  val map : ('a -> 'b) -> 'a t -> 'b t
-end
-
-module type APPLICATIVE = sig
-  type +'a t
-  include FUNCTOR with type 'a t := 'a t
-  val pure : 'a -> 'a t
-  val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
-end
-
-module type MONAD_BARE = sig
-  type +'a t
-  val return : 'a -> 'a t
-  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-end
-
-module type MONAD = sig
-  include MONAD_BARE
-  include APPLICATIVE with type 'a t := 'a t
-end
-
-module type MONAD_TRANSFORMER = sig
-  include MONAD
-  module M : MONAD
-  val lift : 'a M.t -> 'a t
-end
-
-type 'a sequence = ('a -> unit) -> unit
-
-module type FOLDABLE = sig
-  type 'a t
-  val to_seq : 'a t -> 'a sequence
-end
-
-module type TRAVERSE = functor(M : MONAD) -> sig
-  type +'a t
-
-  val sequence_m : 'a M.t t -> 'a t M.t
-
-  val fold_m : ('b -> 'a -> 'b M.t) -> 'b -> 'a t -> 'b M.t
-
-  val map_m : ('a -> 'b M.t) -> 'a t -> 'b t M.t
-end
-
-module type FREE_MONAD = sig
-  module F : FUNCTOR
-
-  type +'a t =
-    | Return of 'a
-    | Roll of 'a t F.t
-
-  include MONAD with type 'a t := 'a t
-  val inj : 'a F.t -> 'a t
-end
-
-(** {2 Some Implementations} *)
-
-module WrapMonad(M : MONAD_BARE) = struct
-  include M
-
-  let map f x = x >>= (fun x -> return (f x))
-
-  let pure = return
-
-  let (<*>) f x = f >>= fun f -> x >>= fun x -> return (f x)
-end
-
-
-module MakeFree(F : FUNCTOR) = struct
-  module F = F
-
-  type 'a t =  Return of 'a | Roll of ('a t F.t)
-
-  let return x = Return x
-  let pure = return
-
-  let rec map : type a b. (a -> b) -> a t -> b t
-    = fun f x -> match x with
-    | Return x -> Return (f x)
-    | Roll xs -> Roll (F.map (map f) xs)
-
-  let rec _bind : type a b. (a -> b t) -> a t -> b t
-    = fun f x -> match x with
-    | Return x -> f x
-    | Roll y -> Roll (F.map (_bind f) y)
-
-  let (>>=) x f = _bind f x
-
-  let rec _app : type a b. (a -> b) t -> a t -> b t
-    = fun f x -> match f, x with
-    | Return f, Return x -> Return (f x)
-    | Return f, Roll xs -> Roll (F.map (map f) xs)
-    | Roll fs, _ -> Roll (F.map (fun f -> _app f x) fs)
-
-  let (<*>) = _app
-
-  let inj x = Roll (F.map return x)
-end
-
-module MakeFreeFold(FM : FREE_MONAD)(Fold : FOLDABLE with type 'a t = 'a FM.F.t) = struct
-  type 'a t = 'a FM.t
-
-  let rec to_seq : type a. a FM.t -> a sequence
-    = fun x k -> match x with
-    | FM.Return x -> k x
-    | FM.Roll xs -> Fold.to_seq xs (fun x -> to_seq x k)
-end

src/advanced/CCCat.mli

@@ -1,113 +0,0 @@
-(*
-copyright (c) 2013-2014, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {1 Categorical Constructs}
-
-Attempt to copy some structures from Haskell and the likes. Disclaimer:
-I don't know much about category theory, only about type signatures ;). *)
-
-(** {2 Signatures} *)
-
-module type MONOID = sig
-  type t
-  val empty : t
-  val append : t -> t -> t
-end
-
-module type FUNCTOR = sig
-  type +'a t
-  val map : ('a -> 'b) -> 'a t -> 'b t
-end
-
-module type APPLICATIVE = sig
-  type +'a t
-  include FUNCTOR with type 'a t := 'a t
-  val pure : 'a -> 'a t
-  val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
-end
-
-module type MONAD_BARE = sig
-  type +'a t
-  val return : 'a -> 'a t
-  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-end
-
-module type MONAD = sig
-  include MONAD_BARE
-  include APPLICATIVE with type 'a t := 'a t
-end
-
-module type MONAD_TRANSFORMER = sig
-  include MONAD
-  module M : MONAD
-  val lift : 'a M.t -> 'a t
-end
-
-(** Cheating: use an equivalent of "to List" with a sequence *)
-type 'a sequence = ('a -> unit) -> unit
-
-module type FOLDABLE = sig
-  type 'a t
-  val to_seq : 'a t -> 'a sequence
-end
-
-module type TRAVERSE = functor(M : MONAD) -> sig
-  type +'a t
-
-  val sequence_m : 'a M.t t -> 'a t M.t
-
-  val fold_m : ('b -> 'a -> 'b M.t) -> 'b -> 'a t -> 'b M.t
-
-  val map_m : ('a -> 'b M.t) -> 'a t -> 'b t M.t
-end
-
-(** The free monad is built by nesting applications of a functor [F].
-
-For instance, Lisp-like nested lists can be built and dealt with like this:
-{[
-  module Lisp = CCCat.FreeMonad(CCList);;
-
-  let l = Lisp.(inj [1;2;3]  >>= fun x -> inj [x; x*2; x+100]);;
-]} *)
-module type FREE_MONAD = sig
-  module F : FUNCTOR
-
-  type +'a t =
-    | Return of 'a
-    | Roll of 'a t F.t
-
-  include MONAD with type 'a t := 'a t
-  val inj : 'a F.t -> 'a t
-end
-
-(** {2 Some Implementations} *)
-
-(** Implement the applicative and functor modules from only return and bind *)
-module WrapMonad(M : MONAD_BARE) : MONAD with type 'a t = 'a M.t
-
-module MakeFree(F : FUNCTOR) : FREE_MONAD with module F = F
-
-module MakeFreeFold(FM : FREE_MONAD)(Fold : FOLDABLE with type 'a t = 'a FM.F.t)
-  : FOLDABLE with type 'a t = 'a FM.t

src/advanced/CCLinq.ml

@@ -1,888 +0,0 @@
-(*
-copyright (c) 2013-2014, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {1 LINQ-like operations on collections} *)
-
-type 'a sequence = ('a -> unit) -> unit
-type 'a equal = 'a -> 'a -> bool
-type 'a ord = 'a -> 'a -> int
-type 'a hash = 'a -> int
-type 'a with_err = [`Ok of 'a | `Error of string ]
-
-let _id x = x
-
-exception ExitWithError of string
-let _exit_with_error s = raise (ExitWithError s)
-let _error_of_exn f = try `Ok (f ()) with ExitWithError s -> `Error s
-
-module PMap = struct
-  type ('a, 'b) t = {
-    is_empty : unit -> bool;
-    size : unit -> int; (* Number of keys *)
-    get : 'a -> 'b option;
-    fold : 'c. ('c -> 'a -> 'b -> 'c) -> 'c -> 'c;
-    to_seq : ('a * 'b) sequence;
-  }
-
-  let get m x = m.get x
-  let mem m x = match m.get x with
-    | None -> false
-    | Some _ -> true
-  let to_seq m = m.to_seq
-  let fold f acc m = m.fold f acc
-  let size m = m.size ()
-
-  type ('a, 'b) build = {
-    mutable cur : ('a, 'b) t;
-    add : 'a -> 'b -> unit;
-    update : 'a -> ('b option -> 'b option) -> unit;
-  }
-
-  let build_get b = b.cur
-  let add b x y = b.add x y
-  let update b f = b.update f
-
-  (* careful to use this map linearly *)
-  let make_hash (type key) ?(eq=(=)) ?(hash=Hashtbl.hash) () =
-    let module H = Hashtbl.Make(struct
-      type t = key
-      let equal = eq
-      let hash = hash
-    end) in
-    (* build table *)
-    let tbl = H.create 32 in
-    let cur = {
-      is_empty = (fun () -> H.length tbl = 0);
-      size = (fun () -> H.length tbl);
-      get = (fun k ->
-        try Some (H.find tbl k)
-        with Not_found -> None);
-      fold = (fun f acc -> H.fold (fun k v acc -> f acc k v) tbl acc);
-      to_seq = (fun k -> H.iter (fun key v -> k (key,v)) tbl);
-    } in
-    { cur;
-      add = (fun k v -> H.replace tbl k v);
-      update = (fun k f ->
-        match (try f (Some (H.find tbl k)) with Not_found -> f None) with
-        | None -> H.remove tbl k
-        | Some v' -> H.replace tbl k v');
-    }
-
-  let make_cmp (type key) ?(cmp=Pervasives.compare) () =
-    let module M = Sequence.Map.Make(struct
-      type t = key
-      let compare = cmp
-    end) in
-    let map = ref M.empty in
-    let cur = {
-      is_empty = (fun () -> M.is_empty !map);
-      size = (fun () -> M.cardinal !map);
-      get = (fun k ->
-        try Some (M.find k !map)
-        with Not_found -> None);
-      fold = (fun f acc ->
-        M.fold
-          (fun key set acc -> f acc key set) !map acc
-      );
-      to_seq = (fun k -> M.to_seq !map k);
-    } in
-    {
-      cur;
-      add = (fun k v -> map := M.add k v !map);
-      update = (fun k f ->
-        match (try f (Some (M.find k !map)) with Not_found -> f None) with
-        | None -> map := M.remove k !map
-        | Some v' -> map := M.add k v' !map);
-    }
-
-  type 'a build_method =
-    | FromCmp of 'a ord
-    | FromHash of 'a equal * 'a hash
-    | Default
-
-  let make ?(build=Default) () = match build with
-    | Default -> make_hash ()
-    | FromCmp cmp -> make_cmp ~cmp ()
-    | FromHash (eq,hash) -> make_hash ~eq ~hash ()
-
-  (* choose a build method from the optional arguments *)
-  let _make_build ?cmp ?eq ?hash () =
-    let _maybe default o = match o with
-      | Some x -> x
-      | None -> default
-    in
-    match eq, hash with
-    | Some _, _
-    | _, Some _ ->
-        FromHash ( _maybe (=) eq, _maybe Hashtbl.hash hash)
-    | _ ->
-        match cmp with
-        | Some f -> FromCmp f
-        | _ -> Default
-
-  let multimap_of_seq ?(build=make ()) seq =
-    seq (fun (k,v) ->
-      build.update k (function
-        | None -> Some [v]
-        | Some l -> Some (v::l)));
-    build.cur
-
-  let count_of_seq ?(build=make ()) seq =
-    seq (fun x ->
-      build.update x
-        (function
-            | None -> Some 1
-            | Some n -> Some (n+1)));
-    build.cur
-
-  (* map values *)
-  let map f m = {
-    is_empty = m.is_empty;
-    size = m.size;
-    get = (fun k -> match m.get k with
-      | None -> None
-      | Some v -> Some (f v)
-    );
-    to_seq = Sequence.map (fun (x,y) -> x, f y) m.to_seq;
-    fold = (fun f' acc ->
-      m.fold (fun acc x y -> f' acc x (f y)) acc
-    );
-  }
-
-  let to_list m = Sequence.to_rev_list m.to_seq
-
-  let reverse_ ~build m =
-    let build = make ~build () in
-    let seq = Sequence.map (fun (x,y) -> y,x) (to_seq m) in
-    multimap_of_seq ~build seq
-
-  let reverse_multimap_ ~build m =
-    let build = make ~build () in
-    let seq = to_seq m in
-    let seq = Sequence.flat_map
-        (fun (x,l) -> Sequence.map (fun y -> y,x) (Sequence.of_list l)
-        ) seq
-    in
-    multimap_of_seq ~build seq
-
-  let reverse ?cmp ?eq ?hash () m =
-    let build = _make_build ?cmp ?eq ?hash () in
-    reverse_ ~build m
-
-  let reverse_multimap  ?cmp ?eq ?hash () m =
-    let build = _make_build ?cmp ?eq ?hash () in
-    reverse_multimap_ ~build m
-
-  let fold_multimap f acc m =
-    m.fold (fun acc x l -> List.fold_left (fun acc y -> f acc x y) acc l) acc
-
-  let get_seq key m = match get m key with
-    | None -> Sequence.empty
-    | Some x -> Sequence.return x
-
-  let iter m = m.to_seq
-
-  let flatten m =
-    let seq = Sequence.flat_map
-      (fun (k,v) -> Sequence.map (fun v' -> k,v') v)
-       m.to_seq
-    in
-    seq
-
-  let flatten_l m =
-    let seq = Sequence.flatMap
-        (fun (k,v) -> Sequence.map (fun v' -> k,v') (Sequence.of_list v))
-        m.to_seq
-    in
-    seq
-end
-
-type 'a search_result =
-  | SearchContinue
-  | SearchStop of 'a
-
-type ('a,'b,'key,'c) join_descr = {
-  join_key1 : 'a -> 'key;
-  join_key2 : 'b -> 'key;
-  join_merge : 'key -> 'a -> 'b -> 'c option;
-  join_build : 'key PMap.build_method;
-}
-
-type ('a,'b) group_join_descr = {
-  gjoin_proj : 'b -> 'a;
-  gjoin_build : 'a PMap.build_method;
-}
-
-module ImplemSetOps = struct
-  let choose s = Sequence.take 1 s
-
-  let distinct ~cmp s = Sequence.sort_uniq ~cmp s
-
-  let search obj s =
-    match
-      Sequence.find
-        (fun x -> match obj#check x with
-          | SearchContinue -> None
-          | SearchStop y -> Some y
-        ) s
-    with None -> obj#failure
-       | Some x -> x
-
-  let do_join ~join c1 c2 =
-    let build1 =
-      let seq = Sequence.map (fun x -> join.join_key1 x, x) c1 in
-      PMap.multimap_of_seq ~build:(PMap.make ~build:join.join_build ()) seq
-    in
-    let l = Sequence.fold
-      (fun acc y ->
-        let key = join.join_key2 y in
-        match PMap.get build1 key with
-        | None -> acc
-        | Some l1 ->
-            List.fold_left
-              (fun acc x -> match join.join_merge key x y with
-                | None -> acc
-                | Some res -> res::acc
-              ) acc l1
-      ) [] c2
-    in
-    Sequence.of_list l
-
-  let do_group_join ~gjoin c1 c2 =
-    let build = PMap.make ~build:gjoin.gjoin_build () in
-    c1 (fun x -> PMap.add build x []);
-    c2
-      (fun y ->
-        (* project [y] into some element of [c1] *)
-        let x = gjoin.gjoin_proj y in
-        PMap.update build x
-          (function
-            | None -> None   (* [x] not present, ignore! *)
-            | Some l -> Some (y::l)
-          )
-      );
-    PMap.build_get build
-
-  let do_union ~build c1 c2 =
-    let build = PMap.make ~build () in
-    c1 (fun x -> PMap.add build x ());
-    c2 (fun x -> PMap.add build x ());
-    let seq = PMap.to_seq (PMap.build_get build) in
-    Sequence.map fst seq
-
-  type inter_status =
-    | InterLeft
-    | InterDone  (* already output *)
-
-  let do_inter ~build c1 c2 =
-    let build = PMap.make ~build () in
-    let l = ref [] in
-    c1 (fun x -> PMap.add build x InterLeft);
-    c2 (fun x ->
-      PMap.update build x
-        (function
-           | None -> Some InterDone
-           | Some InterDone as foo -> foo
-           | Some InterLeft ->
-               l := x :: !l;
-               Some InterDone
-        )
-    );
-    Sequence.of_list !l
-
-  let do_diff ~build c1 c2 =
-    let build = PMap.make ~build () in
-    c2 (fun x -> PMap.add build x ());
-    let map = PMap.build_get build in
-    (* output elements of [c1] not in [map] *)
-    Sequence.filter (fun x -> not (PMap.mem map x)) c1
-end
-
-(** {2 Query operators} *)
-
-type (_, _) unary =
-  | Map : ('a -> 'b) -> ('a, 'b ) unary
-  | Filter : ('a -> bool) -> ('a, 'a ) unary
-  | Fold : ('b -> 'a -> 'b) * 'b -> ('a, 'b) unary
-  | Reduce : ('a -> 'b) * ('a -> 'b -> 'b) * ('b -> 'c)
-    -> ('a, 'c) unary
-  | Size : ('a, int) unary
-  | Choose : ('a, 'a) unary
-  | FilterMap : ('a -> 'b option) -> ('a, 'b) unary
-  | FlatMap : ('a -> 'b sequence) -> ('a, 'b) unary
-  | Take : int -> ('a, 'a) unary
-  | TakeWhile : ('a -> bool) -> ('a, 'a) unary
-  | Sort : 'a ord -> ('a, 'a) unary
-  | Distinct : 'a ord -> ('a, 'a) unary
-  | Search :
-    < check: ('a -> 'b search_result);
-      failure : 'b;
-    > -> ('a, 'b) unary
-  | Contains : 'a equal * 'a -> ('a, bool) unary
-  | GroupBy : 'b PMap.build_method * ('a -> 'b)
-    -> ('a, ('b,'a list) PMap.t) unary
-  | Count : 'a PMap.build_method -> ('a, ('a, int) PMap.t) unary
-  | Lazy : ('a lazy_t, 'a) unary
-
-type set_op =
-  | Union
-  | Inter
-  | Diff
-
-type (_, _, _) binary =
-  | App : ('a -> 'b, 'a, 'b) binary
-  | Join : ('a, 'b, 'key, 'c) join_descr
-    -> ('a, 'b, 'c) binary
-  | GroupJoin : ('a, 'b) group_join_descr
-    -> ('a, 'b, ('a, 'b list) PMap.t) binary
-  | Product : ('a, 'b, ('a*'b)) binary
-  | Append : ('a, 'a, 'a) binary
-  | SetOp : set_op * 'a PMap.build_method
-    -> ('a, 'a, 'a) binary
-
-(* type of queries that return a 'a *)
-and 'a t =
-  | Return : 'a -> 'a t
-  | OfSeq : 'a sequence -> 'a t
-  | Unary : ('a, 'b) unary * 'a t -> 'b t
-  | Binary : ('a, 'b, 'c) binary * 'a t * 'b t -> 'c t
-  | Bind : ('a -> 'b t) * 'a t -> 'b t
-  | Reflect : 'a t -> 'a sequence t
-
-let start x = Return x
-
-let of_list l =
-  OfSeq (Sequence.of_list l)
-
-let of_array a =
-  OfSeq (Sequence.of_array a)
-
-let of_array_i a =
-  OfSeq (Sequence.of_array_i a)
-
-let of_hashtbl h =
-  OfSeq (Sequence.of_hashtbl h)
-
-let range i j = OfSeq (Sequence.int_range ~start:i ~stop:j)
-
-let (--) = range
-
-let of_seq seq =
-  OfSeq seq
-
-let of_queue q =
-  OfSeq (Sequence.of_queue q)
-
-let of_stack s =
-  OfSeq (Sequence.of_stack s)
-
-let of_string s =
-  OfSeq (Sequence.of_str s)
-
-(** {6 Execution} *)
-
-let rec _optimize : type a. a t -> a t
-  = fun q -> match q with
-    | Return _ -> q
-    | Unary (u, q) ->
-        _optimize_unary u (_optimize q)
-    | Binary (b, q1, q2) ->
-        _optimize_binary b (_optimize q1) (_optimize q2)
-    | Reflect q -> Reflect (_optimize q)
-    | OfSeq _ -> q
-    | Bind (f,q) -> Bind(f, _optimize q)  (* cannot optimize [f] before execution *)
-and _optimize_unary : type a b. (a,b) unary -> a t -> b t
-  = fun u q -> match u, q with
-    | Size, Unary (Choose, _) -> Return 1
-    | Map f, Unary (Map g, q') ->
-        _optimize_unary (Map (fun x -> f (g x))) q'
-    | Filter p, Unary (Map f, cont) ->
-        _optimize_unary
-          (FilterMap (fun x -> let y = f x in if p y then Some y else None))
-          cont
-    | Filter p, Unary (Filter p', q) ->
-        _optimize_unary (Filter (fun x -> p x && p' x)) q
-    | FilterMap f, Unary (Map g, q') ->
-        _optimize_unary (FilterMap (fun x -> f (g x))) q'
-    | Map f, Unary (Filter p, cont) ->
-        _optimize_unary
-          (FilterMap (fun x -> if p x then Some (f x) else None))
-          cont
-    | Map _, Binary (Append, q1, q2) ->
-        _optimize_binary Append (Unary (u, q1)) (Unary (u, q2))
-    | Filter _, Binary (Append, q1, q2) ->
-        _optimize_binary Append (Unary (u, q1)) (Unary (u, q2))
-    | Fold (f,acc), Unary (Map f', cont) ->
-        _optimize_unary
-          (Fold ((fun acc x -> f acc (f' x)), acc))
-          cont
-    | Reduce (start, mix, stop), Unary (Map f, cont) ->
-        _optimize_unary
-          (Reduce (
-            (fun x -> start (f x)),
-            (fun x acc -> mix (f x) acc),
-            stop))
-          cont
-    | Size, Unary (Map _, cont) ->
-        _optimize_unary Size cont  (* ignore the map! *)
-    | Size, Unary (Sort _, cont) ->
-        _optimize_unary Size cont
-    | _ -> Unary (u, _optimize q)
-    (* TODO: other cases *)
-and _optimize_binary : type a b c. (a,b,c) binary -> a t -> b t -> c t
-  = fun b q1 q2 -> match b, q1, q2 with
-    | App, Return f, Return x -> Return (f x)
-    | App, Return f, x -> _optimize_unary (Map f) x
-    | App, f, Return x -> _optimize_unary (Map (fun f -> f x)) f
-    | App, _, _ -> Binary (b, _optimize q1, _optimize q2)
-    | Join _, _, _ -> Binary (b, _optimize q1, _optimize q2)
-    | GroupJoin _, _, _ -> Binary (b, _optimize q1, _optimize q2)
-    | Product, _, _ -> Binary (b, _optimize q1, _optimize q2)
-    | Append, _, _ -> Binary (b, _optimize q1, _optimize q2)
-    | SetOp _, _, _ -> Binary (b, _optimize q1, _optimize q2)
-
-(* apply a unary operator on a collection *)
-let _do_unary : type a b. (a,b) unary -> a sequence -> b sequence
-= fun u c -> match u with
-  | Map f -> Sequence.map f c
-  | Filter p -> Sequence.filter p c
-  | Fold (f, acc) -> Sequence.return (Sequence.fold f acc c)
-  | Reduce (start, mix, stop) ->
-      let acc = Sequence.fold
-        (fun acc x -> match acc with
-          | None -> Some (start x)
-          | Some acc -> Some (mix x acc)
-        ) None c
-      in
-      begin match acc with
-        | None -> Sequence.empty
-        | Some x -> Sequence.return (stop x)
-      end
-  | Size -> Sequence.return (Sequence.length c)
-  | Choose -> ImplemSetOps.choose c
-  | FilterMap f -> Sequence.filter_map f c
-  | FlatMap f -> Sequence.flat_map f c
-  | Take n -> Sequence.take n c
-  | TakeWhile p -> Sequence.take_while p c
-  | Sort cmp -> Sequence.sort ~cmp c
-  | Distinct cmp -> ImplemSetOps.distinct ~cmp c
-  | Search obj -> Sequence.return (ImplemSetOps.search obj c)
-  | GroupBy (build,f) ->
-      let seq = Sequence.map (fun x -> f x, x) c in
-      Sequence.return (PMap.multimap_of_seq ~build:(PMap.make ~build ()) seq)
-  | Contains (eq, x) -> Sequence.return (Sequence.mem ~eq x c)
-  | Count build ->
-      Sequence.return (PMap.count_of_seq ~build:(PMap.make ~build ()) c)
-  | Lazy -> Sequence.map Lazy.force c
-
-let _do_binary : type a b c. (a, b, c) binary -> a sequence -> b sequence -> c sequence
-= fun b c1 c2 -> match b with
-  | Join join -> ImplemSetOps.do_join ~join c1 c2
-  | GroupJoin gjoin -> Sequence.return (ImplemSetOps.do_group_join ~gjoin c1 c2)
-  | Product -> Sequence.product c1 c2
-  | Append -> Sequence.append c1 c2
-  | App -> Sequence.(c1 <*> c2)
-  | SetOp (Inter,build) -> ImplemSetOps.do_inter ~build c1 c2
-  | SetOp (Union,build) -> ImplemSetOps.do_union ~build c1 c2
-  | SetOp (Diff,build) -> ImplemSetOps.do_diff ~build c1 c2
-
-let rec _run : type a. opt:bool -> a t -> a sequence
-= fun ~opt q -> match q with
-  | Return c -> Sequence.return c
-  | Unary (u, q') -> _do_unary u (_run ~opt q')
-  | Binary (b, q1, q2) -> _do_binary b (_run ~opt q1) (_run ~opt q2)
-  | OfSeq s -> s
-  | Bind (f, q') ->
-      let seq = _run ~opt q' in
-      Sequence.flat_map
-        (fun x ->
-          let q'' = f x in
-          let q'' = if opt then _optimize q'' else q'' in
-          _run ~opt q''
-        ) seq
-  | Reflect q ->
-    let seq = Sequence.persistent_lazy (_run ~opt q) in
-    Sequence.return seq
-
-let _apply_limit ?limit seq = match limit with
-    | None -> seq
-    | Some l -> Sequence.take l seq
-
-(* safe execution *)
-let run ?limit q =
-  let seq = _run ~opt:true (_optimize q) in
-  _apply_limit ?limit seq
-
-let run_no_optim ?limit q =
-  let seq = _run ~opt:false q in
-  _apply_limit ?limit seq
-
-let run1 q =
-  let seq = _run ~opt:true (_optimize q) in
-  match Sequence.head seq with
-  | Some x -> x
-  | None -> raise Not_found
-
-(** {6 Basics} *)
-
-let empty = OfSeq Sequence.empty
-
-let map f q = Unary (Map f, q)
-
-let (>|=) q f = Unary (Map f, q)
-
-let filter p q = Unary (Filter p, q)
-
-let choose q = Unary (Choose, q)
-
-let filter_map f q = Unary (FilterMap f, q)
-
-let flat_map f q = Unary (FlatMap f, q)
-
-let flat_map_l f q =
-  let f' x = Sequence.of_list (f x) in
-  Unary (FlatMap f', q)
-
-let flatten_seq q = Unary (FlatMap (fun x->x), q)
-
-let flatten q = Unary (FlatMap Sequence.of_list, q)
-
-let take n q = Unary (Take n, q)
-
-let take_while p q = Unary (TakeWhile p, q)
-
-let sort ?(cmp=Pervasives.compare) () q = Unary (Sort cmp, q)
-
-let distinct ?(cmp=Pervasives.compare) () q =
-  Unary (Distinct cmp, q)
-
-let group_by ?cmp ?eq ?hash f q =
-  Unary (GroupBy (PMap._make_build ?cmp ?eq ?hash (),f), q)
-
-let group_by' ?cmp ?eq ?hash f q =
-  flat_map PMap.iter (group_by ?cmp ?eq ?hash f q)
-
-let count ?cmp ?eq ?hash () q =
-  Unary (Count (PMap._make_build ?cmp ?eq ?hash ()), q)
-
-let count' ?cmp () q =
-  flat_map PMap.iter (count ?cmp () q)
-
-let fold f acc q =
-  Unary (Fold (f, acc), q)
-
-let size q = Unary (Size, q)
-
-let sum q = Unary (Fold ((+), 0), q)
-
-let reduce start mix stop q =
-  Unary (Reduce (start,mix,stop), q)
-
-let _avg_start x = (x,1)
-let _avg_mix x (y,n) = (x+y,n+1)
-let _avg_stop (x,n) = x/n
-
-let _lift_some f x y = match y with
-  | None -> Some x
-  | Some y -> Some (f x y)
-
-let max q = Unary (Reduce (_id, Pervasives.max, _id), q)
-let min q = Unary (Reduce (_id, Pervasives.min, _id), q)
-let average q = Unary (Reduce (_avg_start, _avg_mix, _avg_stop), q)
-
-let is_empty q =
-  Unary (Search (object
-    method check _ = SearchStop false (* stop in case there is an element *)
-    method failure = true
-  end), q)
-
-let contains ?(eq=(=)) x q =
-  Unary (Contains (eq, x), q)
-
-let for_all p q =
-  Unary (Search (object
-    method check x = if p x then SearchContinue else SearchStop false
-    method failure = true
-  end), q)
-
-let exists p q =
-  Unary (Search (object
-    method check x = if p x then SearchStop true else SearchContinue
-    method failure = false
-  end), q)
-
-let find p q =
-  Unary (Search (object
-    method check x = if p x then SearchStop (Some x) else SearchContinue
-    method failure = None
-  end), q)
-
-let find_map f q =
-  Unary (Search (object
-    method check x = match f x with
-      | Some y -> SearchStop (Some y)
-      | None -> SearchContinue
-    method failure = None
-  end), q)
-
-(** {6 Binary Operators} *)
-
-let join ?cmp ?eq ?hash join_key1 join_key2 ~merge q1 q2 =
-  let join_build = PMap._make_build ?eq ?hash ?cmp () in
-  let j = {
-    join_key1;
-    join_key2;
-    join_merge=merge;
-    join_build;
-  } in
-  Binary (Join j, q1, q2)
-
-let group_join ?cmp ?eq ?hash gjoin_proj q1 q2 =
-  let gjoin_build = PMap._make_build ?eq ?hash ?cmp () in
-  let j = {
-    gjoin_proj;
-    gjoin_build;
-  } in
-  Binary (GroupJoin j, q1, q2)
-
-let product q1 q2 = Binary (Product, q1, q2)
-
-let append q1 q2 = Binary (Append, q1, q2)
-
-let inter ?cmp ?eq ?hash () q1 q2 =
-  let build = PMap._make_build ?cmp ?eq ?hash () in
-  Binary (SetOp (Inter, build), q1, q2)
-
-let union ?cmp ?eq ?hash () q1 q2 =
-  let build = PMap._make_build ?cmp ?eq ?hash () in
-  Binary (SetOp (Union, build), q1, q2)
-
-let diff ?cmp ?eq ?hash () q1 q2 =
-  let build = PMap._make_build ?cmp ?eq ?hash () in
-  Binary (SetOp (Diff, build), q1, q2)
-
-let fst q = map fst q
-let snd q = map snd q
-
-let map1 f q = map (fun (x,y) -> f x, y) q
-let map2 f q = map (fun (x,y) -> x, f y) q
-
-let flatten_opt q = filter_map _id q
-
-let opt_unwrap q =
-  Unary
-    (Map
-       (function
-         | Some x -> x
-         | None -> _exit_with_error "opt_unwrap"),
-     q
-    )
-
-(** {6 Applicative} *)
-
-let pure x = Return x
-
-let app f x = Binary (App, f, x)
-
-let (<*>) = app
-
-(** {6 Monadic stuff} *)
-
-let return x = Return x
-
-let bind f q = Bind (f,q)
-
-let (>>=) x f = Bind (f, x)
-
-(** {6 Misc} *)
-
-let lazy_ q = Unary (Lazy, q)
-
-let reflect q = Reflect q
-
-(** {6 Infix} *)
-
-module Infix = struct
-  let (>>=) = (>>=)
-  let (>|=) = (>|=)
-  let (<*>) = (<*>)
-  let (--) = (--)
-end
-
-(** {6 Adapters} *)
-
-let to_seq q = reflect q
-
-let to_hashtbl q =
-  Unary (Map (fun c -> Sequence.to_hashtbl c), Reflect q)
-
-let to_queue q =
-  Unary (Map (fun c -> let q = Queue.create() in Sequence.to_queue q c; q), Reflect q)
-
-let to_stack q =
-  Unary (Map (fun c -> let s = Stack.create () in Sequence.to_stack s c; s), Reflect q)
-
-module List = struct
-  let of_list l = OfSeq (Sequence.of_list l)
-  let to_list q = map Sequence.to_list (Reflect q)
-  let run q = run1 (to_list q)
-end
-
-module Array = struct
-  let of_array a = OfSeq (Sequence.of_array a)
-  let to_array q =
-    map (fun s -> Array.of_list (Sequence.to_list s)) (Reflect q)
-  let run q = run1 (to_array q)
-end
-
-module AdaptSet(S : Set.S) = struct
-  let of_set set = OfSeq (fun k -> S.iter k set)
-
-  let to_set q =
-    let f c = Sequence.fold (fun set x -> S.add x set) S.empty c in
-    map f (reflect q)
-
-  let run q = run1 (to_set q)
-end
-
-module AdaptMap(M : Map.S) = struct
-  let _to_seq m k = M.iter (fun x y -> k (x,y)) m
-
-  let of_map map = OfSeq (_to_seq map)
-
-  let to_pmap m = {
-    PMap.get = (fun x -> try Some (M.find x m) with Not_found -> None);
-    PMap.size = (fun () -> M.cardinal m);
-    PMap.is_empty = (fun () -> M.is_empty m);
-    PMap.fold = (fun f acc -> M.fold (fun x y acc -> f acc x y) m acc);
-    PMap.to_seq = _to_seq m;
-  }
-
-  let to_map q =
-    let f c =
-      Sequence.fold (fun m (x,y) -> M.add x y m) M.empty c
-    in
-    map f (reflect q)
-
-  let run q = run1 (to_map q)
-end
-
-module IO = struct
-  let _slurp with_input =
-    let l = lazy (with_input (fun ic -> CCIO.read_all ic)) in
-    lazy_ (return l)
-
-  let slurp ic = _slurp (fun f -> f ic)
-
-  let _with_file_in filename f =
-    try
-      let ic = open_in filename in
-      try
-        let x = f ic in
-        close_in ic;
-        x
-      with e ->
-        close_in ic;
-        _exit_with_error (Printexc.to_string e)
-    with e ->
-      _exit_with_error (Printexc.to_string e)
-
-  let _with_file_out filename f =
-    try
-      let oc = open_out filename in
-      try
-        let x = f oc in
-        close_out oc;
-        x
-      with e ->
-        close_out oc;
-        _exit_with_error (Printexc.to_string e)
-    with e ->
-      _exit_with_error (Printexc.to_string e)
-
-  let slurp_file filename = _slurp (_with_file_in filename)
-
-  (* find [c] in [s], starting at offset [i] *)
-  let rec _find s c i =
-    if i >= String.length s then None
-    else if s.[i] = c then Some i
-    else _find s c (i+1)
-
-  let rec _lines s i k = match _find s '\n' i with
-    | None ->
-      if i<String.length s then k (String.sub s i (String.length s-i))
-    | Some j ->
-        let s' = String.sub s i (j-i) in
-        k s';
-        _lines s (j+1) k
-
-  let lines q =
-    (* sequence of lines *)
-    let f s = _lines s 0 in
-    flat_map f q
-
-  let lines' q =
-    let f s = lazy (Sequence.to_list (_lines s 0)) in
-    lazy_ (map f q)
-
-  let _join ~sep ?(stop="") seq =
-    let buf = Buffer.create 128 in
-    Sequence.iteri
-      (fun i x ->
-        if i>0 then Buffer.add_string buf sep;
-        Buffer.add_string buf x)
-      seq;
-    Buffer.add_string buf stop;
-    Buffer.contents buf
-
-  let unlines q =
-    let f l = lazy (_join ~sep:"\n" ~stop:"\n" l) in
-    lazy_ (map f (reflect q))
-
-  let join sep q =
-    let f l = lazy (_join ~sep l) in
-    lazy_ (map f (reflect q))
-
-  let out oc q =
-    output_string oc (run1 q)
-
-  let out_lines oc q =
-    let x = run q in
-    Sequence.iter (fun l -> output_string oc l; output_char oc '\n') x
-
-  let to_file_exn filename q =
-    _with_file_out filename (fun oc -> out oc q)
-
-  let to_file filename q =
-    try `Ok (_with_file_out filename (fun oc  -> out oc q))
-    with Failure s -> `Error s
-
-  let to_file_lines_exn filename q =
-    _with_file_out filename (fun oc -> out_lines oc q)
-
-  let to_file_lines filename q =
-    try `Ok (_with_file_out filename (fun oc  -> out_lines oc q))
-    with Failure s -> `Error s
-end

src/advanced/CCLinq.mli

@@ -1,424 +0,0 @@
-(*
-copyright (c) 2013-2014, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {1 LINQ-like operations on collections}
-
-The purpose is to provide powerful combinators to express iteration,
-transformation and combination of collections of items. This module depends
-on several other modules, including {!CCList} and {!CCSequence}.
-
-Functions and operations are assumed to be referentially transparent, i.e.
-they should not rely on external side effects, they should not rely on
-the order of execution.
-
-@deprecated use {{: https://github.com/c-cube/olinq} OLinq}
-
-{[
-
-CCLinq.(
-  of_list [1;2;3]
-  |> flat_map (fun x -> Sequence.(x -- (x+10)))
-  |> sort ()
-  |> count ()
-  |> flat_map PMap.to_seq
-  |> List.run
-);;
-- : (int * int) list = [(13, 1); (12, 2); (11, 3); (10, 3); (9, 3);
-    (8, 3); (7, 3); (6, 3); (5, 3); (4, 3); (3, 3); (2, 2); (1, 1)]
-
-
-CCLinq.(
-  IO.slurp_file "/tmp/foo"
-  |> IO.lines
-  |> sort ()
-  |> IO.to_file_lines "/tmp/bar"
-);;
-- :  `Ok ()
-]}
-
-{b DEPRECATED, use "OLinq" (standalone library) instead}
-
-{b status: deprecated}
-
-*)
-
-type 'a sequence = ('a -> unit) -> unit
-type 'a equal = 'a -> 'a -> bool
-type 'a ord = 'a -> 'a -> int
-type 'a hash = 'a -> int
-type 'a with_err = [`Ok of 'a | `Error of string ]
-
-(** {2 Polymorphic Maps} *)
-module PMap : sig
-  type ('a, 'b) t
-
-  val get : ('a,'b) t -> 'a -> 'b option
-
-  val size : (_,_) t -> int
-
-  val to_seq : ('a, 'b) t -> ('a * 'b) sequence
-
-  val map : ('b -> 'c) -> ('a, 'b) t -> ('a, 'c) t
-  (** Transform values *)
-
-  val to_list : ('a,'b) t -> ('a*'b) list
-
-  val reverse : ?cmp:'b ord -> ?eq:'b equal -> ?hash:'b hash -> unit ->
-                ('a,'b) t -> ('b,'a list) t
-  (** Reverse relation of the map, as a multimap *)
-
-  val reverse_multimap : ?cmp:'b ord -> ?eq:'b equal -> ?hash:'b hash -> unit ->
-                          ('a,'b list) t -> ('b,'a list) t
-  (** Reverse relation of the multimap *)
-
-  val fold : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> ('a,'b) t -> 'acc
-  (** Fold on the items of the map *)
-
-  val fold_multimap : ('acc -> 'a -> 'b -> 'acc) -> 'acc ->
-                      ('a,'b list) t -> 'acc
-  (** Fold on the items of the multimap *)
-
-  val get_seq : 'a -> ('a, 'b) t -> 'b sequence
-  (** Select a key from a map and wrap into sequence *)
-
-  val iter : ('a,'b) t -> ('a*'b) sequence
-  (** View a multimap as a proper collection *)
-
-  val flatten : ('a,'b sequence) t -> ('a*'b) sequence
-  (** View a multimap as a collection of individual key/value pairs *)
-
-  val flatten_l : ('a,'b list) t -> ('a*'b) sequence
-  (** View a multimap as a list of individual key/value pairs *)
-end
-
-(** {2 Query operators} *)
-
-type 'a t
-(** Type of a query that returns zero, one or more values of type 'a *)
-
-(** {6 Initial values} *)
-
-val empty : 'a t
-(** Empty collection *)
-
-val start : 'a -> 'a t
-(** Start with a single value
-    @deprecated since 0.13, use {!return} instead *)
-
-val return : 'a -> 'a t
-(** Return one value *)
-
-val of_list : 'a list -> 'a t
-(** Query that just returns the elements of the list *)
-
-val of_array : 'a array -> 'a t
-val of_array_i : 'a array -> (int * 'a) t
-
-val range : int -> int -> int t
-(** [range i j] goes from [i] up to [j] included *)
-
-val (--) : int -> int -> int t
-(** Synonym to {!range} *)
-
-val of_hashtbl : ('a,'b) Hashtbl.t -> ('a * 'b) t
-
-val of_seq : 'a sequence -> 'a t
-(** Query that returns the elements of the given sequence. *)
-
-val of_queue : 'a Queue.t -> 'a t
-
-val of_stack : 'a Stack.t -> 'a t
-
-val of_string : string -> char t
-(** Traverse the characters of the string *)
-
-(** {6 Execution} *)
-
-val run : ?limit:int -> 'a t -> 'a sequence
-(** Execute the query, possibly returning an error if things go wrong
-    @param limit max number of values to return *)
-
-val run1 : 'a t -> 'a
-(** Run the query and return the first value
-    @raise Not_found if the query succeeds with 0 element *)
-
-val run_no_optim : ?limit:int -> 'a t -> 'a sequence
-(** Run without any optimization *)
-
-(** {6 Basics} *)
-
-val map : ('a -> 'b) -> 'a t -> 'b t
-(** Map each value *)
-
-val (>|=) : 'a t -> ('a -> 'b) -> 'b t
-(** Infix synonym of {!map} *)
-
-val filter : ('a -> bool) -> 'a t -> 'a t
-(** Filter out values that do not satisfy predicate *)
-
-val size : _ t -> int t
-(** [size t] returns one value, the number of items returned by [t] *)
-
-val choose : 'a t -> 'a t
-(** Choose one element (if any, otherwise empty) in the collection.
-    This is like a "cut" in prolog. *)
-
-val filter_map : ('a -> 'b option) -> 'a t -> 'b t
-(** Filter and map elements at once *)
-
-val flat_map : ('a -> 'b sequence) -> 'a t -> 'b t
-(** Same as {!flat_map} but using sequences *)
-
-val flat_map_l : ('a -> 'b list) -> 'a t -> 'b t
-(** map each element to a collection and flatten the result *)
-
-val flatten : 'a list t -> 'a t
-
-val flatten_seq : 'a sequence t -> 'a t
-
-val take : int -> 'a t -> 'a t
-(** Take at most [n] elements *)
-
-val take_while : ('a -> bool) -> 'a t -> 'a t
-(** Take elements while they satisfy a predicate *)
-
-val sort : ?cmp:'a ord -> unit -> 'a t -> 'a t
-(** Sort items by the given comparison function *)
-
-val distinct : ?cmp:'a ord -> unit -> 'a t -> 'a t
-(** Remove duplicate elements from the input collection.
-    All elements in the result are distinct. *)
-
-(** {6 Aggregation} *)
-
-val group_by : ?cmp:'b ord -> ?eq:'b equal -> ?hash:'b hash ->
-               ('a -> 'b) -> 'a t -> ('b,'a list) PMap.t t
-(** [group_by f] takes a collection [c] as input, and returns
-    a multimap [m] such that for each [x] in [c],
-    [x] occurs in [m] under the key [f x]. In other words, [f] is used
-    to obtain a key from [x], and [x] is added to the multimap using this key. *)
-
-val group_by' : ?cmp:'b ord -> ?eq:'b equal -> ?hash:'b hash ->
-                ('a -> 'b) -> 'a t -> ('b * 'a list) t
-
-val count : ?cmp:'a ord -> ?eq:'a equal -> ?hash:'a hash ->
-             unit -> 'a t -> ('a, int) PMap.t t
-(** [count c] returns a map from elements of [c] to the number
-    of time those elements occur. *)
-
-val count' : ?cmp:'a ord -> unit -> 'a t -> ('a * int) t
-
-val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b t
-(** Fold over the collection *)
-
-val reduce : ('a -> 'b) -> ('a -> 'b -> 'b) -> ('b -> 'c) ->
-             'a t -> 'c t
-(** [reduce start mix stop q] uses [start] on the first element of [q],
-    and combine the result with following elements using [mix]. The final
-    value is transformed using [stop]. *)
-
-val is_empty : 'a t -> bool t
-
-val sum : int t -> int t
-
-val contains : ?eq:'a equal -> 'a -> 'a t -> bool t
-
-val average : int t -> int t
-val max : int t -> int t
-val min : int t -> int t
-
-val for_all : ('a -> bool) -> 'a t -> bool t
-val exists : ('a -> bool) -> 'a t -> bool t
-val find : ('a -> bool) -> 'a t -> 'a option t
-val find_map : ('a -> 'b option) -> 'a t -> 'b option t
-
-(** {6 Binary Operators} *)
-
-val join : ?cmp:'key ord -> ?eq:'key equal -> ?hash:'key hash ->
-            ('a -> 'key) -> ('b -> 'key) ->
-            merge:('key -> 'a -> 'b -> 'c option) ->
-            'a t -> 'b t -> 'c t
-(** [join key1 key2 ~merge] is a binary operation
-    that takes two collections [a] and [b], projects their
-    elements resp. with [key1] and [key2], and combine
-    values [(x,y)] from [(a,b)] with the same [key]
-    using [merge]. If [merge] returns [None], the combination
-    of values is discarded. *)
-
-val group_join : ?cmp:'a ord -> ?eq:'a equal -> ?hash:'a hash ->
-                  ('b -> 'a) -> 'a t -> 'b t ->
-                  ('a, 'b list) PMap.t t
-(** [group_join key2] associates to every element [x] of
-    the first collection, all the elements [y] of the second
-    collection such that [eq x (key y)] *)
-
-val product : 'a t -> 'b t -> ('a * 'b) t
-(** Cartesian product *)
-
-val append : 'a t -> 'a t -> 'a t
-(** Append two collections together *)
-
-val inter : ?cmp:'a ord -> ?eq:'a equal -> ?hash:'a hash -> unit ->
-            'a t -> 'a t -> 'a t
-(** Intersection of two collections. Each element will occur at most once
-    in the result *)
-
-val union : ?cmp:'a ord -> ?eq:'a equal -> ?hash:'a hash -> unit ->
-            'a t -> 'a t -> 'a t
-(** Union of two collections. Each element will occur at most once
-    in the result *)
-
-val diff : ?cmp:'a ord -> ?eq:'a equal -> ?hash:'a hash -> unit ->
-            'a t -> 'a t -> 'a t
-(** Set difference *)
-
-(** {6 Tuple and Options} *)
-
-(** Specialized projection operators *)
-
-val fst : ('a * 'b) t -> 'a t
-
-val snd : ('a * 'b) t -> 'b t
-
-val map1 : ('a -> 'b) -> ('a * 'c) t -> ('b * 'c) t
-
-val map2 : ('a -> 'b) -> ('c * 'a) t -> ('c * 'b) t
-
-val flatten_opt : 'a option t -> 'a t
-(** Flatten the collection by removing options *)
-
-(** {6 Applicative} *)
-
-val pure : 'a -> 'a t
-(** Synonym to {!return} *)
-
-val app : ('a -> 'b) t -> 'a t -> 'b t
-(** Apply each function to each value *)
-
-val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
-(** Infix synonym to {!app} *)
-
-(** {6 Monad}
-
-Careful, those operators do not allow any optimization before running the
-query, they might therefore be pretty slow. *)
-
-val bind : ('a -> 'b t) -> 'a t -> 'b t
-(** Use the result of a query to build another query and immediately run it. *)
-
-val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-(** Infix version of {!bind} *)
-
-(** {6 Misc} *)
-
-val lazy_ : 'a lazy_t t -> 'a t
-
-val opt_unwrap : 'a option t -> 'a t
-
-val reflect : 'a t -> 'a sequence t
-(** [reflect q] evaluates all values in [q] and returns a sequence
-    of all those values. Also blocks optimizations *)
-
-(** {6 Infix} *)
-
-module Infix : sig
-  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-  val (>|=) : 'a t -> ('a -> 'b) -> 'b t
-  val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
-  val (--) : int -> int -> int t
-end
-
-(** {6 Adapters} *)
-
-val to_seq : 'a t  -> 'a sequence t
-(** Build a (re-usable) sequence of elements, which can then be
-    converted into other structures *)
-
-val to_hashtbl : ('a * 'b) t -> ('a, 'b) Hashtbl.t t
-(** Build a hashtable from the collection *)
-
-val to_queue : 'a t -> 'a Queue.t t
-
-val to_stack : 'a t -> 'a Stack.t t
-
-module List : sig
-  val of_list : 'a list -> 'a t
-  val to_list : 'a t -> 'a list t
-  val run : 'a t -> 'a list
-end
-
-module Array : sig
-  val of_array : 'a array -> 'a t
-  val to_array : 'a t -> 'a array t
-  val run : 'a t -> 'a array
-end
-
-module AdaptSet(S : Set.S) : sig
-  val of_set : S.t -> S.elt t
-  val to_set : S.elt t -> S.t t
-  val run : S.elt t -> S.t
-end
-
-module AdaptMap(M : Map.S) : sig
-  val of_map : 'a M.t -> (M.key * 'a) t
-  val to_pmap : 'a M.t -> (M.key, 'a) PMap.t
-  val to_map : (M.key * 'a) t -> 'a M.t t
-  val run : (M.key * 'a) t -> 'a M.t
-end
-
-module IO : sig
-  val slurp : in_channel -> string t
-  (** Slurp the whole channel in (blocking), returning the
-      corresponding string. The channel will be read at most once
-      during execution, and its content cached; however the channel
-      might never get read because evaluation is lazy. *)
-
-  val slurp_file : string -> string t
-  (** Read a whole file (given by name) and return its content as
-      a string *)
-
-  val lines : string t -> string t
-  (** Convert a string into a collection of lines *)
-
-  val lines' : string t -> string list t
-  (** Convert a string into a list of lines *)
-
-  val join : string -> string t -> string t
-
-  val unlines : string t -> string t
-  (** Join lines together *)
-
-  val out : out_channel -> string t -> unit
-  val out_lines : out_channel -> string t -> unit
-  (** Evaluate the query and print it line by line on the output *)
-
-  (** {8 Run methods} *)
-
-  val to_file : string -> string t -> unit with_err
-  val to_file_exn : string -> string t -> unit
-
-  val to_file_lines : string -> string t -> unit with_err
-  val to_file_lines_exn : string -> string t -> unit
-end

src/advanced/CCMonadIO.cppo.ml

@@ -1,519 +0,0 @@
-(*
-copyright (c) 2013-2014, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {1 IO Monad} *)
-
-type _ t =
-  | Return : 'a -> 'a t
-  | Fail : string -> 'a t
-  | Map : ('a -> 'b) * 'a t -> 'b t
-  | Bind : ('a -> 'b t) * 'a t -> 'b t
-  | WithGuard: unit t * 'a t -> 'a t  (* run guard in any case *)
-  | Star : ('a -> 'b) t * 'a t -> 'b t
-  | Repeat : int * 'a t -> 'a list t
-  | RepeatIgnore : int * 'a t -> unit t
-  | Wrap : (unit -> 'a) -> 'a t
-  | SequenceMap : ('a -> 'b t) * 'a list -> 'b list t
-
-type 'a io = 'a t
-type 'a with_finalizer = ('a t * unit t) t
-type 'a or_error = [ `Ok of 'a | `Error of string ]
-
-let (>>=) x f = Bind(f,x)
-
-let bind ?finalize f a = match finalize with
-  | None -> Bind(f,a)
-  | Some b -> WithGuard (b, Bind (f,a))
-
-let map f x = Map(f, x)
-
-let (>|=) x f = Map(f, x)
-
-let return x = Return x
-let pure = return
-
-let fail msg = Fail msg
-
-let (<*>) f a = Star (f, a)
-
-let lift = map
-
-let lift2 f a b =
-  a >>= fun x -> map (f x) b
-
-let lift3 f a b c =
-  a >>= fun x ->
-  b >>= fun y -> map (f x y) c
-
-let sequence_map f l =
-  SequenceMap (f,l)
-
-let sequence l =
-  let _id x = x in
-  SequenceMap(_id, l)
-
-let repeat i a =
-  if i <= 0 then Return [] else Repeat (i,a)
-
-let repeat' i a =
-  if i <= 0 then Return () else RepeatIgnore (i,a)
-
-(** {2 Finalizers} *)
-
-let (>>>=) a f =
-  a >>= function
-  | x, finalizer -> WithGuard (finalizer, x >>= f)
-
-(** {2 Running} *)
-
-exception IOFailure of string
-
-let rec _run : type a. a t -> a = function
-  | Return x -> x
-  | Fail msg -> raise (IOFailure msg)
-  | Map (f, a) -> f (_run a)
-  | Bind (f, a) -> _run (f (_run a))
-  | WithGuard (g, a) ->
-      begin try
-        let res = _run a in
-        _run g;
-        res
-      with e ->
-        _run g;
-        raise e
-      end
-  | Star (f, a) -> _run f (_run a)
-  | Repeat (i,a) -> _repeat [] i a
-  | RepeatIgnore (i,a) -> _repeat_ignore i a
-  | Wrap f -> f()
-  | SequenceMap (f, l) -> _sequence_map f l []
-and _repeat : type a. a list -> int -> a t -> a list
-  = fun acc i a -> match i with
-  | 0 -> List.rev acc
-  | _ ->
-      let x = _run a in
-      _repeat (x::acc) (i-1) a
-and _repeat_ignore : type a. int -> a t -> unit
-  = fun i a -> match i with
-  | 0 -> ()
-  | _ ->
-      let _ = _run a in
-      _repeat_ignore (i-1) a
-and _sequence_map : type a b. (a -> b t) -> a list -> b list -> b list
-  = fun f l acc -> match l with
-  | [] -> List.rev acc
-  | a::tail ->
-      let x = _run (f a) in
-      _sequence_map f tail (x::acc)
-
-let _printers =
-  ref [
-    (* default printer *)
-    ( function IOFailure msg
-    | Sys_error msg -> Some msg
-    | Exit -> Some "exit"
-    | _ -> None
-    )
-  ]
-
-exception PrinterResult of string
-
-let _print_exn e =
-  try
-    List.iter
-      (fun p -> match p e with
-        | None -> ()
-        | Some msg -> raise (PrinterResult msg)
-      ) !_printers;
-    Printexc.to_string e
-  with PrinterResult s -> s
-
-let run x =
-  try `Ok (_run x)
-  with e -> `Error (_print_exn e)
-
-exception IO_error of string
-
-let run_exn x =
-  try _run x
-  with e -> raise (IO_error (_print_exn e))
-
-let register_printer p = _printers := p :: !_printers
-
-(** {2 Standard Wrappers} *)
-
-let _open_in mode flags filename () =
-  open_in_gen flags mode filename
-let _close_in ic () = close_in ic
-
-let with_in ?(mode=0o644) ?(flags=[]) filename =
-  Wrap (_open_in mode flags filename)
-  >>= fun ic ->
-  Return (Return ic, Wrap (_close_in ic))
-
-let _read ic s i len () = input ic s i len
-let read ic s i len = Wrap (_read ic s i len)
-
-let _read_line ic () =
-  try Some (Pervasives.input_line ic)
-  with End_of_file -> None
-let read_line ic = Wrap(_read_line ic)
-
-let rec _read_lines ic acc =
-  read_line ic
-  >>= function
-  | None -> return (List.rev acc)
-  | Some l -> _read_lines ic (l::acc)
-
-let read_lines ic = _read_lines ic []
-
-let read_all ic = Wrap(fun () -> CCIO.read_all ic)
-
-let _open_out mode flags filename () =
-  open_out_gen flags mode filename
-let _close_out oc () = close_out oc
-
-let with_out ?(mode=0o644) ?(flags=[]) filename =
-  Wrap(_open_out mode (Open_wronly::flags) filename)
-  >>= fun oc ->
-  Return(Return oc, Wrap(_close_out oc))
-
-let with_out_a ?mode ?(flags=[]) filename =
-  with_out ?mode ~flags:(Open_creat::Open_append::flags) filename
-
-#if OCAML_MAJOR >= 4 && OCAML_MINOR >= 2
-
-let output_str_ = Pervasives.output_substring
-
-#else
-
-let output_str_ = Pervasives.output
-
-#endif
-
-let _write oc s i len () = output_str_ oc s i len
-let write oc s i len = Wrap (_write oc s i len)
-
-let _write_str oc s () = output_str_ oc s 0 (String.length s)
-let write_str oc s = Wrap (_write_str oc s)
-
-let _write_line oc l () =
-  output_string oc l;
-  output_char oc '\n'
-let write_line oc l = Wrap (_write_line oc l)
-
-let _write_buf oc buf () = Buffer.output_buffer oc buf
-let write_buf oc buf = Wrap (_write_buf oc buf)
-
-let flush oc = Wrap (fun () -> Pervasives.flush oc)
-
-(** {2 Seq} *)
-
-module Seq = struct
-  type 'a step_result =
-    | Yield of 'a
-    | Stop
-
-  type 'a gen = unit -> 'a step_result io
-
-  type 'a t = 'a gen
-
-  let _stop () = return Stop
-  let _yield x = return (Yield x)
-
-  let map_pure f gen () =
-    gen() >>= function
-    | Stop -> _stop ()
-    | Yield x -> _yield (f x)
-
-  let map f g () =
-    g() >>= function
-    | Stop -> _stop ()
-    | Yield x -> f x >>= _yield
-
-  let rec filter_map f g () =
-    g() >>= function
-    | Stop -> _stop()
-    | Yield x ->
-        match f x with
-        | None -> filter_map f g()
-        | Some y -> _yield y
-
-  let rec filter f g () =
-    g() >>= function
-    | Stop -> _stop()
-    | Yield x ->
-        if f x then _yield x else filter f g()
-
-  let rec flat_map f g () =
-    g() >>= function
-    | Stop -> _stop ()
-    | Yield x ->
-        f x >>= fun g' -> _flat_map_aux f g g' ()
-  and _flat_map_aux f g g' () =
-    g'() >>= function
-    | Stop -> flat_map f g ()
-    | Yield x -> _yield x
-
-  let general_iter f acc g =
-    let acc = ref acc in
-    let rec _next () =
-      g() >>= function
-      | Stop -> _stop()
-      | Yield x ->
-          f !acc x >>= function
-          | `Stop -> _stop()
-          | `Continue (acc', ret) ->
-              acc := acc';
-              match ret with
-              | None -> _next()
-              | Some y -> _yield y
-    in
-    _next
-
-  let take n seq =
-    general_iter
-      (fun n x -> if n<=0
-        then return `Stop
-        else return (`Continue (n-1, Some x))
-      ) n seq
-
-  let drop n seq =
-    general_iter
-      (fun n x -> if n<=0
-        then return (`Continue (n, Some x))
-        else return (`Continue (n-1, None))
-      ) n seq
-
-  let take_while p seq =
-    general_iter
-      (fun () x ->
-        p x >|= function
-          | true -> `Continue ((), Some x)
-          | false -> `Stop
-      ) () seq
-
-  let drop_while p seq =
-    general_iter
-      (fun dropping x ->
-        if dropping
-        then p x >|= function
-          | true -> `Continue (true, None)
-          | false -> `Continue (false, Some x)
-        else return (`Continue (false, Some x))
-      ) true seq
-
-  (* apply all actions from [l] to [x] *)
-  let rec _apply_all_to x l = match l with
-    | [] -> return ()
-    | f::tail -> f x >>= fun () -> _apply_all_to x tail
-
-  let _tee funs g () =
-    g() >>= function
-    | Stop -> _stop()
-    | Yield x ->
-        _apply_all_to x funs >>= fun () ->
-        _yield x
-
-  let tee funs g = match funs with
-    | [] -> g
-    | _::_ -> _tee funs g
-
-  (** {6 Consume} *)
-
-  let rec fold_pure f acc g =
-    g() >>= function
-    | Stop -> return acc
-    | Yield x -> fold_pure f (f acc x) g
-
-  let length g = fold_pure (fun acc _ -> acc+1) 0 g
-
-  let rec fold f acc g =
-    g() >>= function
-    | Stop -> return acc
-    | Yield x ->
-        f acc x >>= fun acc' -> fold f acc' g
-
-  let rec iter f g =
-    g() >>= function
-    | Stop -> return ()
-    | Yield x -> f x >>= fun _ -> iter f g
-
-  let of_fun g = g
-
-  let empty () = _stop()
-
-  let singleton x =
-    let first = ref true in
-    fun () ->
-      if !first then (first := false; _yield x) else _stop()
-
-  let cons x g =
-    let first = ref true in
-    fun () ->
-      if !first then (first := false; _yield x) else g()
-
-  let of_list l =
-    let l = ref l in
-    fun () -> match !l with
-      | [] -> _stop()
-      | x::tail -> l:= tail; _yield x
-
-  let of_array a =
-    let i = ref 0 in
-    fun () ->
-      if !i = Array.length a
-      then _stop()
-      else (
-        let x = a.(!i) in
-        incr i;
-        _yield x
-      )
-
-  (* TODO: wrapper around with_in? using bind ~finalize:... ? *)
-
-  let chunks ~size ic =
-    let buf = Buffer.create size in
-    let eof = ref false in
-    let next() =
-      if !eof then _stop()
-      else try
-        Buffer.add_channel buf ic size;
-        let s = Buffer.contents buf in
-        Buffer.clear buf;
-        _yield s
-      with End_of_file ->
-        let s = Buffer.contents buf in
-        eof := true;
-        if s="" then _stop() else _yield s
-    in
-    next
-
-  let lines ic () =
-    try _yield (input_line ic)
-    with End_of_file -> _stop()
-
-  let words _g =
-    failwith "words: not implemented yet"
-    (* TODO: state machine that goes:
-        - 0: read input chunk
-        - switch to "search for ' '", and yield word
-        - goto 0 if no ' ' found
-        - yield leftover when g returns Stop
-    let buf = Buffer.create 32 in
-    let next() =
-      g() >>= function
-      | Stop -> _stop
-      | Yield s ->
-          Buffer.add_string buf s;
-          search_
-    in
-    next
-    *)
-
-  let output ?sep oc seq =
-    let first = ref true in
-    iter
-      (fun s ->
-        (* print separator *)
-        ( if !first
-          then (first:=false; return ())
-          else match sep with
-            | None -> return ()
-            | Some sep -> write_str oc sep
-        ) >>= fun () ->
-        write_str oc s
-      ) seq
-    >>= fun () -> flush oc
-end
-
-(** {6 File and file names} *)
-
-module File = struct
-  type t = string
-
-  let to_string f = f
-
-  let make f =
-    if Filename.is_relative f
-      then Filename.concat (Sys.getcwd()) f
-      else f
-
-  let exists f = Wrap (fun () -> Sys.file_exists f)
-
-  let is_directory f = Wrap (fun () -> Sys.is_directory f)
-
-  let remove f = Wrap (fun () -> Sys.remove f)
-
-  let _read_dir d () =
-    if Sys.is_directory d
-    then
-      let arr = Sys.readdir d in
-      Seq.map_pure make (Seq.of_array arr)
-    else Seq.empty
-
-  let rec _walk d () =
-    if Sys.is_directory d
-    then
-      let arr = Sys.readdir d in
-      let tail = Seq.of_array arr in
-      let tail = Seq.flat_map
-        (fun s -> return (_walk (Filename.concat d s) ()))
-        tail
-      in Seq.cons (`Dir,d) tail
-    else Seq.singleton (`File, d)
-
-  let walk t = Wrap (_walk t)
-
-  let read_dir ?(recurse=false) d =
-    if recurse
-    then walk d
-      >|= Seq.filter_map
-      (function
-        | `File, f -> Some f
-        | `Dir, _ -> None
-      )
-    else Wrap (_read_dir d)
-
-  let rec _read_dir_rec d () =
-    if Sys.is_directory d
-    then
-      let arr = Sys.readdir d in
-      let arr = Seq.of_array arr in
-      let arr = Seq.map_pure (fun s -> Filename.concat d s) arr in
-      Seq.flat_map
-        (fun s ->
-          if Sys.is_directory s
-            then return (_read_dir_rec s ())
-            else return (Seq.singleton s)
-        ) arr
-    else Seq.empty
-end
-
-(** {2 Raw} *)
-
-module Raw = struct
-  let wrap f = Wrap f
-end

src/advanced/CCMonadIO.mli

@@ -1,322 +0,0 @@
-(*
-copyright (c) 2013-2014, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {1 IO Monad}
-
-A simple abstraction over blocking IO, with strict evaluation. This is in
-no way an alternative to Lwt/Async if you need concurrency.
-
-@since 0.3.3
-*)
-
-(**
-Examples:
-
-- obtain the list of lines of a file:
-
-{[
-let l = CCIO.((with_in "/tmp/some_file" >>>= read_lines) |> run_exn);;
-]}
-
-- transfer one file into another:
-
-{[
-# let a = CCIO.(
-  with_in "input" >>>= fun ic ->
-  with_out ~flags:[Open_creat] "output" >>>= fun oc ->
-  Seq.chunks 512 ic
-  |> Seq.output oc
-) ;;
-
-# run a;;
-]}
-*)
-
-type 'a t
-type 'a io = 'a t
-
-type 'a with_finalizer
-(** A value of type ['a with_finalizer] is similar to a value ['a t] but
-    also contains a finalizer that must be run to cleanup.
-    See {!(>>>=)} to get rid of it. *)
-
-type 'a or_error = [ `Ok of 'a | `Error of string ]
-
-val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-(** Wait for the result of an action, then use a function to build a
-    new action and execute it *)
-
-val return : 'a -> 'a t
-(** Just return a value *)
-
-val repeat : int -> 'a t -> 'a list t
-(** Repeat an IO action as many times as required *)
-
-val repeat' : int -> 'a t -> unit t
-(** Same as {!repeat}, but ignores the result *)
-
-val map : ('a -> 'b) -> 'a t -> 'b t
-(** Map values *)
-
-val (>|=) : 'a t -> ('a -> 'b) -> 'b t
-
-val bind : ?finalize:(unit t) -> ('a -> 'b t) -> 'a t -> 'b t
-(** [bind f a] runs the action [a] and applies [f] to its result
-    to obtain a new action. It then behaves exactly like this new
-    action.
-    @param finalize an optional action that is always run after evaluating
-      the whole action *)
-
-val pure : 'a -> 'a t
-val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
-
-val lift : ('a -> 'b) -> 'a t -> 'b t
-(** Synonym to {!map} *)
-
-val lift2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
-val lift3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t
-
-val sequence : 'a t list -> 'a list t
-(** Runs operations one by one and gather their results *)
-
-val sequence_map : ('a -> 'b t) -> 'a list -> 'b list t
-(** Generalization of {!sequence} *)
-
-val fail : string -> 'a t
-(** [fail msg] fails with the given message. Running the IO value will
-    return an [`Error] variant *)
-
-(** {2 Finalizers} *)
-
-val (>>>=) : 'a with_finalizer -> ('a -> 'b t) -> 'b t
-(** Same as {!(>>=)}, but taking the finalizer into account. Once this
-    IO value is done executing, the finalizer is executed and the resource,
-    fred. *)
-
-(** {2 Running} *)
-
-val run : 'a t -> 'a or_error
-(** Run an IO action.
-    @return either [`Ok x] when [x] is the successful result of the
-      computation, or some [`Error "message"] *)
-
-exception IO_error of string
-
-val run_exn : 'a t -> 'a
-(** Unsafe version of {!run}. It assumes non-failure.
-    @raise IO_error if the execution didn't go well *)
-
-val register_printer : (exn -> string option) -> unit
-(** [register_printer p] register [p] as a possible failure printer.
-    If [run a] raises an exception [e], [p e] is evaluated. If [p e = Some msg]
-    then the error message will be [msg], otherwise other printers will
-    be tried *)
-
-(** {2 Standard Wrappers} *)
-
-(** {6 Input} *)
-
-val with_in : ?mode:int -> ?flags:open_flag list ->
-              string -> in_channel with_finalizer
-(** Open an input file with the given optional flag list.
-    It yields a [in_channel] with a finalizer attached. See {!(>>>=)} to
-    use it. *)
-
-val read : in_channel -> Bytes.t -> int -> int -> int t
-(** Read a chunk into the given string *)
-
-val read_line : in_channel -> string option t
-(** Read a line from the channel. Returns [None] if the input is terminated. *)
-
-val read_lines : in_channel -> string list t
-(** Read all lines eagerly *)
-
-val read_all : in_channel -> string t
-(** Read the whole channel into a buffer, then converted into a string *)
-
-(** {6 Output} *)
-
-val with_out : ?mode:int -> ?flags:open_flag list ->
-               string -> out_channel with_finalizer
-(** Same as {!with_in} but for an output channel *)
-
-val with_out_a : ?mode:int -> ?flags:open_flag list ->
-                  string -> out_channel with_finalizer
-(** Similar to {!with_out} but with the [Open_append] and [Open_creat]
-    flags activated *)
-
-val write : out_channel -> string -> int -> int -> unit t
-
-val write_str : out_channel -> string -> unit t
-
-val write_buf : out_channel -> Buffer.t -> unit t
-
-val write_line : out_channel -> string -> unit t
-
-val flush : out_channel -> unit t
-
-(* TODO: printf/fprintf wrappers *)
-
-(** {2 Streams}
-
-Iterators on chunks of bytes, or lines, or any other value using combinators.
-Those iterators are usable only once, because their source might
-be usable only once (think of a socket) *)
-
-module Seq : sig
-  type 'a t
-  (** An IO stream of values of type 'a, consumable (iterable only once) *)
-
-  val map : ('a -> 'b io) -> 'a t -> 'b t
-  (** Map values with actions *)
-
-  val map_pure : ('a -> 'b) -> 'a t -> 'b t
-  (** Map values with a pure function *)
-
-  val filter_map : ('a -> 'b option) -> 'a t -> 'b t
-
-  val filter : ('a -> bool) -> 'a t -> 'a t
-
-  val flat_map : ('a -> 'b t io) -> 'a t -> 'b t
-  (** Map each value to a sub sequence of values *)
-
-  val take : int -> 'a t -> 'a t
-
-  val drop : int -> 'a t -> 'a t
-
-  val take_while : ('a -> bool io) -> 'a t -> 'a t
-
-  val drop_while : ('a -> bool io) -> 'a t -> 'a t
-
-  val general_iter : ('b -> 'a -> [`Stop | `Continue of ('b * 'c option)] io) ->
-                      'b -> 'a t -> 'c t
-  (** [general_iter f acc seq] performs a [filter_map] over [seq],
-      using [f]. [f] is given a state and the current value, and
-      can either return [`Stop] to indicate it stops traversing,
-      or [`Continue (st, c)] where [st] is the new state and
-      [c] an optional output value.
-      The result is the stream of values output by [f] *)
-
-  val tee : ('a -> unit io) list -> 'a t -> 'a t
-  (** [tee funs seq] behaves like [seq], but each element is given to
-      every function [f] in [funs]. This function [f] returns an action that
-      is eagerly executed. *)
-
-  (** {6 Consume} *)
-
-  val iter : ('a -> _ io) -> 'a t -> unit io
-  (** Iterate on the stream, with an action for each element *)
-
-  val length : _ t -> int io
-  (** Length of the stream *)
-
-  val fold : ('b -> 'a -> 'b io) -> 'b -> 'a t -> 'b io
-  (** [fold f acc seq] folds over [seq], consuming it. Every call to [f]
-      has the right to return an IO value. *)
-
-  val fold_pure : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b io
-  (** [fold f acc seq] folds over [seq], consuming it. [f] is pure. *)
-
-  (** {6 Standard Wrappers} *)
-
-  type 'a step_result =
-    | Yield of 'a
-    | Stop
-
-  type 'a gen = unit -> 'a step_result io
-
-  val of_fun : 'a gen -> 'a t
-  (** Create a stream from a function that yields an element or stops *)
-
-  val empty : 'a t
-  val singleton : 'a -> 'a t
-  val cons : 'a -> 'a t -> 'a t
-  val of_list : 'a list -> 'a t
-  val of_array : 'a array -> 'a t
-
-  val chunks : size:int -> in_channel -> string t
-  (** Read the channel's content into chunks of size [size] *)
-
-  val lines : in_channel -> string t
-  (** Lines of an input channel *)
-
-  val words : string t -> string t
-  (** Split strings into words at " " boundaries.
-      {b NOT IMPLEMENTED} *)
-
-  val output : ?sep:string -> out_channel -> string t -> unit io
-  (** [output oc seq] outputs every value of [seq] into [oc], separated
-      with the optional argument [sep] (default: None).
-      It blocks until all values of [seq] are produced and written to [oc]. *)
-end
-
-(** {6 File and file names}
-
-How to list recursively files in a directory:
-{[
-  CCIO.(
-    File.read_dir ~recurse:true (File.make "/tmp")
-    >>= Seq.output ~sep:"\n" stdout
-  ) |> CCIO.run_exn ;;
-
-  ]}
-
-See {!File.walk} if you also need to list directories.
-*)
-
-module File : sig
-  type t = string
-  (** A file is always represented by its absolute path *)
-
-  val to_string : t -> string
-
-  val make : string -> t
-  (** Build a file representation from a path (absolute or relative) *)
-
-  val exists : t -> bool io
-
-  val is_directory : t -> bool io
-
-  val remove : t -> unit io
-
-  val read_dir : ?recurse:bool -> t -> t Seq.t io
-  (** [read_dir d] returns a sequence of files and directory contained
-      in the directory [d] (or an empty stream if [d] is not a directory)
-      @param recurse if true (default [false]), sub-directories are also
-        explored *)
-
-  val walk : t -> ([`File | `Dir] * t) Seq.t io
-  (** Similar to {!read_dir} (with [recurse=true]), this function walks
-      a directory recursively and yields either files or directories.
-      Is a file anything that doesn't satisfy {!is_directory} (including
-      symlinks, etc.) *)
-end
-
-(** {2 Low level access} *)
-module Raw : sig
-  val wrap : (unit -> 'a) -> 'a t
-  (** [wrap f] is the IO action that, when executed, returns [f ()].
-      [f] should be callable as many times as required *)
-end

src/advanced/containers_advanced.ml

@@ -1,29 +0,0 @@
-(*
-copyright (c) 2013-2015, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-module Batch = CCBatch
-module Cat = CCCat
-module Linq = CCLinq
-module MonadIO = CCMonadIO

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/bigarray/CCArray1.ml

@@ -1,753 +0,0 @@
-(*
-copyright (c) 2013-2015, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {1 Bigarrays of dimension 1 *)
-
-module A = Bigarray.Array1
-
-type 'a printer = Format.formatter -> 'a -> unit
-type 'a sequence = ('a -> unit) -> unit
-type 'a or_error = [`Ok of 'a | `Error of string]
-type random = Random.State.t
-
-type json = [ `Assoc of (string * json) list
-            | `Bool of bool
-            | `Float of float
-            | `Int of int
-            | `List of json list
-            | `Null
-            | `String of string ]
-type 'a to_json = 'a -> json
-type 'a of_json = json -> 'a or_error
-
-type ('a, 'b, 'perm) t =
-  ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t
-  constraint 'perm = [< `R | `W]
-
-type ('a, 'b, 'perm) array_ = ('a, 'b, 'perm) t
-
-exception WrongDimension
-
-let make ?x ~kind n =
-  let a = A.create kind Bigarray.c_layout n in
-  begin match x with
-    | None -> ()
-    | Some x -> A.fill a x
-  end;
-  a
-
-let make_int n = make ~kind:Bigarray.int n
-let make_char n = make ~kind:Bigarray.char n
-let make_int8s n = make ~kind:Bigarray.int8_signed n
-let make_int8u n = make ~kind:Bigarray.int8_unsigned n
-let make_int16s n = make ~kind:Bigarray.int16_signed n
-let make_int16u n = make ~kind:Bigarray.int16_unsigned n
-let make_int32 n = make ~kind:Bigarray.int32 n
-let make_int64 n = make ~kind:Bigarray.int64 n
-let make_native n = make ~kind:Bigarray.nativeint n
-let make_float32 n = make ~kind:Bigarray.float32 n
-let make_float64 n = make ~kind:Bigarray.float64 n
-let make_complex32 n = make ~kind:Bigarray.complex32 n
-let make_complex64 n = make ~kind:Bigarray.complex64 n
-
-let init ~kind ~f n =
-  let a = A.create kind Bigarray.c_layout n in
-  for i = 0 to n-1 do
-    A.unsafe_set a i (f i)
-  done;
-  a
-
-(*$T
-  let a = init ~kind:Bigarray.int 10 ~f:(fun x->x) in \
-  CCList.(0 -- 9) |> List.for_all (fun i -> get a i = i)
-*)
-
-let of_bigarray a = a
-let to_bigarray a = a
-
-let ro (t : ('a,'b,[>`R]) t) : ('a,'b,[`R]) t = t
-let wo (t : ('a,'b,[>`W]) t) : ('a,'b,[`W]) t = t
-
-let fill = A.fill
-
-let copy a =
-  let b = make ~kind:(A.kind a) (A.dim a) in
-  A.blit a b;
-  b
-
-let length a = A.dim a
-
-(*$T
-  length (make_int 42) = 42
-*)
-
-let set = A.set
-
-let get = A.get
-
-let blit = A.blit
-
-let sub = A.sub
-
-let iter ~f a =
-  for i = 0 to A.dim a - 1 do
-    f (A.unsafe_get a i)
-  done
-
-exception LocalExit
-
-let for_all ~f a =
-  try
-    for i = 0 to A.dim a - 1 do
-      if not (f (A.unsafe_get a i)) then raise LocalExit
-    done;
-    true
-  with LocalExit -> false
-
-let exists ~f a =
-  try
-    for i = 0 to A.dim a - 1 do
-      if f (A.unsafe_get a i) then raise LocalExit
-    done;
-    false
-  with LocalExit -> true
-
-(*$T
-  init ~kind:Bigarray.int 10 ~f:(fun x->x) |> for_all ~f:(fun x -> x<10)
-  init ~kind:Bigarray.int 10 ~f:(fun x->x) |> exists ~f:(fun x -> x=5)
-*)
-
-let iteri ~f a =
-  for i = 0 to A.dim a - 1 do
-    f i (A.unsafe_get a i)
-  done
-
-let foldi f acc a =
-  let rec fold' f acc a i =
-    if i = A.dim a then acc
-    else
-      let acc = f acc i (A.unsafe_get a i) in
-      fold' f acc a (i+1)
-  in
-  fold' f acc a 0
-
-let pp pp_x out a =
-  Format.pp_print_char out '[';
-  iteri a
-    ~f:(fun i x ->
-        if i > 0 then Format.fprintf out ",@ ";
-        pp_x out x
-      );
-  Format.pp_print_char out ']';
-  ()
-
-module Bool = struct
-  type ('a, 'perm) t = (int, 'a, 'perm) array_
-
-  let set a i x = A.set a i (if x then 1 else 0)
-
-  let get a i = A.get a i <> 0
-
-  let zeroes n = make ~x:0 ~kind:Bigarray.int8_unsigned n
-  let ones n = make ~x:1 ~kind:Bigarray.int8_unsigned n
-
-  let iter_zeroes ~f a =
-    for i = 0 to A.dim a - 1 do
-      if A.unsafe_get a i = 0 then f i
-    done
-
-  let iter_ones ~f a =
-    for i = 0 to A.dim a - 1 do
-      if A.unsafe_get a i > 0 then f i
-    done
-
-  let cardinal a =
-    let rec fold a i acc =
-      if i = A.dim a then acc
-      else
-        let acc = if A.get a i <> 0 then acc+1 else acc in
-        fold a (i+1) acc
-    in
-    fold a 0 0
-
-  let or_ ?res a b =
-    let res = match res with
-      | Some r ->
-        if A.dim r <> max (A.dim a) (A.dim b) then raise WrongDimension;
-        A.fill r 0;
-        r
-      | None -> make ~x:0 ~kind:(A.kind a) (max (A.dim a) (A.dim b))
-    in
-    (* ensure [a] is no longer than [b] *)
-    let a, b = if A.dim a < A.dim b then a, b else b, a in
-    for i = 0 to A.dim a - 1 do
-      if A.unsafe_get a i > 0 || A.unsafe_get b i > 0
-      then set b i true
-    done;
-    res
-
-  let and_ ?res a b =
-    let res = match res with
-      | Some r ->
-        if A.dim r <> max (A.dim a) (A.dim b) then raise WrongDimension;
-        A.fill r 0;
-        r
-      | None -> make ~x:0 ~kind:(A.kind a) (max (A.dim a) (A.dim b))
-    in
-    (* ensure [a] is no longer than [b] *)
-    let a, b = if A.dim a < A.dim b then a, b else b, a in
-    for i=0 to A.dim a - 1 do
-      if A.unsafe_get a i > 0 && A.unsafe_get b i > 0
-      then set res i true
-    done;
-    res
-
-  let not_ ?res a =
-    let res = match res with
-      | Some r ->
-        if A.dim r <> A.dim a then raise WrongDimension;
-        A.fill r 0;
-        r
-      | None -> make ~x:0 ~kind:(A.kind a) (A.dim a)
-    in
-    for i=0 to A.dim a - 1 do
-      if A.unsafe_get a i = 0 then set res i true
-    done;
-    res
-
-  (* assumes dimensions are ok and [A.dim a >= A.dim b] *)
-  let mix_ a b ~res =
-    let na = A.dim a
-    and nb = A.dim b in
-    assert (nb <= na);
-    (* a has more bits, and we group them in successive chunks of size [d] *)
-    let step = 1 + (na + nb) / nb in
-    for i = 0 to na + nb - 1 do
-      let q, r = i / step, i mod step in
-      if r = 0
-      then set res i (get b q)
-      else set res i (get a (q + r - 1))
-    done
-
-  let mix ?res a b =
-    let res = match res with
-      | Some r ->
-        if A.dim a + A.dim b <> A.dim r then raise WrongDimension;
-        r
-      | None -> make ~kind:(A.kind a) (A.dim a + A.dim b)
-    in
-    if A.dim a < A.dim b then mix_ b a ~res else mix_ a b ~res;
-    res
-
-  let rec big_or_ a b i j acc =
-    if j = A.dim b then acc
-    else (* acc xor (a[i+j] and b[j]) *)
-      let acc = acc <> (get a ((i+j) mod A.dim a) && get b j) in
-      big_or_ a b i (j+1) acc
-
-  (* [into[i] = big_or_{j in [0...nb-1]} (a[i+j-1 mod na] and b[j]) *)
-  let convolution ?res a ~by:b =
-    let res = match res with
-      | Some r ->
-        if A.dim a < A.dim b || A.dim a <> A.dim r then raise WrongDimension;
-        r
-      | None -> make ~kind:(A.kind a) (A.dim a)
-    in
-    for i = 0 to A.dim res - 1 do
-      if big_or_ a b i 0 false then set res i true
-    done;
-    res
-
-  let pp out a = pp
-      (fun oc b ->
-         Format.pp_print_char oc (if b>0 then '1' else '0')
-      ) out a
-end
-
-let append ?res a b =
-  let res = match res with
-    | Some r ->
-      if A.dim a + A.dim b <> A.dim r then raise WrongDimension;
-      r
-    | None -> make ~kind:(A.kind a) (A.dim a + A.dim b)
-  in
-  let n = A.dim a in
-  A.blit a (A.sub res 0 n);
-  A.blit b (A.sub res n (A.dim b));
-  res
-
-let map ?res ~f a =
-  let res = match res with
-    | Some r ->
-      if A.dim a <> A.dim r then raise WrongDimension;
-      r
-    | None -> make ~kind:(A.kind a) (A.dim a)
-  in
-  for i=0 to A.dim a - 1 do
-    A.set res i (f (A.unsafe_get a i))
-  done;
-  res
-
-let map2 ?res ~f a b =
-  if A.dim a <> A.dim b then raise WrongDimension;
-  let res = match res with
-    | Some r ->
-      if A.dim r <> A.dim a then raise WrongDimension;
-      r
-    | None -> make ~kind:(A.kind a) (A.dim a)
-  in
-  for i=0 to A.dim a - 1 do
-    A.set res i (f (A.unsafe_get a i) (A.unsafe_get b i))
-  done;
-  res
-
-let filter ?res ~f a =
-  let res = match res with
-    | Some r ->
-      if A.dim a <> A.dim r then raise WrongDimension;
-      r
-    | None -> make ~x:0 ~kind:Bigarray.int8_unsigned (A.dim a)
-  in
-  for i=0 to A.dim a - 1 do
-    if f (A.unsafe_get a i)
-    then Bool.set res i true
-  done;
-  res
-
-module type S = sig
-  type elt
-  type ('a, 'perm) t = (elt, 'a, 'perm) array_
-
-  val add :
-    ?res:('a, [>`W] as 'perm) t ->
-    ('a, [>`R]) t ->
-    ('a, [>`R]) t ->
-    ('a, 'perm) t
-  (** Elementwise sum
-      @raise WrongDimension if dimensions do not fit *)
-
-  val mult :
-    ?res:('a, [>`W] as 'perm) t ->
-    ('a, [>`R]) t ->
-    ('a, [>`R]) t ->
-    ('a, 'perm) t
-  (** Elementwise product *)
-
-  val scalar_add :
-    ?res:('a, [>`W] as 'perm) t ->
-    ('a, [>`R]) t ->
-    x:elt ->
-    ('a, 'perm) t
-    (** @raise WrongDimension if dimensions do not fit *)
-
-  val scalar_mult :
-    ?res:('a, [>`W] as 'perm) t ->
-    ('a, [>`R]) t ->
-    x:elt ->
-    ('a, 'perm) t
-    (** @raise WrongDimension if dimensions do not fit *)
-
-  val sum_elt : (_, [>`R]) t -> elt
-  (** Efficient sum of elements *)
-
-  val product_elt : (_, [>`R]) t -> elt
-  (** Efficient product of elements *)
-
-  val dot_product : (_, [>`R]) t -> (_, [>`R]) t -> elt
-  (** [dot_product a b] returns [sum_i a(i)*b(i)] with the given
-      sum and product, on [elt].
-      [dot_product a b = sum_elt (product a b)]
-      @raise WrongDimension if [a] and [b] do not have the same size *)
-
-  module Infix : sig
-    val ( * ) : ('a, [>`R]) t -> ('a, [>`R]) t -> ('a, 'perm) t
-    (** Alias to {!mult} *)
-
-    val ( + ) : ('a, [>`R]) t -> (_, [>`R]) t -> ('a, 'perm) t
-    (** Alias to {!add} *)
-
-    val ( *! ) : ('a, [>`R]) t -> elt -> ('a, 'perm) t
-    (** Alias to {!scalar_mult} *)
-
-    val ( +! ) : ('a, [>`R]) t -> elt -> ('a, 'perm) t
-    (** Alias to {!scalar_add} *)
-  end
-
-  include module type of Infix
-end
-
-module Int = struct
-  type elt = int
-  type ('a, 'perm) t = (elt, 'a, 'perm) array_
-
-  let add ?res a b =
-    if A.dim a <> A.dim b then raise WrongDimension;
-    let res = match res with
-      | Some r ->
-        if A.dim a <> A.dim r then raise WrongDimension;
-        r
-      | None -> make ~x:0 ~kind:(A.kind a) (A.dim a)
-    in
-    for i = 0 to A.dim a - 1 do
-      A.set res i (A.unsafe_get a i + A.unsafe_get b i)
-    done;
-    res
-
-  let mult ?res a b =
-    if A.dim a <> A.dim b then raise WrongDimension;
-    let res = match res with
-      | Some r ->
-        if A.dim a <> A.dim r then raise WrongDimension;
-        r
-      | None -> make ~x:0 ~kind:(A.kind a) (A.dim a)
-    in
-    for i = 0 to A.dim a - 1 do
-      A.set res i (A.unsafe_get a i * A.unsafe_get b i)
-    done;
-    res
-
-  let scalar_add ?res a ~x =
-    let res = match res with
-      | Some r ->
-        if A.dim a <> A.dim r then raise WrongDimension;
-        r
-      | None -> make ~x:0 ~kind:(A.kind a) (A.dim a)
-    in
-    for i = 0 to A.dim a - 1 do
-      A.set res i (A.unsafe_get a i + x)
-    done;
-    res
-
-  let scalar_mult ?res a ~x =
-    let res = match res with
-      | Some r ->
-        if A.dim a <> A.dim r then raise WrongDimension;
-        r
-      | None -> make ~x:0 ~kind:(A.kind a) (A.dim a)
-    in
-    for i = 0 to A.dim a - 1 do
-      A.set res i (A.unsafe_get a i * x)
-    done;
-    res
-
-  let dot_product a b =
-    if A.dim a <> A.dim b then raise WrongDimension;
-    let r = ref 0 in
-    for i = 0 to A.dim a - 1 do
-      r := !r + (A.unsafe_get a i * A.unsafe_get b i)
-    done;
-    !r
-
-  let sum_elt a =
-    let r = ref 0 in
-    for i = 0 to A.dim a - 1 do
-      r := !r + A.unsafe_get a i
-    done;
-    !r
-
-  let product_elt a =
-    let r = ref 1 in
-    for i = 0 to A.dim a - 1 do
-      r := !r * A.unsafe_get a i
-    done;
-    !r
-
-  module Infix = struct
-    let ( + ) a b = add a b
-    let ( * ) a b = mult a b
-
-    let ( +! ) a x = scalar_add a ~x
-    let ( *! ) a x = scalar_mult a ~x
-  end
-
-  include Infix
-end
-
-module Float = struct
-  type elt = float
-  type ('a, 'perm) t = (elt, 'a, 'perm) array_
-
-  let add ?res a b =
-    if A.dim a <> A.dim b then raise WrongDimension;
-    let res = match res with
-      | Some r ->
-        if A.dim a <> A.dim r then raise WrongDimension;
-        r
-      | None -> make ~x:0. ~kind:(A.kind a) (A.dim a)
-    in
-    for i = 0 to A.dim a - 1 do
-      A.set res i (A.unsafe_get a i +. A.unsafe_get b i)
-    done;
-    res
-
-  let mult ?res a b =
-    if A.dim a <> A.dim b then raise WrongDimension;
-    let res = match res with
-      | Some r ->
-        if A.dim a <> A.dim r then raise WrongDimension;
-        r
-      | None -> make ~x:0. ~kind:(A.kind a) (A.dim a)
-    in
-    for i = 0 to A.dim a - 1 do
-      A.set res i (A.unsafe_get a i *. A.unsafe_get b i)
-    done;
-    res
-
-  let scalar_add ?res a ~x =
-    let res = match res with
-      | Some r ->
-        if A.dim a <> A.dim r then raise WrongDimension;
-        r
-      | None -> make ~x:0. ~kind:(A.kind a) (A.dim a)
-    in
-    for i = 0 to A.dim a - 1 do
-      A.set res i (A.unsafe_get a i +. x)
-    done;
-    res
-
-  let scalar_mult ?res a ~x =
-    let res = match res with
-      | Some r ->
-        if A.dim a <> A.dim r then raise WrongDimension;
-        r
-      | None -> make ~x:0. ~kind:(A.kind a) (A.dim a)
-    in
-    for i = 0 to A.dim a - 1 do
-      A.set res i (A.unsafe_get a i *. x)
-    done;
-    res
-
-  let dot_product a b =
-    if A.dim a <> A.dim b then raise WrongDimension;
-    let r = ref 0. in
-    for i = 0 to A.dim a - 1 do
-      r := !r +. (A.unsafe_get a i *. A.unsafe_get b i)
-    done;
-    !r
-
-  let sum_elt a =
-    let r = ref 0. in
-    for i = 0 to A.dim a - 1 do
-      r := !r +. A.unsafe_get a i
-    done;
-    !r
-
-  let product_elt a =
-    let r = ref 1. in
-    for i = 0 to A.dim a - 1 do
-      r := !r *. A.unsafe_get a i
-    done;
-    !r
-
-  module Infix = struct
-    let ( + ) a b = add a b
-    let ( * ) a b = mult a b
-
-    let ( +! ) a x = scalar_add a ~x
-    let ( *! ) a x = scalar_mult a ~x
-  end
-
-  include Infix
-end
-
-let to_list a =
-  let l = foldi (fun acc _ x -> x::acc) [] a in
-  List.rev l
-
-let to_array a =
-  if A.dim a = 0 then [||]
-  else (
-    let b = Array.make (A.dim a) (A.get a 0) in
-    for i = 1 to A.dim a - 1 do
-      Array.unsafe_set b i (A.unsafe_get a i)
-    done;
-    b
-  )
-
-let to_seq a yield = iter a ~f:yield
-
-let of_array ~kind a = A.of_array kind Bigarray.c_layout a
-
-exception OfYojsonError of string
-
-let to_yojson (f:'a -> json) a : json =
-  let l = foldi (fun l _ x -> f x :: l) [] a in
-  `List (List.rev l)
-
-let int_to_yojson i = `Int i
-let int_of_yojson = function
-  | `Int i -> `Ok i
-  | `Float f -> `Ok (int_of_float f)
-  | `String s -> (try `Ok (int_of_string s) with _ -> `Error "expected int")
-  | _ -> `Error "expected int"
-
-let float_to_yojson f = `Float f
-let float_of_yojson = function
-  | `Float f -> `Ok f
-  | `Int i -> `Ok (float_of_int i)
-  | _ -> `Error "expected float"
-
-let of_yojson
-    ~(kind:('a,'b) Bigarray.kind)
-    (f: json -> 'a or_error)
-    (j : json) : ('a,'b,'perm) t or_error
-=
-  let unwrap_ = function
-    | `Ok x -> x
-    | `Error msg -> raise (OfYojsonError msg)
-  in
-  let map_l l = List.map (fun x -> unwrap_ (f x)) l
-  and of_list l =
-    let a = make ~kind (List.length l) in
-    List.iteri (fun i b -> set a i b) l;
-    a
-  in
-  try
-    match j with
-    | `List l -> `Ok (of_list (map_l l))
-    | _ -> raise (OfYojsonError "invalid json (expected list)")
-  with OfYojsonError msg ->
-    `Error msg
-
-
-module View = struct
-  type 'a t = {
-    len : int;
-    view : 'a view
-  }
-  and _ view =
-    | Arr : ('a, _, _) array_ -> 'a view
-    | Map : ('a -> 'b) * 'a t -> 'b view
-    | Map2 : ('a -> 'b -> 'c) * 'a t * 'b t -> 'c view
-    | Select : (int, _, _) array_ * 'a t -> 'a view
-    | SelectA : int array * 'a t -> 'a view
-    | SelectV : int t * 'a t -> 'a view
-    | Raw :
-        ('a, 'b, [>`R]) array_ *
-        (('a, 'b, [>`R]) array_ -> int) *
-        (('a, 'b, [>`R]) array_ -> int -> 'a) ->
-        'a view
-
-  let length t = t.len
-
-  let rec get
-    : type a. a t -> int -> a
-    = fun v i -> match v.view with
-    | Arr a -> A.get a i
-    | Map (f, a) -> f (get a i)
-    | Map2 (f, a1, a2) -> f (get a1 i) (get a2 i)
-    | Select (idx, a) -> get a (A.get idx i)
-    | SelectA (idx, a) -> get a (Array.get idx i)
-    | SelectV (idx, a) -> get a (get idx i)
-    | Raw (a, _, f) -> f a i
-
-  let rec iteri
-    : type a. f:(int -> a -> unit) -> a t -> unit
-    = fun ~f v -> match v.view with
-    | Arr a ->
-      for i = 0 to A.dim a - 1 do
-        f i (A.unsafe_get a i)
-      done
-    | Map (g, a') ->
-      iteri a' ~f:(fun i x -> f i (g x))
-    | Map2 (g, a1, a2) ->
-      iteri a1 ~f:(fun i x -> let y = get a2 i in f i (g x y))
-    | Select (idx, a) ->
-      for i = 0 to A.dim idx - 1 do
-        let j = A.unsafe_get idx i in
-        f i (get a j)
-      done
-    | SelectA (idx, a) ->
-      Array.iteri (fun i j -> f i (get a j)) idx
-    | SelectV (idx, a) ->
-      for i=0 to length idx - 1 do
-        let j = get idx i in
-        f i (get a j)
-      done
-    | Raw (a, len, g) ->
-      for i=0 to len a - 1 do
-        f i (g a i)
-      done
-
-  let of_array a = {len=A.dim a; view=Arr a}
-
-  let map ~f a = {len=length a; view=Map(f, a)}
-  let map2 ~f a b =
-    if length a <> length b then raise WrongDimension;
-    {len=length a; view=Map2(f, a, b)}
-
-  let select ~idx a = {len=A.dim idx; view=Select(idx,a)}
-  let select_a ~idx a = {len=Array.length idx; view=SelectA(idx,a)}
-  let select_view ~idx a = {len=length idx; view=SelectV(idx,a)}
-
-  let foldi f acc a =
-    let acc = ref acc in
-    iteri a ~f:(fun i x -> acc := f !acc i x);
-    !acc
-
-  let raw ~length ~get a = {len=length a; view=Raw (a, length, get) }
-
-  module type S = sig
-    type elt
-    val mult : elt t -> elt t -> elt t
-    val add : elt t -> elt t -> elt t
-    val sum : elt t -> elt
-    val prod : elt t -> elt
-    val add_scalar : elt t -> x:elt -> elt t
-    val mult_scalar : elt t -> x:elt -> elt t
-  end
-
-  module Int = struct
-    type elt = int
-    let add a b = map2 ~f:(+) a b
-    let mult a b = map2 ~f:( * ) a b
-    let sum a = foldi (fun acc _ x -> acc+x) 0 a
-    let prod a = foldi (fun acc _ x -> acc*x) 1 a
-    let add_scalar a ~x = map ~f:(fun y -> x+y) a
-    let mult_scalar a ~x = map ~f:(fun y -> x*y) a
-  end
-
-  module Float = struct
-    type elt = float
-    let add a b = map2 ~f:(+.) a b
-    let mult a b = map2 ~f:( *. ) a b
-    let sum a = foldi (fun acc _ x -> acc+.x) 0. a
-    let prod a = foldi (fun acc _ x -> acc*.x) 1. a
-    let add_scalar a ~x = map ~f:(fun y -> x+.y) a
-    let mult_scalar a ~x = map ~f:(fun y -> x*.y) a
-  end
-
-  let to_array ?res ?kind a =
-    let res = match res, kind with
-      | Some r, None ->
-        if A.dim r <> length a then raise WrongDimension;
-        r
-      | None, Some kind -> A.create kind Bigarray.c_layout (length a)
-      | None, None
-      | Some _, Some _ -> invalid_arg "View.to_array"
-    in
-    iteri a ~f:(fun i x -> A.unsafe_set res i x);
-    res
-end

src/bigarray/CCArray1.mli

@@ -1,371 +0,0 @@
-(*
-copyright (c) 2013-2015, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {1 Bigarrays of dimension 1}
-
-    @deprecated do not use, this was always experimental
-    {b NOTE this module will be removed soon and should not be depended upon}
-
-    {b status: deprecated}
-    @since 0.12 *)
-
-(** {2 used types} *)
-
-type 'a printer = Format.formatter -> 'a -> unit
-type 'a sequence = ('a -> unit) -> unit
-type 'a or_error = [`Ok of 'a | `Error of string]
-type random = Random.State.t
-
-type json = [ `Assoc of (string * json) list
-            | `Bool of bool
-            | `Float of float
-            | `Int of int
-            | `List of json list
-            | `Null
-            | `String of string ]
-type 'a to_json = 'a -> json
-type 'a of_json = json -> 'a or_error
-
-(** {2 Type Declarations} *)
-
-type ('a, 'b, 'perm) t constraint 'perm = [< `R | `W]
-(** Array of OCaml values of type ['a] with C representation of type [b']
-    with permissions ['perm] *)
-
-type ('a, 'b, 'perm) array_ = ('a, 'b, 'perm) t
-
-exception WrongDimension
-(** Raised when arrays do not have expected length *)
-
-(** {2 Basic Operations} *)
-
-val make : ?x:'a -> kind:('a,'b) Bigarray.kind -> int -> ('a, 'b, 'perm) t
-(** New array with undefined elements
-    @param kind the kind of bigarray
-    @param x optional element to fill every slot
-    @param n the number of elements *)
-
-val make_int : int -> (int, Bigarray.int_elt, 'perm) t
-val make_char : int -> (char, Bigarray.int8_unsigned_elt, 'perm) t
-val make_int8s : int -> (int, Bigarray.int8_signed_elt, 'perm) t
-val make_int8u : int -> (int, Bigarray.int8_unsigned_elt, 'perm) t
-val make_int16s : int -> (int, Bigarray.int16_signed_elt, 'perm) t
-val make_int16u : int -> (int, Bigarray.int16_unsigned_elt, 'perm) t
-val make_int32 : int -> (int32, Bigarray.int32_elt, 'perm) t
-val make_int64 : int -> (int64, Bigarray.int64_elt, 'perm) t
-val make_native : int -> (nativeint, Bigarray.nativeint_elt, 'perm) t
-val make_float32 : int -> (float, Bigarray.float32_elt, 'perm) t
-val make_float64 : int -> (float, Bigarray.float64_elt, 'perm) t
-val make_complex32 : int -> (Complex.t, Bigarray.complex32_elt, 'perm) t
-val make_complex64 : int -> (Complex.t, Bigarray.complex64_elt, 'perm) t
-
-val init : kind:('a, 'b) Bigarray.kind -> f:(int -> 'a) -> int -> ('a, 'b, 'perm) t
-(** Initialize with given size and initialization function *)
-
-val of_bigarray : ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t -> ('a, 'b, 'perm) t
-(** Convert from a big array *)
-
-val to_bigarray : ('a, 'b, [`R | `W]) t -> ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t
-(** Obtain the underlying array *)
-
-val ro : ('a, 'b, [>`R]) t -> ('a, 'b, [`R]) t
-(** Change permission (old reference to array might still be mutable!) *)
-
-val wo : ('a, 'b, [>`W]) t -> ('a, 'b, [`W]) t
-(** Change permission *)
-
-val length : (_, _, [>`R]) t -> int
-(** Number of elements *)
-
-val set : ('a, _, [>`W]) t -> int -> 'a -> unit
-(** set n-th element *)
-
-val get : ('a, _, [>`R]) t -> int -> 'a
-(** Get n-th element *)
-
-val fill : ('a, _, [>`W]) t -> 'a -> unit
-(** [fill a x] fills [a] with [x] *)
-
-val sub : ('a, 'b, 'perm) t -> int -> int -> ('a, 'b, 'perm) t
-(** [sub a i len] takes the slice of length [len] starting at offset [i] *)
-
-val blit : ('a, 'b, [>`R]) t -> ('a, 'b, [>`W]) t -> unit
-(** blit the first array to the second *)
-
-val copy : ('a, 'b, [>`R]) t -> ('a, 'b, 'perm) t
-(** Fresh copy *)
-
-val iter : f:('a -> unit) -> ('a, _, [>`R]) t -> unit
-(** [iter a ~f] calls [f v] where [get a i = v] for each [i < length a].
-    It iterates on all bits in increasing order *)
-
-val iteri : f:(int -> 'a -> unit) -> ('a, _, [>`R]) t -> unit
-(** [iteri a ~f] calls [f i v] where [get a i = v] for each [i < length a].
-    It iterates on all elements in increasing order *)
-
-val foldi : ('b -> int -> 'a -> 'b) -> 'b -> ('a, _, [>`R]) t -> 'b
-
-val for_all : f:('a -> bool) -> ('a, _, [>`R]) t -> bool
-
-val exists : f:('a -> bool) -> ('a, _, [>`R]) t -> bool
-
-val pp : 'a printer -> ('a, _, [>`R]) t printer
-(** Print the SDR nicely *)
-
-(** {2 Boolean Vectors} *)
-
-module Bool : sig
-  type ('b, 'perm) t = (int, 'b, 'perm) array_
-  (** A simple bitvector based on some integral type ['b] *)
-
-  val get : (_, [>`R]) t -> int -> bool
-
-  val set : (_, [>`W]) t -> int -> bool -> unit
-
-  val zeroes : int -> (Bigarray.int8_unsigned_elt, 'perm) t
-  val ones : int -> (Bigarray.int8_unsigned_elt, 'perm) t
-
-  val iter_zeroes : f:(int -> unit) -> (_, [>`R]) t -> unit
-  (** [iter_ones ~f a] calls [f i] for every index [i] such that [get a i = false] *)
-
-  val iter_ones : f:(int -> unit) -> (_, [>`R]) t -> unit
-  (** [iter_ones ~f a] calls [f i] for every index [i] such that [get a i = true] *)
-
-  val cardinal : (_, [>`R]) t -> int
-  (** Number of ones *)
-
-  val pp : (_,[>`R]) t printer
-  (** Print the bitvector nicely *)
-
-  (** {6 Operations} *)
-
-  val or_ : ?res:('b, [>`W] as 'perm) t -> ('b, [>`R]) t -> ('b, [>`R]) t -> ('b, 'perm) t
-  (** [or_ a b ~into] puts the boolean "or" of [a] and [b] in [into]
-      expects [length into = max (length a) (length b)]
-      @raise WrongDimension if dimensions do not match *)
-
-  val and_ : ?res:('b, [>`W] as 'perm) t -> ('b, [>`R]) t -> ('b, [>`R]) t -> ('b, 'perm) t
-  (** Boolean conjunction. See {!or} for the parameters *)
-
-  val not_ : ?res:('b, [>`W] as 'perm) t -> ('b, [>`R]) t -> ('b, 'perm) t
-  (** Boolean negation (negation of a 0 becomes a 1) *)
-
-  val mix : ?res:('b, [>`W] as 'perm) t -> ('b, [>`R]) t -> ('b, [>`R]) t -> ('b, 'perm) t
-  (** [mix a b ~into] assumes [length a + length b = length into] and
-      mixes (interleaves) bits of [a] and [b] in [into].
-      @raise WrongDimension if dimensions do not match *)
-
-  val convolution : ?res:('b, [>`W] as 'perm) t -> ('b,[>`R]) t -> by:('b, [>`R]) t -> ('b,'perm) t
-  (** [convolution a ~by:b ~into] assumes [length into = length a >= length b]
-      and computes the boolean convolution of [a] by [b]
-      @raise WrongDimension if dimensions do not match *)
-end
-
-(** {2 Operations} *)
-
-val map :
-  ?res:('a, 'b, ([>`W] as 'perm)) t ->
-  f:('a -> 'a) ->
-  ('a, 'b, [>`R]) t ->
-  ('a, 'b, 'perm) t
-
-val map2 :
-  ?res:('a, 'b, ([>`W] as 'perm)) t ->
-  f:('a -> 'a2 -> 'a) ->
-  ('a, 'b, [>`R]) t ->
-  ('a2, _, [>`R]) t ->
-  ('a, 'b, 'perm) t
-
-val append :
-  ?res:('a, 'b, ([>`W] as 'perm)) t ->
-  ('a, 'b, [>`R]) t ->
-  ('a, 'b, [>`R]) t ->
-  ('a, 'b, 'perm) t
-(** [append a b ~into] assumes [length a + length b = length into] and
-    copies [a] and [b] side by side in [into]
-    @raise WrongDimension if dimensions do not match *)
-
-val filter :
-  ?res:(Bigarray.int8_unsigned_elt, [>`W] as 'perm) Bool.t ->
-  f:('a -> bool) ->
-  ('a, 'b, [>`R]) t ->
-  (Bigarray.int8_unsigned_elt, 'perm) Bool.t
-
-module type S = sig
-  type elt
-  type ('a, 'perm) t = (elt, 'a, 'perm) array_
-
-  val add :
-    ?res:('a, [>`W] as 'perm) t ->
-    ('a, [>`R]) t ->
-    ('a, [>`R]) t ->
-    ('a, 'perm) t
-  (** Elementwise sum
-      @raise WrongDimension if dimensions do not fit *)
-
-  val mult :
-    ?res:('a, [>`W] as 'perm) t ->
-    ('a, [>`R]) t ->
-    ('a, [>`R]) t ->
-    ('a, 'perm) t
-  (** Elementwise product *)
-
-  val scalar_add :
-    ?res:('a, [>`W] as 'perm) t ->
-    ('a, [>`R]) t ->
-    x:elt ->
-    ('a, 'perm) t
-    (** @raise WrongDimension if dimensions do not fit *)
-
-  val scalar_mult :
-    ?res:('a, [>`W] as 'perm) t ->
-    ('a, [>`R]) t ->
-    x:elt ->
-    ('a, 'perm) t
-    (** @raise WrongDimension if dimensions do not fit *)
-
-  val sum_elt : (_, [>`R]) t -> elt
-  (** Efficient sum of elements *)
-
-  val product_elt : (_, [>`R]) t -> elt
-  (** Efficient product of elements *)
-
-  val dot_product : (_, [>`R]) t -> (_, [>`R]) t -> elt
-  (** [dot_product a b] returns [sum_i a(i)*b(i)] with the given
-      sum and product, on [elt].
-      [dot_product a b = sum_elt (product a b)]
-      @raise WrongDimension if [a] and [b] do not have the same size *)
-
-  module Infix : sig
-    val ( * ) : ('a, [>`R]) t -> ('a, [>`R]) t -> ('a, 'perm) t
-    (** Alias to {!mult} *)
-
-    val ( + ) : ('a, [>`R]) t -> (_, [>`R]) t -> ('a, 'perm) t
-    (** Alias to {!add} *)
-
-    val ( *! ) : ('a, [>`R]) t -> elt -> ('a, 'perm) t
-    (** Alias to {!scalar_mult} *)
-
-    val ( +! ) : ('a, [>`R]) t -> elt -> ('a, 'perm) t
-    (** Alias to {!scalar_add} *)
-  end
-
-  include module type of Infix
-end
-
-module Int : S with type elt = int
-
-module Float : S with type elt = float
-
-(** {2 Conversions} *)
-
-val to_list : ('a, _, [>`R]) t -> 'a list
-val to_array : ('a, _, [>`R]) t -> 'a array
-val to_seq : ('a, _, [>`R]) t -> 'a sequence
-
-val of_array : kind:('a, 'b) Bigarray.kind -> 'a array -> ('a, 'b, 'perm) t
-
-(** {2 Serialization} *)
-
-val to_yojson : 'a to_json -> ('a, _, [>`R]) t to_json
-val of_yojson : kind:('a, 'b) Bigarray.kind -> 'a of_json -> ('a, 'b, 'perm) t of_json
-
-val int_to_yojson : int to_json
-val int_of_yojson : int of_json
-val float_to_yojson : float to_json
-val float_of_yojson : float of_json
-
-(** {2 Views} *)
-
-module View : sig
-  type 'a t
-  (** A view on an array or part of an array *)
-
-  val of_array : ('a, _, [>`R]) array_ -> 'a t
-
-  val get : 'a t -> int -> 'a
-  (** [get v i] returns the [i]-th element of [v]. Caution, this is not
-      as cheap as a regular array indexing, and it might involve recursion.
-      @raise Invalid_argument if index out of bounds *)
-
-  val length : _ t -> int
-  (** [length v] is the number of elements of [v] *)
-
-  val map : f:('a -> 'b) -> 'a t -> 'b t
-  (** Map values *)
-
-  val map2 : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
-  (** Map values
-      @raise WrongDimension if lengths do not fit *)
-
-  val select : idx:(int, _, [>`R]) array_ -> 'a t -> 'a t
-  (** [select ~idx v] is the view that has length [length idx]
-      and such that [get (select ~idx a) i = get a (get idx i)] *)
-
-  val select_a : idx:int array -> 'a t -> 'a t
-  (** See {!select} *)
-
-  val select_view : idx:int t -> 'a t -> 'a t
-  (** See {!select} *)
-
-  val foldi : ('b -> int -> 'a -> 'b) -> 'b -> 'a t -> 'b
-  (** Fold on values with their index *)
-
-  val iteri : f:(int -> 'a -> unit) -> 'a t -> unit
-  (** [iteri ~f v] iterates on elements of [v] with their index *)
-
-  module type S = sig
-    type elt
-    val mult : elt t -> elt t -> elt t
-    val add : elt t -> elt t -> elt t
-    val sum : elt t -> elt
-    val prod : elt t -> elt
-    val add_scalar : elt t -> x:elt -> elt t
-    val mult_scalar : elt t -> x:elt -> elt t
-  end
-
-  module Int : sig
-    include S with type elt = int
-  end
-
-  module Float : sig
-    include S with type elt = float
-    (* TODO: more, like trigo functions *)
-  end
-
-  val raw :
-    length:(('a, 'b, [>`R]) array_ -> int) ->
-    get:(('a, 'b, [>`R]) array_ -> int -> 'a) ->
-    ('a, 'b, [>`R]) array_ ->
-    'a t
-
-  val to_array :
-    ?res:('a, 'b, [>`W] as 'perm) array_ ->
-    ?kind:('a, 'b) Bigarray.kind ->
-    'a t ->
-    ('a, 'b, 'perm) array_
-  (** [to_array v] returns a fresh copy of the content of [v].
-      Exactly one of [res] and [kind] must be provided *)
-end

src/bigarray/CCBigstring.ml

@@ -1,213 +0,0 @@
-
-(* This file is free software, part of containers. See file "license" for more details. *)
-
-(** {1 Interface to 1-dimension Bigarrays of bytes (char)} *)
-
-module B = Bigarray.Array1
-
-type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
-
-let create size = B.create Bigarray.char Bigarray.c_layout size
-
-let empty = create 0
-
-let init size f =
-  let a = create size in
-  for i = 0 to size-1 do
-    B.unsafe_set a i (f i)
-  done;
-  a
-
-let fill = B.fill
-
-let get = B.get
-
-let set = B.set
-
-let size = B.dim
-let length = B.dim
-
-let sub = B.sub
-
-let blit a i b j len =
-  let a' = sub a i len in
-  let b' = sub b j len in
-  B.blit a' b'
-
-let copy a =
-  let b = create (size a) in
-  B.blit a b;
-  b
-
-(*$T
-  copy (of_string "abcd") |> to_string = "abcd"
-  *)
-
-let fold f acc a =
-  let rec fold' f acc a i len =
-    if i = len then acc
-    else
-      let acc = f acc (get a i) in
-      fold' f acc a (i+1) len
-  in
-  fold' f acc a 0 (size a)
-
-let iter f a =
-  let n = size a in
-  for i = 0 to n-1 do
-    f (get a i)
-  done
-
-let rec equal_rec a b i len =
-  i = len
-  ||
-  ( get a i = get b i && equal_rec a b (i+1) len)
-
-let equal a b =
-  size a = size b
-  &&
-  equal_rec a b 0 (size a)
-
-(*$Q
-  Q.(pair printable_string printable_string) (fun (s1, s2) -> \
-    let a1 = of_string s1 and a2 = of_string s2 in \
-    equal a1 a2 = (s1 = s2))
-*)
-
-let rec compare_rec a b i len_a len_b =
-  if i=len_a && i=len_b then 0
-  else if i=len_a then -1
-  else if i=len_b then 1
-  else
-    match Char.compare (get a i) (get b i) with
-    | 0 -> compare_rec a b (i+1) len_a len_b
-    | n -> n
-
-let compare a b =
-  compare_rec a b 0 (size a) (size b)
-
-(*$T
-  compare (of_string "abc") (of_string "abd") < 0
-  compare (of_string "abc") (of_string "abcd") < 0
-  compare (of_string "abcd") (of_string "abc") > 0
-  compare (of_string "abc") (of_string "b") < 0
-*)
-
-(*$Q
-  Q.(pair string string) (fun (s1, s2) -> \
-    let a1 = of_string s1 and a2 = of_string s2 in \
-    CCInt.sign (compare a1 a2) = CCInt.sign (String.compare s1 s2))
-*)
-
-(** {2 Conversions} *)
-
-let to_bytes a =
-  Bytes.init (size a) (fun i -> B.unsafe_get a i)
-
-let of_bytes b =
-  init (Bytes.length b) (fun i -> Bytes.get b i)
-
-let of_bytes_slice b i len =
-  if i < 0 || i+len > Bytes.length b then invalid_arg "CCBigstring";
-  init len (fun j -> Bytes.get b (i+j))
-
-let sub_bytes a i len =
-  if i < 0 || i+len > size a then invalid_arg "CCBigstring";
-  Bytes.init len (fun j -> B.get a (i+j))
-
-let blit_to_bytes a i b j len =
-  if i < 0 || j < 0 || i+len > size a || j+len > Bytes.length b
-    then invalid_arg "CCBigstring";
-  for x=0 to len-1 do
-    Bytes.set b (j+x) (B.get a (i+x))
-  done
-
-let blit_of_bytes a i b j len =
-  if i < 0 || j < 0 || i+len > Bytes.length a || j+len > size b
-    then invalid_arg "CCBigstring";
-  for x=0 to len-1 do
-    B.set b (j+x) (Bytes.get a (i+x))
-  done
-
-let to_string a =
-  CCString.init (size a) (fun i -> B.unsafe_get a i)
-
-let of_string s =
-  init (String.length s) (fun i -> String.get s i)
-
-let of_string_slice s i len =
-  if i < 0 || i+len > String.length s then invalid_arg "CCBigstring";
-  init len (fun j -> String.get s (i+j))
-
-let sub_string a i len =
-  if i < 0 || i+len > size a then invalid_arg "CCBigstring";
-  CCString.init len (fun j -> B.get a (i+j))
-
-(*$T
-  of_string_slice "abcde" 1 3 |> to_string = "bcd"
-*)
-
-let blit_of_string a i b j len =
-  if i < 0 || j < 0 || i+len > String.length a || j+len > size b
-    then invalid_arg "CCBigstring";
-  for x=0 to len-1 do
-    B.set b (j+x) (String.get a (i+x))
-  done
-
-type 'a gen = unit -> 'a option
-type 'a sequence = ('a -> unit) -> unit
-type 'a printer = Format.formatter -> 'a -> unit
-
-let to_seq a k = iter k a
-
-let to_gen a =
-  let i = ref 0 in
-  let n = size a in
-  fun () ->
-    if !i = n then None
-    else (
-      let x = get a !i in
-      incr i;
-      Some x
-    )
-
-(*$T
-  of_string "abcd" |> to_gen |> Gen.to_string = "abcd"
-*)
-
-let to_seq_slice a i len =
-  to_seq (sub a i len)
-
-let to_gen_slice a i len =
-  to_gen (sub a i len)
-
-let print out s =
-  Format.pp_print_string out "bigstring \"";
-  iter
-    (function
-      | '\n' -> Format.pp_print_string out "\\n"
-      | '\t' -> Format.pp_print_string out "\\t"
-      | '\\' -> Format.pp_print_string out "\\\\"
-      | c -> Format.pp_print_char out c
-    ) s;
-  Format.pp_print_char out '"'
-
-(** {2 Memory-map} *)
-
-let map_file_descr ?pos ?(shared=false) fd len =
-  B.map_file fd ?pos Bigarray.char Bigarray.c_layout shared len
-
-let with_map_file ?pos ?len ?(mode=0o644) ?(flags=[Open_rdonly]) ?shared name f =
-  let ic = open_in_gen flags mode name in
-  let len = match len with
-    | None -> in_channel_length ic
-    | Some n -> n
-  in
-  let a = map_file_descr ?pos ?shared (Unix.descr_of_in_channel ic) len in
-  try
-    let x = f a in
-    close_in ic;
-    x
-  with e ->
-    close_in ic;
-    raise e

src/bigarray/CCBigstring.mli

@@ -1,116 +0,0 @@
-
-(* This file is free software, part of containers. See file "license" for more details. *)
-
-(** {1 Interface to 1-dimension Bigarrays of bytes (char)}
-
-    @deprecated use the package [bigstring] instead.
-
-    {b status: deprecated, do not use anymore}
-
-    @since 0.7 *)
-
-type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
-
-val create : int -> t
-(** Create a new bigstring of the given size. *)
-
-val empty : t
-(** Empty string *)
-
-val init : int -> (int -> char) -> t
-(** Initialize with the given function (called at every index) *)
-
-val fill : t -> char -> unit
-(** Fill with a single byte *)
-
-val size : t -> int
-(** Number of bytes *)
-
-val length : t -> int
-(** Alias for [size].
-    @since 0.8 *)
-
-val get : t -> int -> char
-
-val set : t -> int -> char -> unit
-
-val blit : t -> int -> t -> int -> int -> unit
-(** Blit a slice of the bigstring into another *)
-
-val copy : t -> t
-(** Copy of the string *)
-
-val sub : t -> int -> int -> t
-(** [sub s i len] takes a slice of length [len] from the string [s], starting
-    at offset [i].
-    @raise Invalid_argument if [i, len] doesn't designate a valid substring *)
-
-val fold : ('a -> char -> 'a) -> 'a -> t -> 'a
-
-val iter : (char -> unit) -> t -> unit
-
-val equal : t -> t -> bool
-
-val compare : t -> t -> int
-(** Lexicographic order *)
-
-(** {2 Conversions} *)
-
-val to_bytes : t -> Bytes.t
-
-val of_bytes : Bytes.t -> t
-
-val of_bytes_slice : Bytes.t -> int -> int -> t
-
-val sub_bytes : t -> int -> int -> Bytes.t
-
-val blit_to_bytes : t -> int -> Bytes.t -> int -> int -> unit
-
-val blit_of_bytes : Bytes.t -> int -> t -> int -> int -> unit
-
-val to_string : t -> string
-
-val of_string : string -> t
-
-val of_string_slice : string -> int -> int -> t
-
-val sub_string : t -> int -> int -> string
-
-val blit_of_string : string -> int -> t -> int -> int -> unit
-
-type 'a gen = unit -> 'a option
-type 'a sequence = ('a -> unit) -> unit
-type 'a printer = Format.formatter -> 'a -> unit
-
-val to_seq : t -> char sequence
-
-val to_gen : t -> char gen
-
-val to_seq_slice : t -> int -> int -> char sequence
-
-val to_gen_slice : t -> int -> int -> char gen
-
-val print : t printer
-(** @since 0.13 *)
-
-(** {2 Memory-map} *)
-
-val with_map_file :
-  ?pos:int64 -> ?len:int -> ?mode:int -> ?flags:open_flag list -> ?shared:bool ->
-  string -> (t -> 'a) -> 'a
-(** [with_map_file name f] maps the file into memory, opening it, and
-    call [f] with a slice [pos.... pos+len] of the bytes of the file
-    where [len] is the length of the file if not provided.
-    When [f] returns, the file is closed.
-    @param pos offset in the file (default 0)
-    @param shared if true, modifications are shared between processes that
-      have mapped this file (requires the filedescr to be open in write mode).
-    @param mode the mode for the file, if it's created
-    @param flags opening flags (default rdonly)
-    see {!Bigarray.Array1.map_file} for more details *)
-
-val map_file_descr : ?pos:int64 -> ?shared:bool -> Unix.file_descr -> int -> t
-(** [map_file_descr descr len] is a lower-level access to an underlying file descriptor.
-    @param shared if true, modifications are shared between processes that
-    have mapped this file (requires the filedescr to be open in write mode).
-    see {!Bigarray.Array1.map_file} for more details *)

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,223 +1,312 @@
-
 (* 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
 type 'a random_gen = Random.State.t -> 'a
-
-(** {2 Abstract Signature} *)
-
-module type S = sig
-  type 'a t
-  (** Array, or sub-array, 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 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 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_exn}, 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 -> 'a -> bool) -> 'a t -> 'a t -> bool
-  (** Forall on pairs of arrays.
-      @raise Invalid_argument if they have distinct lengths *)
-
-  val exists : ('a -> bool) -> 'a t -> bool
-
-  val exists2 : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
-  (** Exists on pairs of arrays.
-      @raise Invalid_argument if they have distinct lengths *)
-
-  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 -> (Buffer.t -> 'a -> unit) ->
-          Buffer.t -> 'a t -> unit
-  (** Print an array of items with printing function *)
-
-  val pp_i: ?sep:string -> (Buffer.t -> int -> 'a -> unit) ->
-            Buffer.t -> 'a t -> unit
-  (** Print an array, giving the printing function both index and item *)
-
-  val print : ?sep:string -> (Format.formatter -> 'a -> unit) ->
-              Format.formatter -> 'a t -> unit
-  (** Print an array of items with printing function *)
-end
+type 'a printer = Format.formatter -> 'a -> unit
 
 (** {2 Arrays} *)
 
-type 'a t = 'a array
+include module type of Array
+(** @inline *)
 
-include S with type 'a t := 'a t
+val empty : 'a t
+(** [empty] is the empty array, physically equal to [[||]]. *)
 
-val map : ('a -> 'b) -> 'a t -> 'b t
+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 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.
+    @since 0.18 *)
+
+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 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
+(** [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
+(** [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 fold_map : ('acc -> 'a -> 'acc * 'b) -> '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 scan_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc t
+(** [scan_left f init a] returns the array
+    [ [|init; f init x0; f (f init a.(0)) a.(1); …|] ].
+
+    @since 1.2, but only
+    @since 2.1 with labels *)
+
+val reverse_in_place : 'a t -> unit
+(** [reverse_in_place a] reverses the array [a] in place. *)
+
+val sorted : ('a -> 'a -> int) -> 'a t -> 'a array
+(** [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 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 f a]
+    appears in [a]. [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 : ('a -> 'a -> int) -> 'a t -> int array
+(** [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]-th element of [a] appears
+    in [sorted f a]. [a] is not modified.
+
+    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)].
+    @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]. Otherwise returns [None].
+    @since 1.3, but only
+    @since 2.1 with labels *)
+
+val find_map_i : (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 : ('a -> bool) -> 'a t -> (int * 'a) option
+(** [find_idx f a] returns [Some (i,x)] where [x] is the [i]-th element of [a],
+    and [f x] holds. Otherwise returns [None].
+    @since 0.3.4 *)
+
+val max : ('a -> 'a -> int) -> 'a t -> 'a option
+(** [max cmp a] returns [None] if [a] is empty, otherwise, returns [Some e] where [e]
+    is a maximum element in [a] with respect to [cmp].
+    @since 3.12 *)
+
+val max_exn : ('a -> 'a -> int) -> 'a t -> 'a
+(** [max_exn cmp a] is like {!max}, but
+    @raise Invalid_argument if [a] is empty.
+    @since 3.12 *)
+
+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 key a] finds the index of the object [key] in the array [a],
+    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 [a]
+    (dichotomic search).
+
+    @return
+    - [`At i] if [cmp a.(i) key = 0] (for some i).
+    - [`All_lower] if all elements of [a] are lower than [key].
+    - [`All_bigger] if all elements of [a] are bigger than [key].
+    - [`Just_after i] if [a.(i) < key < a.(i+1)].
+    - [`Empty] if the array [a] is empty.
+
+    @raise Invalid_argument if the array is found to be unsorted w.r.t [cmp].
+    @since 0.13 *)
+
+val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
+(** [for_all2 f [|a1; …; an|] [|b1; …; bn|]] is [true] if each pair of elements [ai bi]
+    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 exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
+(** [exists2 f [|a1; …; an|] [|b1; …; bn|]] is [true] if any pair of elements [ai bi]
+    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 a] randomly shuffles the array [a], in place. *)
+
+val shuffle_with : Random.State.t -> 'a t -> unit
+(** [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
+(** [random_choose a rs] randomly chooses an element of [a].
+    @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_gen : 'a t -> 'a gen
+(** [to_gen a] returns a [gen] of the elements of an array [a]. *)
+
+(** {2 IO} *)
+
+val pp :
+  ?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 :
+  ?pp_start:unit printer ->
+  ?pp_stop:unit printer ->
+  ?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 rev : 'a t -> 'a t
+(** [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
-    the given predicate will be kept. *)
+(** [filter f a] filters elements out of the array [a]. Only the elements satisfying
+    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 *)
-
-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 *)
+(** [flat_map f a] transforms each element of [a] into an array, then flattens. *)
 
 val except_idx : 'a t -> int -> 'a list
-(** Remove given index, obtaining 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 *)
+(** [except_idx a i] removes the element of [a] at given index [i], and returns
+    the list of the other elements. *)
 
 val random : 'a random_gen -> 'a t random_gen
 val random_non_empty : 'a random_gen -> 'a t random_gen
 val random_len : int -> 'a random_gen -> 'a t random_gen
 
-(** {2 Slices}
-A slice is a part of an array, that requires no copying and shares
-its storage with the original array.
-
-All indexing in a slice is relative to the beginning of a slice, not
-to the underlying array (meaning a slice is effectively like
-a regular array) *)
-
-module Sub : sig
-  type 'a t
-  (** A slice is an array, an offset, and a length *)
-
-  val make : 'a array -> int -> len:int -> 'a t
-  (** Create a slice.
-      @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 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 *)
-
-  include S with type 'a t := 'a t
-end
-
 (** {2 Generic Functions} *)
 
 module type MONO_ARRAY = sig
@@ -225,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
-(** Sort the array, without allocating (eats stack space though). Performance
-    might be lower than {!Array.sort}.
+  cmp:('elt -> 'elt -> int) ->
+  'arr ->
+  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

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

src/core/CCArrayLabels.mli

@@ -0,0 +1,377 @@
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** Array utils (Labeled version of {!CCArray}) *)
+
+type 'a iter = ('a -> unit) -> unit
+(** Fast internal iterator.
+    @since 2.8 *)
+
+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
+
+(** {2 Arrays} *)
+
+include module type of ArrayLabels with module Floatarray = Array.Floatarray
+(** @inline *)
+
+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 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.
+    @since 0.18 *)
+
+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 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
+(** [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
+(** [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 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 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); …|] ].
+
+    @since 1.2, but only
+    @since 2.1 with labels *)
+
+val reverse_in_place : 'a t -> unit
+(** [reverse_in_place a] reverses the array [a] in place. *)
+
+val sorted : f:('a -> 'a -> int) -> 'a t -> 'a array
+(** [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 ~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 f a]
+    appears in [a]. [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 ~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 [a] appears
+    in [sorted f a]. [a] is not modified.
+
+    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)].
+    @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 : f:('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]. 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 ~f a] returns [Some (i,x)] where [x] is the [i]-th element of [a],
+    and [f x] holds. Otherwise returns [None].
+    @since 0.3.4 *)
+
+val max : cmp:('a -> 'a -> int) -> 'a t -> 'a option
+(** [max ~cmp a] returns [None] if [a] is empty, otherwise, returns [Some e] where [e]
+    is a maximum element in [a] with respect to [cmp].
+    @since 3.12 *)
+
+val max_exn : cmp:('a -> 'a -> int) -> 'a t -> 'a
+(** [max_exn ~cmp a] is like {!max}, but
+    @raise Invalid_argument if [a] is empty.
+    @since 3.12 *)
+
+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 a] finds the index of the object [key] in the array [a],
+    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 [a]
+    (dichotomic search).
+
+    @return
+    - [`At i] if [cmp a.(i) key = 0] (for some i).
+    - [`All_lower] if all elements of [a] are lower than [key].
+    - [`All_bigger] if all elements of [a] are bigger than [key].
+    - [`Just_after i] if [a.(i) < key < a.(i+1)].
+    - [`Empty] if the array [a] is empty.
+
+    @raise Invalid_argument if the array is found to be unsorted w.r.t [cmp].
+    @since 0.13 *)
+
+val for_all2 : f:('a -> 'b -> bool) -> 'a t -> 'b t -> bool
+(** [for_all2 ~f [|a1; …; an|] [|b1; …; bn|]] is [true] if each pair of elements [ai bi]
+    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 exists2 : f:('a -> 'b -> bool) -> 'a t -> 'b t -> bool
+(** [exists2 ~f [|a1; …; an|] [|b1; …; bn|]] is [true] if any pair of elements [ai bi]
+    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 : f:('acc -> 'a -> 'b -> 'acc) -> init:'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 iter2 : f:('a -> 'b -> unit) -> 'a t -> 'b t -> unit
+(** [iter2 ~f a b] iterates on the two arrays [a] and [b] stepwise.
+    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 a] randomly shuffles the array [a], in place. *)
+
+val shuffle_with : Random.State.t -> 'a t -> unit
+(** [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
+(** [random_choose a rs] randomly chooses an element of [a].
+    @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_gen : 'a t -> 'a gen
+(** [to_gen a] returns a [gen] of the elements of an array [a]. *)
+
+(** {2 IO} *)
+
+val pp :
+  ?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 :
+  ?pp_start:unit printer ->
+  ?pp_stop:unit printer ->
+  ?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
+(** [map2 ~f a b] applies function [f] to all elements of [a] and [b],
+    and builds an array with the results returned by [f]:
+    [[| 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
+(** [rev a] copies the array [a] and reverses it in place.
+    @since 0.20 *)
+
+val filter : f:('a -> bool) -> 'a t -> 'a t
+(** [filter ~f a] filters elements out of the array [a]. Only the elements satisfying
+    the given predicate [f] will be kept. *)
+
+val filter_map : f:('a -> 'b option) -> 'a t -> 'b t
+(** [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
+(** [flat_map ~f a] transforms each element of [a] into an array, then flattens. *)
+
+val except_idx : 'a t -> int -> 'a list
+(** [except_idx a i] removes the element of [a] at given index [i], and returns
+    the list of the other elements. *)
+
+val random : 'a random_gen -> 'a t random_gen
+val random_non_empty : 'a random_gen -> 'a t random_gen
+val random_len : int -> 'a random_gen -> 'a t random_gen
+
+(** {2 Generic Functions} *)
+
+module type MONO_ARRAY = sig
+  type elt
+  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)[@keep_label]) ->
+  'arr ->
+  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/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 NEXT_RELEASE *)
+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,16 +1,30 @@
-
 (* 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 x = not x
+let if_then_else f g x =
+  if x then
+    f ()
+  else
+    g ()
 
-type 'a printer = Buffer.t -> 'a -> unit
-type 'a formatter = Format.formatter -> 'a -> unit
+let to_int (x : bool) : int =
+  if x then
+    1
+  else
+    0
 
-let pp buf = Printf.bprintf buf "%B"
-let print fmt = Format.pp_print_bool fmt
+let of_int x : t = x <> 0
+
+type 'a printer = Format.formatter -> 'a -> unit
+
+let pp = Format.pp_print_bool

src/core/CCBool.mli

@@ -1,22 +1,31 @@
-
 (* 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
-(** Negation on booleans (functional version of [not]) *)
+val if_then : (unit -> 'a) -> t -> 'a option
+(** [if_then f x] is [Some (f ())] if [x] is true and None otherwise.
+    @since 3.13 *)
 
-type 'a printer = Buffer.t -> 'a -> unit
-type 'a formatter = Format.formatter -> 'a -> unit
+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
 
 val pp : t printer
-(** Printer for booleans *)
-
-val print : t formatter

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