├── .github └── workflows │ ├── gh-pages.yml │ └── main.yml ├── .gitignore ├── .header ├── .ocamlformat ├── CHANGELOG.md ├── CODE_OF_CONDUCT.md ├── LICENSE ├── Makefile ├── README.md ├── benchs ├── dune ├── objsize.ml ├── ref_impl.ml ├── run_bench_hash.ml ├── run_benchs.ml ├── run_benchs.sh └── run_objsize.ml ├── containers-data.opam ├── containers-data.opam.template ├── containers.opam ├── containers.opam.template ├── doc └── containers.md ├── dune ├── dune-project ├── examples ├── ccparse_irclogs_real.cond.ml ├── ccparse_sexp.ml ├── dune ├── id_sexp.ml └── test_data │ ├── benchpress.sexp │ └── irc-logs.txt ├── fuzz ├── ccsexp_csexp_reparse.ml ├── ccsexp_parse_string_does_not_crash.ml ├── ccutf8_string_uchar_to_bytes_is_same_as_simple_version.ml ├── clean.sh ├── dune ├── list.sh ├── run.sh └── run_all.sh ├── run_bench_hash.sh ├── run_benchs.sh ├── src ├── bencode │ ├── containers_bencode.ml │ ├── containers_bencode.mli │ └── dune ├── cbor │ ├── containers_cbor.ml │ ├── containers_cbor.mli │ ├── dune │ └── rfc8949.txt ├── codegen │ ├── containers_codegen.ml │ ├── containers_codegen.mli │ ├── dune │ └── tests │ │ ├── dune │ │ └── emit_tests.ml ├── core │ ├── CCArray.ml │ ├── CCArray.mli │ ├── CCArrayLabels.ml │ ├── CCArrayLabels.mli │ ├── CCAtomic.ml │ ├── CCBool.ml │ ├── CCBool.mli │ ├── CCByte_buffer.ml │ ├── CCByte_buffer.mli │ ├── CCByte_slice.ml │ ├── CCByte_slice.mli │ ├── CCCanonical_sexp.ml │ ├── CCCanonical_sexp.mli │ ├── CCChar.ml │ ├── CCChar.mli │ ├── CCEither.ml │ ├── CCEither.mli │ ├── CCEqual.ml │ ├── CCEqual.mli │ ├── CCEqualLabels.ml │ ├── CCEqualLabels.mli │ ├── CCFloat.ml │ ├── CCFloat.mli │ ├── CCFormat.ml │ ├── CCFormat.mli │ ├── CCFun.ml │ ├── CCFun.mli │ ├── CCHash.ml │ ├── CCHash.mli │ ├── CCHashtbl.ml │ ├── CCHashtbl.mli │ ├── CCHeap.ml │ ├── CCHeap.mli │ ├── CCIO.ml │ ├── CCIO.mli │ ├── CCInt.ml │ ├── CCInt.mli │ ├── CCInt32.ml │ ├── CCInt32.mli │ ├── CCInt64.ml │ ├── CCInt64.mli │ ├── CCList.ml │ ├── CCList.mli │ ├── CCListLabels.ml │ ├── CCListLabels.mli │ ├── CCMap.ml │ ├── CCMap.mli │ ├── CCNativeint.ml │ ├── CCNativeint.mli │ ├── CCOpt.ml │ ├── CCOpt.mli │ ├── CCOption.ml │ ├── CCOption.mli │ ├── CCOrd.ml │ ├── CCOrd.mli │ ├── CCPair.ml │ ├── CCPair.mli │ ├── CCParse.ml │ ├── CCParse.mli │ ├── CCRandom.ml │ ├── CCRandom.mli │ ├── CCRef.ml │ ├── CCRef.mli │ ├── CCResult.ml │ ├── CCResult.mli │ ├── CCSeq.ml │ ├── CCSeq.mli │ ├── CCSet.ml │ ├── CCSet.mli │ ├── CCSexp.ml │ ├── CCSexp.mli │ ├── CCSexp_intf.ml │ ├── CCSexp_lex.mll │ ├── CCString.ml │ ├── CCString.mli │ ├── CCStringLabels.ml │ ├── CCStringLabels.mli │ ├── CCUnit.ml │ ├── CCUtf8_string.ml │ ├── CCUtf8_string.mli │ ├── CCVector.ml │ ├── CCVector.mli │ ├── containers.ml │ ├── containersLabels.ml │ ├── cpp │ │ ├── cpp.ml │ │ └── dune │ ├── dune │ └── tests │ │ ├── check_labelled_mods.ml │ │ ├── dune │ │ ├── test_hash.ml │ │ └── test_random.ml ├── data │ ├── CCBV.ml │ ├── CCBV.mli │ ├── CCBijection.ml │ ├── CCBijection.mli │ ├── CCBitField.ml │ ├── CCBitField.mli │ ├── CCCache.ml │ ├── CCCache.mli │ ├── CCDeque.ml │ ├── CCDeque.mli │ ├── CCFQueue.ml │ ├── CCFQueue.mli │ ├── CCFun_vec.ml │ ├── CCFun_vec.mli │ ├── CCGraph.ml │ ├── CCGraph.mli │ ├── CCHashSet.ml │ ├── CCHashSet.mli │ ├── CCHashTrie.ml │ ├── CCHashTrie.mli │ ├── CCHet.ml │ ├── CCHet.mli │ ├── CCImmutArray.ml │ ├── CCImmutArray.mli │ ├── CCIntMap.ml │ ├── CCIntMap.mli │ ├── CCKTree.ml │ ├── CCKTree.mli │ ├── CCLazy_list.ml │ ├── CCLazy_list.mli │ ├── CCMixmap.ml │ ├── CCMixmap.mli │ ├── CCMixset.ml │ ├── CCMixset.mli │ ├── CCMixtbl.ml │ ├── CCMixtbl.mli │ ├── CCMultiMap.ml │ ├── CCMultiMap.mli │ ├── CCMultiSet.ml │ ├── CCMultiSet.mli │ ├── CCMutHeap.ml │ ├── CCMutHeap.mli │ ├── CCMutHeap_intf.ml │ ├── CCPersistentArray.ml │ ├── CCPersistentArray.mli │ ├── CCPersistentHashtbl.ml │ ├── CCPersistentHashtbl.mli │ ├── CCRAL.ml │ ├── CCRAL.mli │ ├── CCRingBuffer.ml │ ├── CCRingBuffer.mli │ ├── CCSimple_queue.ml │ ├── CCSimple_queue.mli │ ├── CCTrie.ml │ ├── CCTrie.mli │ ├── CCWBTree.ml │ ├── CCWBTree.mli │ ├── CCZipper.ml │ ├── CCZipper.mli │ ├── dune │ └── top │ │ ├── containers_data_top.ml │ │ └── dune ├── dune ├── leb128 │ ├── containers_leb128.ml │ ├── containers_leb128.mli │ ├── dune │ └── stubs.c ├── mdx_runner.ml ├── monomorphic │ ├── CCMonomorphic.ml │ ├── CCMonomorphic.mli │ └── dune ├── pp │ ├── containers_pp.ml │ ├── containers_pp.mli │ └── dune ├── pvec │ ├── containers_pvec.ml │ ├── containers_pvec.mli │ └── dune ├── scc │ ├── containers_scc.ml │ ├── containers_scc.mli │ └── dune ├── testlib │ ├── containers_testlib.ml │ ├── containers_testlib.mli │ └── dune ├── top │ ├── containers_top.ml │ └── dune └── unix │ ├── CCUnix.ml │ ├── CCUnix.mli │ └── dune └── tests ├── cbor ├── appendix_a.json ├── dune └── t_appendix_a.ml ├── core ├── compat │ ├── dune │ └── t_compat.ml ├── dune ├── reg │ ├── dune │ ├── t_reg454.expected │ └── t_reg454.ml ├── t.ml ├── t_IO.ml ├── t_array.ml ├── t_bencode.ml ├── t_bool.ml ├── t_byte_buffer.ml ├── t_canonical_sexp.ml ├── t_cbor.ml ├── t_char.ml ├── t_either.ml ├── t_eq.ml ├── t_float.ml ├── t_format.ml ├── t_fun.ml ├── t_hash.ml ├── t_hashtbl.ml ├── t_heap.ml ├── t_int.ml ├── t_int32.ml ├── t_int64.ml ├── t_list.ml ├── t_map.ml ├── t_nativeint.ml ├── t_option.ml ├── t_ord.ml ├── t_parse.ml ├── t_pp.ml ├── t_random.ml ├── t_result.ml ├── t_seq.ml ├── t_set.ml ├── t_sexp.ml ├── t_string.ml ├── t_unix.ml ├── t_utf8string.ml └── t_vector.ml ├── data ├── dune ├── t.ml ├── t_bijection.ml ├── t_bitfield.ml ├── t_bv.ml ├── t_cache.ml ├── t_deque.ml ├── t_fqueue.ml ├── t_fun_vec.ml ├── t_graph.ml ├── t_hashset.ml ├── t_hashtrie.ml ├── t_het.ml ├── t_immutarray.ml ├── t_intmap.ml ├── t_lazylist.ml ├── t_misc.ml ├── t_mutheap.ml ├── t_persistenthashtbl.ml ├── t_ral.ml ├── t_ringbuffer.ml ├── t_simplequeue.ml ├── t_trie.ml ├── t_wbt.ml └── t_zipper.ml └── pvec ├── dune ├── t.ml └── t_pvec.ml /.github/workflows/gh-pages.yml: -------------------------------------------------------------------------------- 1 | name: github pages 2 | 3 | on: 4 | push: 5 | branches: 6 | - master # Set a branch name to trigger deployment 7 | 8 | jobs: 9 | deploy: 10 | name: Deploy doc 11 | runs-on: ubuntu-latest 12 | steps: 13 | - uses: actions/checkout@main 14 | 15 | - name: Use OCaml 16 | uses: ocaml/setup-ocaml@v3 17 | with: 18 | ocaml-compiler: '5.2' 19 | dune-cache: false 20 | 21 | - name: Deps 22 | run: opam install odig containers containers-data 23 | 24 | - name: Build 25 | run: opam exec -- odig odoc --cache-dir=_doc/ containers containers-data 26 | 27 | - name: Deploy 28 | uses: peaceiris/actions-gh-pages@v3 29 | with: 30 | github_token: ${{ secrets.GITHUB_TOKEN }} 31 | publish_dir: ./_doc/html/ 32 | destination_dir: dev 33 | enable_jekyll: true 34 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: Build and Test 2 | 3 | on: 4 | push: 5 | branches: 6 | - main 7 | pull_request: 8 | 9 | jobs: 10 | run: 11 | name: build 12 | timeout-minutes: 15 13 | strategy: 14 | fail-fast: true 15 | matrix: 16 | os: 17 | - ubuntu-latest 18 | ocaml-compiler: 19 | - '4.08' 20 | - '4.10' 21 | - '4.14' 22 | - '5.2' 23 | - 'ocaml-variants.5.0.0+options,ocaml-option-bytecode-only' 24 | 25 | runs-on: ${{ matrix.os }} 26 | steps: 27 | - uses: actions/checkout@main 28 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 29 | uses: ocaml/setup-ocaml@v3 30 | with: 31 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 32 | dune-cache: true 33 | allow-prerelease-opam: true 34 | - run: opam install -t containers containers-data --deps-only 35 | - run: opam exec -- dune build '@install' 36 | - run: opam exec -- dune runtest --force --profile=release 37 | 38 | compat: 39 | name: build 40 | timeout-minutes: 15 41 | strategy: 42 | fail-fast: true 43 | matrix: 44 | os: 45 | - macos-latest 46 | - ubuntu-latest 47 | #- windows-latest 48 | ocaml-compiler: 49 | - '5.1' 50 | 51 | runs-on: ${{ matrix.os }} 52 | steps: 53 | - uses: actions/checkout@main 54 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 55 | uses: ocaml/setup-ocaml@v3 56 | with: 57 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 58 | dune-cache: true 59 | allow-prerelease-opam: true 60 | - run: | 61 | opam install -t containers --deps-only ; 62 | opam install containers-data --deps-only # no test deps 63 | - run: opam exec -- dune build '@install' 64 | - run: opam exec -- dune runtest -j 1 -p containers --profile=release # test only core on non-ubuntu platform 65 | 66 | format: 67 | name: format 68 | strategy: 69 | matrix: 70 | ocaml-compiler: 71 | - '5.2' 72 | runs-on: 'ubuntu-latest' 73 | steps: 74 | - uses: actions/checkout@main 75 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 76 | uses: ocaml/setup-ocaml@v3 77 | with: 78 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 79 | dune-cache: true 80 | allow-prerelease-opam: true 81 | 82 | - run: opam install ocamlformat.0.26.2 83 | - run: opam exec -- make format-check 84 | 85 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .*.swp 2 | .*.swo 3 | _build 4 | *.native 5 | *.byte 6 | .session 7 | *.docdir 8 | setup.* 9 | *.html 10 | .merlin 11 | *.install 12 | .ignore 13 | _opam 14 | *.exe 15 | fuzz-*-input 16 | fuzz-*-output 17 | fuzz-logs/ 18 | doc/papers 19 | -------------------------------------------------------------------------------- /.header: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version = 0.26.2 2 | profile=conventional 3 | margin=80 4 | if-then-else=k-r 5 | parens-ite=true 6 | parens-tuple=multi-line-only 7 | sequence-style=terminator 8 | type-decl=sparse 9 | break-cases=toplevel 10 | cases-exp-indent=2 11 | field-space=tight-decl 12 | leading-nested-match-parens=true 13 | module-item-spacing=compact 14 | quiet=true 15 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Code of Conduct 2 | 3 | This project has adopted the [OCaml Code of Conduct](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md). 4 | 5 | # Enforcement 6 | 7 | This project follows the OCaml Code of Conduct 8 | [enforcement policy](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md#enforcement). 9 | To report any violations, please contact @c-cube 10 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, Simon Cruanes 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. Redistributions in binary 9 | form must reproduce the above copyright notice, this list of conditions and 10 | the following disclaimer in the documentation and/or other materials 11 | provided with the distribution. 12 | 13 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 14 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 15 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 16 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 17 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 18 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 19 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 20 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 21 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 22 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | PACKAGES=containers,containers-data 2 | 3 | all: build test 4 | 5 | build: 6 | dune build @install -p $(PACKAGES) 7 | 8 | test: build 9 | # run tests in release mode to expose bug in #454 10 | dune runtest --display=quiet --cache=disabled --no-buffer --force --profile=release 11 | 12 | clean: 13 | dune clean 14 | 15 | doc: 16 | dune build @doc 17 | 18 | examples: 19 | dune build examples/id_sexp.exe 20 | 21 | format: 22 | @dune build $(DUNE_OPTS) @fmt --auto-promote 23 | 24 | format-check: 25 | @dune build $(DUNE_OPTS) @fmt --display=quiet 26 | 27 | 28 | VERSION=$(shell awk '/^version:/ {print $$2}' containers.opam) 29 | 30 | update_next_tag: 31 | @echo "update version to $(VERSION)..." 32 | sed -i "s/NEXT_VERSION/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli) 33 | sed -i "s/NEXT_RELEASE/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli) 34 | 35 | WATCH?=@src/check @tests/runtest 36 | watch: 37 | @dune build $(WATCH) -w 38 | 39 | reindent: 40 | @which ocp-indent || ( echo "require ocp-indent" ; exit 1 ) 41 | @find src '(' -name '*.ml' -or -name '*.mli' ')' -type f -print0 | xargs -0 echo "reindenting: " 42 | @find src '(' -name '*.ml' -or -name '*.mli' ')' -type f -print0 | xargs -0 ocp-indent -i 43 | 44 | .PHONY: all test clean build doc update_next_tag watch examples 45 | -------------------------------------------------------------------------------- /benchs/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names run_benchs run_bench_hash run_objsize) 3 | (libraries 4 | containers 5 | containers_pvec 6 | containers-data 7 | benchmark 8 | gen 9 | iter 10 | qcheck 11 | oseq 12 | batteries 13 | base 14 | sek) 15 | (flags :standard -warn-error -3-5 -w -60 -safe-string -color always) 16 | (optional) 17 | (ocamlopt_flags 18 | :standard 19 | -O3 20 | -color 21 | always 22 | -unbox-closures 23 | -unbox-closures-factor 24 | 20)) 25 | -------------------------------------------------------------------------------- /benchs/objsize.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright (C) Jean-Christophe Filliatre *) 4 | (* *) 5 | (* This software is free software; you can redistribute it and/or *) 6 | (* modify it under the terms of the GNU Library General Public *) 7 | (* License version 2.1, with the special exception on linking *) 8 | (* described in file LICENSE. *) 9 | (* *) 10 | (* This software is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) 13 | (* *) 14 | (**************************************************************************) 15 | 16 | (*i $Id$ i*) 17 | 18 | (*i*) 19 | open Obj 20 | (*i*) 21 | 22 | (*s Pointers already visited are stored in a hash-table, where 23 | comparisons are done using physical equality. *) 24 | 25 | module H = Hashtbl.Make (struct 26 | type t = Obj.t 27 | 28 | let equal = ( == ) 29 | let hash o = Hashtbl.hash (magic o : int) 30 | end) 31 | 32 | let node_table = (H.create 257 : unit H.t) 33 | 34 | let in_table o = 35 | try 36 | H.find node_table o; 37 | true 38 | with Not_found -> false 39 | 40 | let add_in_table o = H.add node_table o () 41 | let reset_table () = H.clear node_table 42 | 43 | (*s Objects are traversed recursively, as soon as their tags are less than 44 | [no_scan_tag]. [count] records the numbers of words already visited. *) 45 | 46 | let size_of_double = size (repr 1.0) 47 | let count = ref 0 48 | 49 | let rec traverse t = 50 | if not (in_table t) then ( 51 | add_in_table t; 52 | if is_block t then ( 53 | let n = size t in 54 | let tag = tag t in 55 | if tag < no_scan_tag then ( 56 | count := !count + 1 + n; 57 | for i = 0 to n - 1 do 58 | let f = field t i in 59 | if is_block f then traverse f 60 | done 61 | ) else if tag = string_tag then 62 | count := !count + 1 + n 63 | else if tag = double_tag then 64 | count := !count + size_of_double 65 | else if tag = double_array_tag then 66 | count := !count + 1 + (size_of_double * n) 67 | else 68 | incr count 69 | ) 70 | ) 71 | 72 | (*s Sizes of objects in words and in bytes. The size in bytes is computed 73 | system-independently according to [Sys.word_size]. *) 74 | 75 | let size_w o = 76 | reset_table (); 77 | count := 0; 78 | traverse (repr o); 79 | !count 80 | 81 | let size_b o = size_w o * (Sys.word_size / 8) 82 | let size_kb o = size_w o / (8192 / Sys.word_size) 83 | -------------------------------------------------------------------------------- /benchs/run_bench_hash.ml: -------------------------------------------------------------------------------- 1 | (** Test hash functions *) 2 | 3 | type tree = 4 | | Empty 5 | | Node of int * tree list 6 | 7 | let mk_node i l = Node (i, l) 8 | 9 | let random_tree = 10 | CCRandom.( 11 | fix ~base:(return Empty) 12 | ~subn:[ (int 10, fun sublist -> pure mk_node <*> small_int <*> sublist) ] 13 | (int_range 15 150)) 14 | 15 | let rec eq t1 t2 = 16 | match t1, t2 with 17 | | Empty, Empty -> true 18 | | Node (i1, l1), Node (i2, l2) -> i1 = i2 && CCList.equal eq l1 l2 19 | | Node _, _ | _, Node _ -> false 20 | 21 | let rec hash_tree t = 22 | match t with 23 | | Empty -> CCHash.string "empty" 24 | | Node (i, l) -> CCHash.(combine2 (int i) (list hash_tree l)) 25 | 26 | module H = Hashtbl.Make (struct 27 | type t = tree 28 | 29 | let equal = eq 30 | let hash = hash_tree 31 | end) 32 | 33 | let print_hashcons_stats st = 34 | let open Hashtbl in 35 | Format.printf "tbl stats: %d elements, num buckets: %d, max bucket: %d@." 36 | st.num_bindings st.num_buckets st.max_bucket_length; 37 | Array.iteri 38 | (fun i n -> Format.printf " %d\t buckets have length %d@." n i) 39 | st.bucket_histogram 40 | 41 | let () = 42 | let st = Random.State.make_self_init () in 43 | let n = 50_000 in 44 | Format.printf "generate %d elements...\n" n; 45 | let l = CCRandom.run ~st (CCList.random_len n random_tree) in 46 | (* with custom hashtable *) 47 | Format.printf "### custom hashtable\n"; 48 | let tbl = H.create 256 in 49 | List.iter (fun t -> H.replace tbl t ()) l; 50 | print_hashcons_stats (H.stats tbl); 51 | (* with default hashtable *) 52 | Format.printf "### default hashtable\n"; 53 | let tbl' = Hashtbl.create 256 in 54 | List.iter (fun t -> Hashtbl.replace tbl' t ()) l; 55 | print_hashcons_stats (Hashtbl.stats tbl'); 56 | () 57 | -------------------------------------------------------------------------------- /benchs/run_benchs.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | exec dune exec --profile=release benchs/run_benchs.exe -- $@ 4 | -------------------------------------------------------------------------------- /benchs/run_objsize.ml: -------------------------------------------------------------------------------- 1 | (* module Deque = Core_kernel.Deque *) 2 | module Int_map = CCMap.Make (CCInt) 3 | module Int_set = CCSet.Make (CCInt) 4 | 5 | let dup = CCPair.dup 6 | let id = CCFun.id 7 | let ns n = List.init n CCFun.id 8 | let iter_range n f = List.iter f (ns n) 9 | 10 | let gen_cons x xs = 11 | let saw_x = ref false in 12 | fun () -> 13 | if !saw_x then ( 14 | saw_x := true; 15 | Some x 16 | ) else 17 | xs () 18 | 19 | let front = Sek.front 20 | let dummy = 0 21 | 22 | let types = 23 | [ 24 | ("Stdlib.List", fun n -> Obj.magic @@ ns n); 25 | ("Stdlib.Array", fun n -> Obj.magic @@ Array.init n id); 26 | ( "Stdlib.Hashtbl", 27 | fun n -> Obj.magic @@ CCHashtbl.of_iter Iter.(init dup |> take n) ); 28 | ( "Base.Hashtbl", 29 | fun n -> Obj.magic @@ Base.Hashtbl.Poly.of_alist_exn (List.init n dup) ); 30 | ( "Stdlib.Map", 31 | fun n -> Obj.magic @@ Int_map.of_iter Iter.(init dup |> take n) ); 32 | ( "Stdlib.Set", 33 | fun n -> Obj.magic @@ Int_set.of_iter Iter.(init id |> take n) ); 34 | ("CCFun_vec", fun n -> Obj.magic @@ CCFun_vec.of_list (ns n)); 35 | ("CCRAL", fun n -> Obj.magic @@ CCRAL.of_list (ns n)); 36 | ("BatVect", fun n -> Obj.magic @@ BatVect.of_list (ns n)); 37 | ( "Sek.Persistent", 38 | fun n -> 39 | Obj.magic 40 | @@ List.fold_left 41 | (Sek.Persistent.push front) 42 | (Sek.Persistent.create dummy) 43 | (ns n) ); 44 | ( "Sek.Ephemeral", 45 | fun n -> 46 | Obj.magic 47 | @@ 48 | let c = Sek.Ephemeral.create dummy in 49 | iter_range n (Sek.Ephemeral.push front c); 50 | c ); 51 | ( "CCVector", 52 | fun n -> 53 | Obj.magic 54 | @@ 55 | let c = CCVector.create () in 56 | iter_range n (CCVector.push c); 57 | c ); 58 | (* "Core_kernel.Deque", (fun n -> Obj.magic @@ let c = Deque.create () in iter_range n (Deque.enqueue_back c); c); *) 59 | ( "Base.Queue", 60 | fun n -> 61 | Obj.magic 62 | @@ 63 | let c = Base.Queue.create () in 64 | iter_range n (Base.Queue.enqueue c); 65 | c ); 66 | ( "Stdlib.Queue", 67 | fun n -> 68 | Obj.magic 69 | @@ 70 | let q = Queue.create () in 71 | iter_range n (fun x -> Queue.push x q); 72 | q ); 73 | ("CCQueue", fun n -> Obj.magic @@ CCDeque.of_list (ns n)); 74 | ("Iter", fun n -> Obj.magic @@ List.fold_right Iter.cons (ns n) Iter.empty); 75 | ("Gen", fun n -> Obj.magic @@ List.fold_right gen_cons (ns n) Gen.empty); 76 | ( "Stdlib.Seq", 77 | fun n -> Obj.magic @@ List.fold_right OSeq.cons (ns n) OSeq.empty ); 78 | ] 79 | 80 | let () = 81 | let sizes = [ 0; 1; 10; 100; 1000; 10000 ] in 82 | Printf.printf "%-20s " ""; 83 | sizes |> List.iter (fun n -> Printf.printf "%6d " n); 84 | Printf.printf "\n"; 85 | types 86 | |> List.iter (fun (name, create) -> 87 | Printf.printf "%-20s: " name; 88 | sizes 89 | |> List.iter (fun n -> 90 | let obj = create n in 91 | let size = Objsize.size_w obj in 92 | (* let size = Obj.reachable_words (Obj.repr obj) in *) 93 | Printf.printf "%6d " size); 94 | Printf.printf "\n") 95 | -------------------------------------------------------------------------------- /containers-data.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "3.15" 4 | synopsis: "A set of advanced datatypes for containers" 5 | maintainer: ["c-cube"] 6 | authors: ["c-cube"] 7 | license: "BSD-2-Clause" 8 | tags: ["containers" "RAL" "function" "vector" "okasaki"] 9 | homepage: "https://github.com/c-cube/ocaml-containers/" 10 | bug-reports: "https://github.com/c-cube/ocaml-containers/issues" 11 | depends: [ 12 | "dune" {>= "3.0"} 13 | "ocaml" {>= "4.08"} 14 | "containers" {= version} 15 | "qcheck-core" {>= "0.18" & with-test} 16 | "iter" {with-test} 17 | "gen" {with-test} 18 | "mdx" {with-test} 19 | "odoc" {with-doc} 20 | ] 21 | dev-repo: "git+https://github.com/c-cube/ocaml-containers.git" 22 | build: [ 23 | ["dune" "build" "-p" name "-j" jobs] 24 | ["dune" "build" "@doc" "-p" name ] {with-doc} 25 | ["dune" "runtest" "-p" name "-j" jobs] {with-test & arch != "x86_32" & arch != "arm32"} 26 | ] 27 | -------------------------------------------------------------------------------- /containers-data.opam.template: -------------------------------------------------------------------------------- 1 | build: [ 2 | ["dune" "build" "-p" name "-j" jobs] 3 | ["dune" "build" "@doc" "-p" name ] {with-doc} 4 | ["dune" "runtest" "-p" name "-j" jobs] {with-test & arch != "x86_32" & arch != "arm32"} 5 | ] 6 | -------------------------------------------------------------------------------- /containers.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "3.15" 4 | synopsis: 5 | "A modular, clean and powerful extension of the OCaml standard library" 6 | maintainer: ["c-cube"] 7 | authors: ["c-cube"] 8 | license: "BSD-2-Clause" 9 | tags: ["stdlib" "containers" "iterators" "list" "heap" "queue"] 10 | homepage: "https://github.com/c-cube/ocaml-containers/" 11 | bug-reports: "https://github.com/c-cube/ocaml-containers/issues" 12 | depends: [ 13 | "dune" {>= "3.0"} 14 | "ocaml" {>= "4.08"} 15 | "either" 16 | "dune-configurator" 17 | "qcheck-core" {>= "0.18" & with-test} 18 | "yojson" {with-test} 19 | "iter" {with-test} 20 | "gen" {with-test} 21 | "csexp" {with-test} 22 | "uutf" {with-test} 23 | "odoc" {with-doc} 24 | ] 25 | depopts: ["base-unix" "base-threads"] 26 | dev-repo: "git+https://github.com/c-cube/ocaml-containers.git" 27 | build: [ 28 | ["dune" "build" "-p" name "-j" jobs] 29 | ["dune" "build" "@doc" "-p" name ] {with-doc} 30 | ["dune" "runtest" "-p" name "-j" jobs] {with-test & arch != "x86_32" & arch != "arm32"} 31 | ] 32 | -------------------------------------------------------------------------------- /containers.opam.template: -------------------------------------------------------------------------------- 1 | build: [ 2 | ["dune" "build" "-p" name "-j" jobs] 3 | ["dune" "build" "@doc" "-p" name ] {with-doc} 4 | ["dune" "runtest" "-p" name "-j" jobs] {with-test & arch != "x86_32" & arch != "arm32"} 5 | ] 6 | -------------------------------------------------------------------------------- /doc/containers.md: -------------------------------------------------------------------------------- 1 | # More about OCaml-containers 2 | 3 | This document contains more information on some modules of Containers. 4 | 5 | ```ocaml 6 | # #require "containers";; 7 | ``` 8 | 9 | ## Hash combinators: `CCHash` 10 | 11 | Although OCaml provides polymorphic hash tables (`('a,'b) Hashtbl.t`) 12 | using the polymorphic equality `(=)` and hash `Hashtbl.hash`, it is often 13 | safer and more efficient to use `Hashtbl.Make` (or the extended `CCHashtbl.Make`) 14 | with custom equality and hash functions. 15 | 16 | `CCHash` provides combinators for writing hash functions: 17 | 18 | ```ocaml 19 | # module H = CCHash;; 20 | module H = CCHash 21 | 22 | # let hash1 : (int * bool) list H.t = H.(list (pair int bool));; 23 | val hash1 : (int * bool) list H.t = 24 | ``` 25 | 26 | ```ocaml non-deterministic=output 27 | # hash1 [1, true; 2, false; 3, true];; 28 | - : int = 636041136 29 | # hash1 CCList.(1 -- 1000 |> map (fun i->i, i mod 2 = 0));; 30 | - : int = 845685523 31 | # hash1 CCList.(1 -- 1001 |> map (fun i->i, i mod 2 = 0));; 32 | - : int = 381026697 33 | ``` 34 | 35 | The polymorphic hash function is still present, as `CCHash.poly`. 36 | The functions `CCHash.list_comm` and `CCHash.array_comm` allow to hash 37 | lists and arrays while ignoring the order of elements: all permutations 38 | of the input will have the same hash. 39 | 40 | ## Parser Combinator: `CCParse` 41 | 42 | The module `CCParse` defines basic parser combinators on strings. 43 | Adapting [angstrom's tutorial example](https://github.com/inhabitedtype/angstrom#usage) 44 | gives the following snippet. 45 | Note that backtracking is explicit in `CCParse`, hence 46 | the use of `try_` to allow it in some places. 47 | Explicit memoization with `memo` and `fix_memo` is also possible. 48 | 49 | ```ocaml 50 | open CCParse.Infix 51 | module P = CCParse 52 | 53 | let parens p = P.try_ (P.char '(') *> p <* P.char ')' 54 | let add = P.char '+' *> P.return (+) 55 | let sub = P.char '-' *> P.return (-) 56 | let mul = P.char '*' *> P.return ( * ) 57 | let div = P.char '/' *> P.return ( / ) 58 | let integer = 59 | P.chars1_if (function '0'..'9'->true|_->false) >|= int_of_string 60 | 61 | let chainl1 e op = 62 | P.fix (fun r -> 63 | e >>= fun x -> P.try_ (op <*> P.return x <*> r) <|> P.return x) 64 | 65 | let expr : int P.t = 66 | P.fix (fun expr -> 67 | let factor = parens expr <|> integer in 68 | let term = chainl1 factor (mul <|> div) in 69 | chainl1 term (add <|> sub)) 70 | ``` 71 | 72 | Now we can parse strings using `expr`: 73 | 74 | ```ocaml 75 | # P.parse_string expr "4*1+2";; (* Ok 6 *) 76 | - : int P.or_error = Result.Ok 6 77 | 78 | # P.parse_string expr "4*(1+2)";; (* Ok 12 *) 79 | - : int P.or_error = Result.Ok 12 80 | ``` 81 | 82 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets README.md.corrected) 3 | (deps 4 | (package containers-data) 5 | ./src/mdx_runner.exe) 6 | (enabled_if 7 | (= %{system} "linux")) 8 | (action 9 | (run ./src/mdx_runner.exe))) 10 | 11 | (rule 12 | (alias runtest) 13 | (package containers-data) 14 | (enabled_if 15 | (= %{system} "linux")) 16 | (locks /ctest) 17 | (action 18 | (diff README.md README.md.corrected))) 19 | 20 | (env 21 | (_ 22 | (flags 23 | :standard 24 | -warn-error 25 | -a+8 26 | -w 27 | -32-48-60-70 28 | -w 29 | +a-4-40-42-44-70 30 | -color 31 | always 32 | -safe-string 33 | -strict-sequence) 34 | (ocamlopt_flags 35 | :standard 36 | -O3 37 | -unbox-closures 38 | -unbox-closures-factor 39 | 20 40 | -inline 41 | 100))) 42 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.0) 2 | (name containers) 3 | (generate_opam_files true) 4 | 5 | (version 3.15) 6 | (authors c-cube) 7 | (maintainers c-cube) 8 | (license BSD-2-Clause) 9 | (homepage "https://github.com/c-cube/ocaml-containers/") 10 | (source (github c-cube/ocaml-containers)) 11 | 12 | (package 13 | (name containers) 14 | (synopsis "A modular, clean and powerful extension of the OCaml standard library") 15 | (tags (stdlib containers iterators list heap queue)) 16 | (depends 17 | (ocaml (>= 4.08)) 18 | either 19 | dune-configurator 20 | (qcheck-core (and (>= 0.18) :with-test)) 21 | (yojson :with-test) 22 | (iter :with-test) 23 | (gen :with-test) 24 | (csexp :with-test) 25 | (uutf :with-test) 26 | (odoc :with-doc)) 27 | (depopts 28 | base-unix 29 | base-threads)) 30 | 31 | (package 32 | (name containers-data) 33 | (synopsis "A set of advanced datatypes for containers") 34 | (tags (containers RAL function vector okasaki)) 35 | (depends 36 | (ocaml (>= 4.08)) 37 | (containers (= :version)) 38 | (qcheck-core (and (>= 0.18) :with-test)) 39 | (iter :with-test) 40 | (gen :with-test) 41 | (mdx :with-test) 42 | (odoc :with-doc))) 43 | -------------------------------------------------------------------------------- /examples/ccparse_irclogs_real.cond.ml: -------------------------------------------------------------------------------- 1 | (* parse IRC logs *) 2 | 3 | type datetime = { 4 | year: int; 5 | month: int; 6 | day: int; 7 | hour: int; 8 | min: int; 9 | sec: int; 10 | } 11 | 12 | let pp_datetime out d = 13 | let { year; month; day; hour; min; sec } = d in 14 | CCFormat.( 15 | fprintf out "{y=%d;M=%d;d=%d;h=%d;m=%d;s=%d}" year month day hour min sec) 16 | 17 | type msg = { 18 | timestamp: datetime; 19 | user: string; 20 | msg: string; 21 | } 22 | 23 | let pp_msg out m = 24 | CCFormat.fprintf out "{@[time=%a;@ user=%S;@ msg=%S@]}" pp_datetime 25 | m.timestamp m.user m.msg 26 | 27 | open CCParse 28 | 29 | let p_datetime : datetime t = 30 | let int = U.int in 31 | let* date, time = split_2 ~on_char:' ' in 32 | let* y, m, d = recurse date (split_3 ~on_char:'-') in 33 | let* year = recurse y int in 34 | let* month = recurse m int in 35 | let* day = recurse d int in 36 | let* hour, min, sec = 37 | recurse time 38 | (let* hour = int in 39 | char ':' 40 | *> let* min = int in 41 | char ':' 42 | *> let+ sec = int in 43 | hour, min, sec) 44 | in 45 | let dt = { year; month; day; hour; min; sec } in 46 | return dt 47 | 48 | let p_line = 49 | let* line = lookahead all in 50 | 51 | if Slice.is_empty line then 52 | return None 53 | else 54 | let* fields = split_list ~on_char:'\t' in 55 | match fields with 56 | | [ date; user; rest ] -> 57 | let+ timestamp = recurse date p_datetime 58 | and+ user = 59 | recurse user 60 | (chars_if (function 61 | | '>' -> false 62 | | _ -> true)) 63 | and+ msg = recurse rest (all_str >|= String.trim) in 64 | Some { timestamp; user; msg } 65 | | _ -> 66 | failf "expected 3 fields, got [%s]" 67 | (String.concat ";" @@ List.map String.escaped 68 | @@ List.map Slice.to_string fields) 69 | 70 | let p_file = each_line (parsing "line" p_line) >|= CCList.keep_some 71 | 72 | let () = 73 | let s = CCIO.File.read_exn Sys.argv.(1) in 74 | match parse_string p_file s with 75 | | Ok l -> 76 | Format.printf "parsed:@."; 77 | List.iter (Format.printf "%a@." pp_msg) l 78 | | Error e -> 79 | Format.printf "parse error: %s@." e; 80 | exit 1 81 | -------------------------------------------------------------------------------- /examples/ccparse_sexp.ml: -------------------------------------------------------------------------------- 1 | open CCParse 2 | 3 | type sexp = 4 | | Atom of string 5 | | List of sexp list 6 | 7 | let rec pp_sexpr out (s : sexp) : unit = 8 | match s with 9 | | Atom s -> Format.fprintf out "%S" s 10 | | List l -> 11 | Format.fprintf out "(@["; 12 | List.iteri 13 | (fun i s -> 14 | if i > 0 then Format.fprintf out "@ "; 15 | pp_sexpr out s) 16 | l; 17 | Format.fprintf out "@])" 18 | 19 | let skip_white_and_comments = 20 | fix @@ fun self -> 21 | skip_white 22 | *> try_or (char ';') 23 | ~f:(fun _ -> 24 | skip_chars (function 25 | | '\n' -> false 26 | | _ -> true) 27 | *> self) 28 | ~else_:(return ()) 29 | 30 | let atom = 31 | chars_fold_transduce `Start ~f:(fun acc c -> 32 | match acc, c with 33 | | `Start, '"' -> `Continue `In_quote 34 | | `Start, (' ' | '\t' | '\n' | '(' | ')' | ';') -> `Fail "atom" 35 | | `Normal, (' ' | '\t' | '\n' | '(' | ')' | ';') -> `Stop 36 | | `Done, _ -> `Stop 37 | | `In_quote, '"' -> `Continue `Done (* consume *) 38 | | `In_quote, '\\' -> `Continue `Escape 39 | | `In_quote, c -> `Yield (`In_quote, c) 40 | | `Escape, 'n' -> `Yield (`In_quote, '\n') 41 | | `Escape, 't' -> `Yield (`In_quote, '\t') 42 | | `Escape, '"' -> `Yield (`In_quote, '"') 43 | | `Escape, '\\' -> `Yield (`In_quote, '\\') 44 | | `Escape, c -> `Fail (Printf.sprintf "unknown escape code \\%c" c) 45 | | (`Start | `Normal), c -> `Yield (`Normal, c) 46 | | _ -> `Fail "invalid atom") 47 | >>= function 48 | | `In_quote, _ -> fail "unclosed \"" 49 | | `Escape, _ -> fail "unfinished escape sequence" 50 | | _, "" -> fail "expected non-empty atom" 51 | | _, s -> return (Atom s) 52 | 53 | let psexp = 54 | fix @@ fun self -> 55 | skip_white_and_comments 56 | *> try_or (char '(') 57 | ~f:(fun _ -> 58 | sep ~by:skip_white_and_comments self 59 | <* skip_white_and_comments <* char ')' 60 | >|= fun l -> List l) 61 | ~else_:atom 62 | 63 | let psexp_l = many_until ~until:(skip_white_and_comments *> eoi) psexp 64 | 65 | let () = 66 | let s = CCIO.File.read_exn Sys.argv.(1) in 67 | match parse_string psexp_l s with 68 | | Ok l -> 69 | Format.printf "parsed:@."; 70 | List.iter (Format.printf "%a@." pp_sexpr) l 71 | | Error e -> 72 | Format.printf "parse error: %s@." e; 73 | exit 1 74 | -------------------------------------------------------------------------------- /examples/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names id_sexp ccparse_sexp ccparse_irclogs) 3 | (libraries containers) 4 | (flags :standard -warn-error -a+8)) 5 | 6 | (rule 7 | (alias runtest) 8 | (locks /ctest) 9 | (deps 10 | (source_tree test_data)) 11 | (action 12 | (ignore-stdout 13 | (run ./id_sexp.exe test_data/benchpress.sexp)))) 14 | 15 | (rule 16 | (alias runtest) 17 | (locks /ctest) 18 | (deps 19 | (source_tree test_data)) 20 | (action 21 | (ignore-stdout 22 | (run ./ccparse_sexp.exe test_data/benchpress.sexp)))) 23 | 24 | (rule 25 | (targets ccparse_irclogs.ml) 26 | (enabled_if 27 | (>= %{ocaml_version} "4.08")) 28 | (action 29 | (copy ccparse_irclogs_real.cond.ml %{targets}))) 30 | 31 | (rule 32 | (targets ccparse_irclogs.ml) 33 | (enabled_if 34 | (< %{ocaml_version} "4.08")) 35 | (action 36 | (with-stdout-to 37 | %{targets} 38 | (run echo "let() = print_endline {|ok|}")))) 39 | 40 | (rule 41 | (alias runtest) 42 | (locks /ctest) 43 | (deps 44 | (source_tree test_data)) 45 | (enabled_if 46 | (>= %{ocaml_version} "4.08")) 47 | (action 48 | (ignore-stdout 49 | (run ./ccparse_irclogs.exe test_data/irc-logs.txt)))) 50 | -------------------------------------------------------------------------------- /examples/id_sexp.ml: -------------------------------------------------------------------------------- 1 | let pp_sexp s = 2 | match s with 3 | | Ok l -> List.iter (fun s -> Format.printf "@[%a@]@." CCSexp.pp s) l 4 | | Error msg -> Format.printf "error: %s@." msg 5 | 6 | let () = 7 | match Sys.argv with 8 | | [| _ |] -> 9 | let s = CCSexp.parse_chan_list stdin in 10 | pp_sexp s 11 | | [| _; file |] -> 12 | let s = CCSexp.parse_file_list file in 13 | pp_sexp s 14 | | _ -> failwith "usage: id_sexp [file]" 15 | -------------------------------------------------------------------------------- /examples/test_data/benchpress.sexp: -------------------------------------------------------------------------------- 1 | 2 | (prover 3 | (name msat) 4 | (synopsis "msat for pure sat problems") 5 | (version "git:.") 6 | (sat "^Sat") 7 | (unsat "^Unsat") 8 | (cmd "$cur_dir/../msat.exe -time $timeout $file")) 9 | 10 | (dir 11 | (path $cur_dir) 12 | (pattern ".*\\.cnf") 13 | (expect (const unknown))) 14 | -------------------------------------------------------------------------------- /fuzz/ccsexp_csexp_reparse.ml: -------------------------------------------------------------------------------- 1 | let gen_sexp = 2 | let open! Crowbar in 3 | let ( >|= ) = map in 4 | fix (fun self -> 5 | choose 6 | [ 7 | (([ bytes ] : _ gens) >|= fun s -> `Atom s); 8 | ([ list self ] >|= fun l -> `List l); 9 | ]) 10 | 11 | let () = 12 | Crowbar.add_test ~name:"ccsexp_csexp_reparse" [ gen_sexp ] (fun s -> 13 | let str = CCCanonical_sexp.to_string s in 14 | match CCCanonical_sexp.parse_string_list str with 15 | | Ok [ s2 ] -> assert (s = s2) 16 | | Ok _ -> failwith "wrong number of sexps" 17 | | Error e -> failwith e) 18 | -------------------------------------------------------------------------------- /fuzz/ccsexp_parse_string_does_not_crash.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | Crowbar.add_test ~name:"ccsexp_parse_string_does_not_crash" [ Crowbar.bytes ] 3 | (fun s -> CCSexp.parse_string s |> ignore) 4 | -------------------------------------------------------------------------------- /fuzz/clean.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | script_dir=$(dirname $(readlink -f "$0")) 4 | 5 | rm -r "$script_dir"/../fuzz-*-input 6 | rm -r "$script_dir"/../fuzz-*-output 7 | -------------------------------------------------------------------------------- /fuzz/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (flags 3 | (-w "+a-4-9-29-37-40-42-44-48-50-32-70" -g)) 4 | (names 5 | ccsexp_parse_string_does_not_crash 6 | ccutf8_string_uchar_to_bytes_is_same_as_simple_version 7 | ccsexp_csexp_reparse) 8 | (optional) 9 | (libraries crowbar containers)) 10 | -------------------------------------------------------------------------------- /fuzz/list.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | script_dir=$(dirname $(readlink -f "$0")) 4 | 5 | echo "Building" 6 | 7 | dune build @all 8 | 9 | echo "" 10 | 11 | echo "Fuzzing tests available:" 12 | 13 | for file in "$script_dir"/../_build/default/fuzz/*.exe; do 14 | echo "- "$(basename $file | sed 's/\.exe$//') 15 | done 16 | -------------------------------------------------------------------------------- /fuzz/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | script_dir=$(dirname $(readlink -f "$0")) 4 | 5 | skip_build=$2 6 | 7 | if [[ "$skip_build" != "skip_build" ]]; then 8 | echo "Building" 9 | 10 | dune build @all 11 | fi 12 | 13 | if [[ "$1" == "" ]]; then 14 | echo "Please enter a fuzzing test to run" 15 | exit 1 16 | fi 17 | 18 | name=$(echo "$1" | sed 's/\.exe$//' | sed 's/\.ml$//') 19 | 20 | echo "Creating input directory" 21 | 22 | input_dir="$script_dir"/../"fuzz-""$name""-input" 23 | 24 | output_dir="$script_dir"/../"fuzz-""$name""-output" 25 | 26 | mkdir -p "$input_dir" 27 | 28 | echo "abcd" > "$input_dir"/dummy 29 | 30 | if [ -d "$output_dir" ]; then 31 | afl-fuzz -t 1000 -i - -o "$output_dir" "$script_dir"/../_build/default/fuzz/"$name".exe @@ 32 | else 33 | mkdir -p "$output_dir" 34 | 35 | afl-fuzz -t 1000 -i "$input_dir" -o "$output_dir" "$script_dir"/../_build/default/fuzz/"$name".exe @@ 36 | fi 37 | 38 | -------------------------------------------------------------------------------- /fuzz/run_all.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | cpu_count=$(grep -c ^processor /proc/cpuinfo) 4 | 5 | simul_test_count=$[cpu_count-1] 6 | 7 | test_timeout="10m" 8 | 9 | script_dir=$(dirname $(readlink -f "$0")) 10 | 11 | log_dir="$script_dir"/../fuzz-logs 12 | 13 | echo "Building" 14 | 15 | dune build @all 16 | 17 | echo "" 18 | 19 | start_date=$(date "+%Y-%m-%d %H:%M") 20 | start_time=$(date "+%s") 21 | 22 | names=() 23 | 24 | i=0 25 | for file in "$script_dir"/../_build/default/fuzz/*.exe; do 26 | name=$(basename $file | sed 's/\.exe$//') 27 | names[$i]=$name 28 | i=$[i+1] 29 | done 30 | 31 | test_count=${#names[@]} 32 | 33 | echo "Fuzzing tests available:" 34 | 35 | for name in ${names[@]}; do 36 | echo "- "$name 37 | done 38 | 39 | echo "" 40 | echo "Fuzzing start time:" $start_date 41 | echo "" 42 | 43 | echo "Starting $test_count tests" 44 | echo "" 45 | 46 | mkdir -p "$log_dir" 47 | 48 | i=0 49 | while (( $i < $test_count )); do 50 | if (( $test_count - $i >= $simul_test_count )); then 51 | tests_to_run=$simul_test_count 52 | else 53 | tests_to_run=$[test_count - i] 54 | fi 55 | 56 | echo "Running $tests_to_run tests in parallel" 57 | 58 | for (( c=0; c < $tests_to_run; c++ )); do 59 | name=${names[$i]} 60 | if [[ "$name" != "" ]]; then 61 | echo " Starting $name" 62 | 63 | (AFL_NO_UI=1 timeout "$test_timeout" "$script_dir"/run.sh "$name" skip_build > "$log_dir"/"$name".log) & 64 | 65 | i=$[i+1] 66 | fi 67 | done 68 | 69 | echo "Waiting for $test_timeout" 70 | 71 | sleep $test_timeout 72 | 73 | echo "Terminating tests" 74 | 75 | pkill afl-fuzz 76 | 77 | sleep 5 78 | 79 | echo "" 80 | echo "$[test_count - i] / $test_count tests remaining" 81 | echo "" 82 | done 83 | 84 | end_date=$(date "+%Y-%m-%d %H:%M") 85 | end_time=$(date "+%s") 86 | 87 | echo "" 88 | echo "Test end:" $end_date 89 | 90 | echo "" 91 | 92 | echo "Time elapsed:" $[(end_time - start_time) / 60] "minutes" 93 | 94 | test_fail_count=0 95 | tests_failed=() 96 | 97 | for name in ${names[@]}; do 98 | output_dir="$script_dir"/../"fuzz-""$name""-output" 99 | 100 | crashes_dir="$output_dir"/crashes 101 | 102 | if [ -z "$(ls -A $crashes_dir)" ]; then 103 | # crashes dir is empty 104 | : 105 | else 106 | # crashes dir is not empty 107 | test_fail_count=$[$test_fail_count + 1] 108 | tests_failed+=("$name") 109 | fi 110 | done 111 | 112 | echo "========================================" 113 | 114 | if [[ $test_fail_count == 0 ]]; then 115 | echo "All $test_count tests passed" 116 | exit_code=0 117 | else 118 | echo "$test_fail_count tests failed" 119 | echo "" 120 | echo "List of tests failed :" 121 | for t in ${tests_failed[@]}; do 122 | echo " "$t 123 | done 124 | exit_code=1 125 | fi 126 | 127 | -------------------------------------------------------------------------------- /run_bench_hash.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | OPTS="--profile=release --display=quiet" 4 | exec dune exec $OPTS -- benchs/run_benchs_hash.exe $@ 5 | -------------------------------------------------------------------------------- /run_benchs.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | OPTS="--profile=release --display=quiet" 4 | exec dune exec $OPTS -- benchs/run_benchs.exe $@ 5 | -------------------------------------------------------------------------------- /src/bencode/containers_bencode.mli: -------------------------------------------------------------------------------- 1 | (** Basic Bencode decoder/encoder. 2 | 3 | See https://en.wikipedia.org/wiki/Bencode . 4 | 5 | @since 3.8 *) 6 | 7 | module Str_map : module type of Map.Make (String) 8 | 9 | type t = 10 | | Int of int64 11 | | String of string 12 | | List of t list 13 | | Map of t Str_map.t 14 | 15 | val equal : t -> t -> bool 16 | val hash : t -> int 17 | 18 | val pp_debug : Format.formatter -> t -> unit 19 | (** Printer for diagnostic/human consumption *) 20 | 21 | val to_string_debug : t -> string 22 | val int : int -> t 23 | val int64 : int64 -> t 24 | val string : string -> t 25 | val list : t list -> t 26 | val map_of_list : (string * t) list -> t 27 | val map : t Str_map.t -> t 28 | 29 | (** Encoding *) 30 | module Encode : sig 31 | val to_string : t -> string 32 | val to_buffer : Buffer.t -> t -> unit 33 | val to_chan : out_channel -> t -> unit 34 | val to_fmt : Format.formatter -> t -> unit 35 | end 36 | 37 | (** Decoding *) 38 | module Decode : sig 39 | val of_string : string -> t option 40 | 41 | val of_string_exn : string -> t 42 | (** Parse string. 43 | @raise Failure if the string is not valid bencode. *) 44 | end 45 | -------------------------------------------------------------------------------- /src/bencode/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name containers_bencode) 3 | (public_name containers.bencode) 4 | (libraries containers) 5 | (synopsis "Bencode codec for containers (the format for bittorrent files)")) 6 | -------------------------------------------------------------------------------- /src/cbor/containers_cbor.mli: -------------------------------------------------------------------------------- 1 | (** CBOR encoder/decoder. 2 | 3 | The type is chosen to be compatible with ocaml-cbor. 4 | See {{: https://www.rfc-editor.org/rfc/rfc8949.html} the RFC}. 5 | 6 | {b note} this is experimental. 7 | 8 | @since 3.9 9 | *) 10 | 11 | type t = 12 | [ `Null 13 | | `Undefined 14 | | `Simple of int 15 | | `Bool of bool 16 | | `Int of int64 17 | | `Float of float 18 | | `Bytes of string 19 | | `Text of string 20 | | `Array of t list 21 | | `Map of (t * t) list 22 | | `Tag of int * t 23 | ] 24 | 25 | val pp_diagnostic : t CCFormat.printer 26 | val to_string_diagnostic : t -> string 27 | val encode : ?buf:Buffer.t -> t -> string 28 | val decode : string -> (t, string) result 29 | 30 | val decode_exn : string -> t 31 | (** Like {!decode}. 32 | @raise Failure if the string isn't valid *) 33 | -------------------------------------------------------------------------------- /src/cbor/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name containers_cbor) 3 | (libraries containers) 4 | (preprocess 5 | (action 6 | (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))) 7 | (public_name containers.cbor)) 8 | -------------------------------------------------------------------------------- /src/codegen/containers_codegen.mli: -------------------------------------------------------------------------------- 1 | (** {1 Code generators} 2 | 3 | The code generator library is designed to be used from a build system 4 | (for example, from [dune]) to generate efficient code for features 5 | that are harder to provide at runtime. 6 | 7 | The idea is that the build system should invoke some OCaml script 8 | that depends on [containers.codegen]; the script uses the DSL below 9 | to describe what code to generate (e.g. a description of a bitfield type) 10 | and emits a [.ml] file (and possibly a [.mli] file). 11 | 12 | For example, the build script might contain: 13 | 14 | {[ 15 | module CG = Containers_codegen 16 | let () = 17 | let module B = CG.Bitfield in 18 | let b = B.make ~name:"t" () in 19 | B.field_bit b "x"; 20 | B.field_bit b "y"; 21 | B.field_bit b "z"; 22 | B.field_int b ~width:5 "foo"; 23 | 24 | CG.emit_file "foo.mli" [B.gen_mli b]; 25 | CG.emit_file "foo.ml" [B.gen_ml b]; 26 | () 27 | ]} 28 | 29 | and this will produce [foo.ml] and [foo.mli] with a bitfield containing 30 | [x], [y], and [z]. 31 | 32 | *) 33 | 34 | module Fmt = CCFormat 35 | 36 | type code 37 | 38 | (** {2 Representation of OCaml code} *) 39 | module Code : sig 40 | type t = code 41 | 42 | val pp : t Fmt.printer 43 | val to_string : t -> string 44 | val mk_pp : unit Fmt.printer -> t 45 | val mk_str : string -> t 46 | val in_struct : string -> t list -> t 47 | val in_sig : string -> t list -> t 48 | end 49 | 50 | (** {2 Generate efficient bitfields that fit in an integer} *) 51 | module Bitfield : sig 52 | type t 53 | 54 | val make : ?emit_failure_if_too_wide:bool -> name:string -> unit -> t 55 | (** Make a new bitfield with the given name. 56 | @param name the name of the generated type 57 | @param emit_failure_if_too_wide if true, generated code includes a runtime 58 | assertion that {!Sys.int_size} is wide enough to support this type *) 59 | 60 | val field_bit : t -> string -> unit 61 | (** [field_bit ty name] adds a field of size [1] to the bitfield [ty], 62 | with name [name]. The generate code will provide get/set for 63 | a boolean. *) 64 | 65 | val field_int : t -> width:int -> string -> unit 66 | (** [field_int ty name ~width] adds a field of size [width] to 67 | the bitfield with name [name]. 68 | The accessors will be for integers of [width] bits, and the 69 | setter might assert that the provided integer fits. *) 70 | 71 | val total_width : t -> int 72 | (** Total width in bits of the given bitfield. *) 73 | 74 | val gen_mli : t -> code 75 | (** Generate code for the type signature for the given bitfield *) 76 | 77 | val gen_ml : t -> code 78 | (** Generate code for the implementation for the given bitfield *) 79 | end 80 | 81 | val emit_file : string -> code list -> unit 82 | (** [emit_file file cs] emits code fragments [cs] into the given file 83 | at path [file] *) 84 | 85 | val emit_chan : out_channel -> code list -> unit 86 | val emit_string : code list -> string 87 | -------------------------------------------------------------------------------- /src/codegen/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name containers_codegen) 3 | (public_name containers.codegen) 4 | (synopsis "code generators for Containers") 5 | (libraries containers) 6 | (flags :standard -warn-error -a+8)) 7 | -------------------------------------------------------------------------------- /src/codegen/tests/dune: -------------------------------------------------------------------------------- 1 | ; emit tests 2 | 3 | (executable 4 | (name emit_tests) 5 | (modules emit_tests) 6 | (flags :standard -warn-error -a+8) 7 | (libraries containers containers.codegen)) 8 | 9 | (rule 10 | (targets test_bitfield.ml test_bitfield.mli) 11 | (action 12 | (run ./emit_tests.exe))) 13 | 14 | ; run tests 15 | 16 | (executables 17 | (names test_bitfield) 18 | (modules test_bitfield) 19 | (flags :standard -warn-error -a+8) 20 | (libraries containers)) 21 | 22 | (rule 23 | (alias runtest) 24 | (action 25 | (run ./test_bitfield.exe))) 26 | -------------------------------------------------------------------------------- /src/codegen/tests/emit_tests.ml: -------------------------------------------------------------------------------- 1 | module CG = Containers_codegen 2 | module Vec = CCVector 3 | 4 | let spf = Printf.sprintf 5 | 6 | let emit_bitfields () = 7 | let module B = CG.Bitfield in 8 | let ml = Vec.create () in 9 | let mli = Vec.create () in 10 | (let b = B.make ~name:"t" () in 11 | B.field_bit b "x"; 12 | B.field_bit b "y"; 13 | B.field_bit b "z"; 14 | B.field_int b ~width:5 "foo"; 15 | 16 | Vec.push ml (CG.Code.in_struct "T1" [ B.gen_ml b ]); 17 | Vec.push mli (CG.Code.in_sig "T1" [ B.gen_mli b ]); 18 | (* check width *) 19 | Vec.push ml 20 | (CG.Code.mk_str (spf "let() = assert (%d = 8);;" (B.total_width b))); 21 | ()); 22 | 23 | Vec.push ml 24 | @@ CG.Code.mk_str 25 | {| 26 | let n_fails = ref 0;; 27 | at_exit (fun () -> if !n_fails > 0 then exit 1);; 28 | let assert_true line s = 29 | if not s then ( incr n_fails; Printf.eprintf "test failure at %d\n%!" line);; 30 | 31 | |}; 32 | 33 | let test1 = 34 | {| 35 | assert_true __LINE__ T1.(get_y (empty |> set_x true |> set_y true |> set_foo 10));; 36 | assert_true __LINE__ T1.(get_x (empty |> set_x true |> set_y true |> set_foo 10));; 37 | assert_true __LINE__ T1.(get_y (empty |> set_x true |> set_z true 38 | |> set_y false |> set_x false |> set_y true));; 39 | assert_true __LINE__ T1.(get_z (empty |> set_z true));; 40 | assert_true __LINE__ T1.(not @@ get_x (empty |> set_z true));; 41 | assert_true __LINE__ T1.(not @@ get_y (empty |> set_z true |> set_x true));; 42 | assert_true __LINE__ T1.(not @@ get_y (empty |> set_z true |> set_foo 18));; 43 | (* check width of foo *) 44 | assert_true __LINE__ T1.(try ignore (empty |> set_foo (1 lsl 6)); false with _ -> true);; 45 | assert_true __LINE__ T1.(12 = get_foo (empty |> set_x true |> set_foo 12 |> set_x false));; 46 | assert_true __LINE__ T1.(24 = get_foo (empty |> set_y true |> set_foo 24 |> set_z true));; 47 | |} 48 | |> CG.Code.mk_str 49 | in 50 | Vec.push ml test1; 51 | 52 | CG.emit_file "test_bitfield.ml" (Vec.to_list ml); 53 | CG.emit_file "test_bitfield.mli" (Vec.to_list mli); 54 | () 55 | 56 | let () = 57 | emit_bitfields (); 58 | () 59 | -------------------------------------------------------------------------------- /src/core/CCArrayLabels.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | include CCArray 4 | -------------------------------------------------------------------------------- /src/core/CCAtomic.ml: -------------------------------------------------------------------------------- 1 | [@@@ifge 4.12] 2 | 3 | include Atomic 4 | 5 | [@@@else_] 6 | 7 | open Stdlib (* for == *) 8 | 9 | type 'a t = { mutable x: 'a } 10 | 11 | let[@inline] make x = { x } 12 | let[@inline] get { x } = x 13 | let[@inline] set r x = r.x <- x 14 | 15 | let[@inline never] exchange r x = 16 | (* atomic *) 17 | let y = r.x in 18 | r.x <- x; 19 | (* atomic *) 20 | y 21 | 22 | let[@inline never] compare_and_set r seen v = 23 | (* atomic *) 24 | if r.x == seen then ( 25 | r.x <- v; 26 | (* atomic *) 27 | true 28 | ) else 29 | false 30 | 31 | let[@inline never] fetch_and_add r x = 32 | (* atomic *) 33 | let v = r.x in 34 | r.x <- x + r.x; 35 | (* atomic *) 36 | v 37 | 38 | let[@inline never] incr r = 39 | (* atomic *) 40 | r.x <- 1 + r.x 41 | (* atomic *) 42 | 43 | let[@inline never] decr r = 44 | (* atomic *) 45 | r.x <- r.x - 1 46 | (* atomic *) 47 | 48 | [@@@endif] 49 | -------------------------------------------------------------------------------- /src/core/CCBool.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | type t = bool 4 | 5 | let equal (a : bool) b = Stdlib.( = ) a b 6 | let compare (a : bool) b = Stdlib.compare a b 7 | 8 | let if_then f x = 9 | if x then 10 | Some (f ()) 11 | else 12 | None 13 | 14 | let if_then_else f g x = 15 | if x then 16 | f () 17 | else 18 | g () 19 | 20 | let to_int (x : bool) : int = 21 | if x then 22 | 1 23 | else 24 | 0 25 | 26 | let of_int x : t = x <> 0 27 | 28 | type 'a printer = Format.formatter -> 'a -> unit 29 | 30 | let pp = Format.pp_print_bool 31 | -------------------------------------------------------------------------------- /src/core/CCBool.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Basic Bool functions *) 4 | 5 | type t = bool 6 | 7 | val compare : t -> t -> int 8 | (** [compare b1 b2] is the total ordering on booleans [b1] and [b2], similar to {!Stdlib.compare}. *) 9 | 10 | val equal : t -> t -> bool 11 | (** [equal b1 b2] is [true] if [b1] and [b2] are the same. *) 12 | 13 | val if_then : (unit -> 'a) -> t -> 'a option 14 | (** [if_then f x] is [Some (f ())] if [x] is true and None otherwise. 15 | @since 3.13 *) 16 | 17 | val if_then_else : (unit -> 'a) -> (unit -> 'a) -> t -> 'a 18 | (** [if_then_else f g x] is [f ()] if [x] is true and [g ()] otherwise. 19 | @since 3.13 *) 20 | 21 | val to_int : t -> int 22 | (** [to_int true = 1], [to_int false = 0]. 23 | @since 2.7 *) 24 | 25 | val of_int : int -> t 26 | (** [of_int i] is the same as [i <> 0] 27 | @since 2.7 *) 28 | 29 | type 'a printer = Format.formatter -> 'a -> unit 30 | 31 | val pp : t printer 32 | -------------------------------------------------------------------------------- /src/core/CCByte_slice.ml: -------------------------------------------------------------------------------- 1 | type t = { 2 | bs: bytes; 3 | mutable off: int; 4 | mutable len: int; 5 | } 6 | 7 | let show self = Printf.sprintf "" self.len 8 | let pp out self = Format.pp_print_string out (show self) 9 | 10 | let create ?(off = 0) ?len bs = 11 | let len = 12 | match len with 13 | | None -> Bytes.length bs - off 14 | | Some n -> 15 | if n < 0 || off + n > Bytes.length bs then 16 | invalid_arg "Bslice: invalid length"; 17 | n 18 | in 19 | { bs; off; len } 20 | 21 | let[@inline] unsafe_of_string ?off ?len s = 22 | create ?off ?len (Bytes.unsafe_of_string s) 23 | 24 | let[@inline] len self = self.len 25 | let[@inline] contents self = Bytes.sub_string self.bs self.off self.len 26 | 27 | let[@inline] get self i : char = 28 | if i >= self.len then invalid_arg "Bslice: out of bound access"; 29 | Bytes.unsafe_get self.bs (self.off + i) 30 | 31 | let[@inline] set self i c : unit = 32 | if i >= self.len then invalid_arg "Bslice: out of bound access"; 33 | Bytes.unsafe_set self.bs (self.off + i) c 34 | 35 | let sub self off len = 36 | if off + len > self.len then invalid_arg "Bslice: invalid length"; 37 | { bs = self.bs; off = self.off + off; len } 38 | 39 | let[@inline] consume self n : unit = 40 | if n > self.len then invalid_arg "Bslice: consuming too many bytes"; 41 | self.off <- self.off + n; 42 | self.len <- self.len - n 43 | -------------------------------------------------------------------------------- /src/core/CCByte_slice.mli: -------------------------------------------------------------------------------- 1 | (** A simple byte slice. 2 | 3 | @since 3.13.1 *) 4 | 5 | type t = { 6 | bs: bytes; (** The bytes, potentially shared between many slices *) 7 | mutable off: int; (** Offset in [bs] *) 8 | mutable len: int; 9 | (** Length of the slice. Valid indices are [bs[off]…bs[off+len-1]], 10 | inclusive. *) 11 | } 12 | 13 | val show : t -> string 14 | (** Simple printer (summary, doesn't show the content) *) 15 | 16 | val pp : Format.formatter -> t -> unit 17 | (** Simple printer (summary, doesn't show the content) *) 18 | 19 | val create : ?off:int -> ?len:int -> bytes -> t 20 | (** [create bs] creates a slice of [bs]. 21 | @param off optional starting offset 22 | @param len length of the slice *) 23 | 24 | val unsafe_of_string : ?off:int -> ?len:int -> string -> t 25 | (** [unsafe_of_string s] makes a slice from a string. 26 | This is unsafe because mutating the bytes is forbidden 27 | (just like with {!Bytes.unsafe_of_string} *) 28 | 29 | val len : t -> int 30 | (** Access the length *) 31 | 32 | val get : t -> int -> char 33 | (** [get sl i] gets the [i]-th byte of the slice. Same as [sl.bs.[sl.off + i]]. 34 | @raise Invalid_argument if out of bounds. *) 35 | 36 | val set : t -> int -> char -> unit 37 | (** [set sl i c] sets the [i]-th byte to [c]. 38 | @raise Invalid_argument if out of bounds. *) 39 | 40 | val consume : t -> int -> unit 41 | (** [consume sl n] moves the offset forward by [n] bytes, and 42 | reduces [len] by [n] bytes. *) 43 | 44 | val contents : t -> string 45 | (** A copy of the contents of the slice. Allocates. *) 46 | 47 | val sub : t -> int -> int -> t 48 | (** [sub sl off len] makes a new slice with the same 49 | backing [bs]. *) 50 | -------------------------------------------------------------------------------- /src/core/CCCanonical_sexp.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Canonical S-expressions 4 | 5 | See {{: https://en.wikipedia.org/wiki/Canonical_S-expressions} wikipedia}. 6 | These S-expressions are binary safe. 7 | 8 | @since 3.3 9 | *) 10 | 11 | type 'a or_error = ('a, string) result 12 | type 'a gen = unit -> 'a option 13 | 14 | module type SEXP = CCSexp_intf.BASIC_SEXP 15 | module type S = CCSexp_intf.S0 16 | 17 | (** {2 Parser and printer} *) 18 | module Make (Sexp : SEXP) : S with type t = Sexp.t 19 | 20 | (** {2 Basics} *) 21 | 22 | type t = 23 | [ `Atom of string 24 | | `List of t list 25 | ] 26 | (** A simple, structural representation of S-expressions. 27 | Compatible with {!CCSexp}. *) 28 | 29 | include S with type t := t 30 | 31 | val equal : t -> t -> bool 32 | val compare : t -> t -> int 33 | val atom : string -> t 34 | -------------------------------------------------------------------------------- /src/core/CCChar.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** {1 Utils around char} 4 | 5 | @since 0.14 *) 6 | 7 | include Char 8 | 9 | let pp_buf = Buffer.add_char 10 | let pp = Format.pp_print_char 11 | let of_int_exn = Char.chr 12 | let of_int c = try Some (of_int_exn c) with Invalid_argument _ -> None 13 | let to_int = Char.code 14 | let to_string c = String.make 1 c 15 | 16 | module Infix = struct 17 | let ( = ) : t -> t -> bool = Stdlib.( = ) 18 | let ( <> ) : t -> t -> bool = Stdlib.( <> ) 19 | let ( < ) : t -> t -> bool = Stdlib.( < ) 20 | let ( > ) : t -> t -> bool = Stdlib.( > ) 21 | let ( <= ) : t -> t -> bool = Stdlib.( <= ) 22 | let ( >= ) : t -> t -> bool = Stdlib.( >= ) 23 | end 24 | 25 | include Infix 26 | 27 | let is_uppercase_ascii c = c > '\064' && c < '\091' 28 | let is_lowercase_ascii c = c > '\096' && c < '\123' 29 | 30 | let is_letter_ascii c = 31 | (is_lowercase_ascii [@inlined]) c || (is_uppercase_ascii [@inlined]) c 32 | 33 | let is_digit_ascii c = c > '\047' && c < '\058' 34 | let is_whitespace_ascii c = c = '\032' || (c > '\008' && c < '\014') 35 | -------------------------------------------------------------------------------- /src/core/CCChar.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Utils around char 4 | 5 | @since 0.14 *) 6 | 7 | (** @inline *) 8 | include module type of struct 9 | include Char 10 | end 11 | 12 | val compare : t -> t -> int 13 | (** The comparison function for characters, with the same specification as 14 | {!Stdlib.compare}. Along with the type [t], this function [compare] 15 | allows the module [Char] to be passed as argument to the functors 16 | {!Set.Make} and {!Map.Make}. *) 17 | 18 | val of_int_exn : int -> t 19 | (** Alias to {!Char.chr}. 20 | Return the character with the given ASCII code. 21 | @raise Invalid_argument if the int is not within [0 … 255]. 22 | @since 1.0 *) 23 | 24 | val of_int : int -> t option 25 | (** Safe version of {!of_int_exn}. 26 | @since 1.0 *) 27 | 28 | val to_int : t -> int 29 | (** Alias to {!Char.code}. 30 | Return the ASCII code of the argument. 31 | @since 1.0 *) 32 | 33 | val to_string : t -> string 34 | (** [to_string c] returns a string containing [c] 35 | @since 2.7 *) 36 | 37 | val pp_buf : Buffer.t -> t -> unit 38 | (** Renamed from [pp] since 2.0. *) 39 | 40 | val pp : Format.formatter -> t -> unit 41 | (** Renamed from [print] since 2.0. *) 42 | 43 | val is_uppercase_ascii : t -> bool 44 | (** [is_uppercase_ascii c] is true exactly when [c] is an 45 | uppercase ASCII character, i.e. ['\064'] < [c] < ['\091']. 46 | @since 3.16 *) 47 | 48 | val is_lowercase_ascii : t -> bool 49 | (** [is_lowercase_ascii c] is true exactly when [c] is a 50 | lowercase ASCII character, i.e. ['\096'] < [c] < ['\123']. 51 | @since 3.16 *) 52 | 53 | val is_letter_ascii : t -> bool 54 | (** [is_letter_ascii c] is true exactly when [c] is an ASCII 55 | letter, i.e. [is_uppercase_ascii c || is_lowercase_ascii c]. 56 | @since 3.16 *) 57 | 58 | val is_digit_ascii : t -> bool 59 | (** [is_digit_ascii c] is true exactly when [c] is an 60 | ASCII digit, i.e. ['\047'] < [c] < ['\058']. 61 | @since 3.16 *) 62 | 63 | val is_whitespace_ascii : t -> bool 64 | (** [is_whitespace_ascii c] is true exactly when [c] is an ASCII 65 | whitespace character as defined by Unicode, i.e. either [c = ' '] 66 | or ['\008'] < [c] < ['\014']. 67 | @since 3.16 *) 68 | 69 | (** {2 Infix Operators} 70 | 71 | @since 3.3 *) 72 | 73 | module Infix : sig 74 | val ( = ) : t -> t -> bool 75 | (** @since 3.3 *) 76 | 77 | val ( <> ) : t -> t -> bool 78 | (** @since 3.3 *) 79 | 80 | val ( < ) : t -> t -> bool 81 | (** @since 3.3 *) 82 | 83 | val ( > ) : t -> t -> bool 84 | (** @since 3.3 *) 85 | 86 | val ( <= ) : t -> t -> bool 87 | (** @since 3.3 *) 88 | 89 | val ( >= ) : t -> t -> bool 90 | (** @since 3.3 *) 91 | end 92 | 93 | include module type of Infix 94 | -------------------------------------------------------------------------------- /src/core/CCEither.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | type 'a iter = ('a -> unit) -> unit 4 | type 'a equal = 'a -> 'a -> bool 5 | type 'a ord = 'a -> 'a -> int 6 | type 'a printer = Format.formatter -> 'a -> unit 7 | 8 | (** {2 Basics} *) 9 | 10 | type ('a, 'b) t = ('a, 'b) Either.t = 11 | | Left of 'a 12 | | Right of 'b 13 | 14 | let left l = Left l 15 | let right r = Right r 16 | 17 | let is_left = function 18 | | Left _ -> true 19 | | Right _ -> false 20 | 21 | let is_right = function 22 | | Left _ -> false 23 | | Right _ -> true 24 | 25 | let find_left = function 26 | | Left l -> Some l 27 | | Right _ -> None 28 | 29 | let find_right = function 30 | | Left _ -> None 31 | | Right r -> Some r 32 | 33 | let map_left f = function 34 | | Left l -> Left (f l) 35 | | Right r -> Right r 36 | 37 | let map_right f = function 38 | | Left l -> Left l 39 | | Right r -> Right (f r) 40 | 41 | let map ~left ~right = function 42 | | Left l -> Left (left l) 43 | | Right r -> Right (right r) 44 | 45 | let fold ~left ~right = function 46 | | Left l -> left l 47 | | Right r -> right r 48 | 49 | let iter = fold 50 | let for_all = fold 51 | 52 | let equal ~left ~right e1 e2 = 53 | match e1, e2 with 54 | | Left l1, Left l2 -> left l1 l2 55 | | Right r1, Right r2 -> right r1 r2 56 | | _ -> false 57 | 58 | let compare ~left ~right e1 e2 = 59 | match e1, e2 with 60 | | Left _, Right _ -> -1 61 | | Right _, Left _ -> 1 62 | | Left l1, Left l2 -> left l1 l2 63 | | Right r1, Right r2 -> right r1 r2 64 | 65 | (** {2 IO} *) 66 | 67 | let pp ~left ~right fmt = function 68 | | Left l -> Format.fprintf fmt "Left@ (@[%a@])" left l 69 | | Right r -> Format.fprintf fmt "Right@ (@[%a@])" right r 70 | -------------------------------------------------------------------------------- /src/core/CCEither.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Either Monad 4 | 5 | Module that is compatible with Either from OCaml 4.12 but can be use with any 6 | ocaml version compatible with container 7 | 8 | @since 3.2 9 | *) 10 | 11 | type 'a iter = ('a -> unit) -> unit 12 | type 'a equal = 'a -> 'a -> bool 13 | type 'a ord = 'a -> 'a -> int 14 | type 'a printer = Format.formatter -> 'a -> unit 15 | 16 | (** {2 Basics} *) 17 | 18 | type ('a, 'b) t = ('a, 'b) Either.t = 19 | | Left of 'a 20 | | Right of 'b 21 | 22 | val left : 'a -> ('a, 'b) t 23 | (** [left l] is [Left l] *) 24 | 25 | val right : 'b -> ('a, 'b) t 26 | (** [right r] is [Right r] *) 27 | 28 | val is_left : ('a, 'b) t -> bool 29 | (** [is_left x] checks if [x = Left _] *) 30 | 31 | val is_right : ('a, 'b) t -> bool 32 | (** [is_right x] checks if [x = Right _] *) 33 | 34 | val find_left : ('a, 'b) t -> 'a option 35 | (** [find_left x] returns [l] if [x = Left l] and [None] otherwise. *) 36 | 37 | val find_right : ('a, 'b) t -> 'b option 38 | (** [find_right x] returns [r] if [x = Left r] and [None] otherwise. *) 39 | 40 | val map_left : ('a1 -> 'a2) -> ('a1, 'b) t -> ('a2, 'b) t 41 | (** Map of the Left variant. *) 42 | 43 | val map_right : ('b1 -> 'b2) -> ('a, 'b1) t -> ('a, 'b2) t 44 | (** Map of the Right variant. *) 45 | 46 | val map : 47 | left:('a1 -> 'a2) -> right:('b1 -> 'b2) -> ('a1, 'b1) t -> ('a2, 'b2) t 48 | (** Map using [left] or [right]. *) 49 | 50 | val fold : left:('a -> 'c) -> right:('b -> 'c) -> ('a, 'b) t -> 'c 51 | (** Fold using [left] or [right]. *) 52 | 53 | val iter : left:('a -> unit) -> right:('b -> unit) -> ('a, 'b) t -> unit 54 | (** Iter using [left] or [right]. *) 55 | 56 | val for_all : left:('a -> bool) -> right:('b -> bool) -> ('a, 'b) t -> bool 57 | (** Check some property on [Left] or [Right] variant. *) 58 | 59 | val equal : 60 | left:('a -> 'a -> bool) -> 61 | right:('b -> 'b -> bool) -> 62 | ('a, 'b) t -> 63 | ('a, 'b) t -> 64 | bool 65 | 66 | val compare : 67 | left:('a -> 'a -> int) -> 68 | right:('b -> 'b -> int) -> 69 | ('a, 'b) t -> 70 | ('a, 'b) t -> 71 | int 72 | 73 | (** {2 IO} *) 74 | 75 | val pp : left:'a printer -> right:'b printer -> ('a, 'b) t printer 76 | (** Pretty printer. *) 77 | -------------------------------------------------------------------------------- /src/core/CCEqual.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** {1 Equality Combinators} *) 4 | 5 | type 'a t = 'a -> 'a -> bool 6 | 7 | let poly = Stdlib.( = ) 8 | let physical = Stdlib.( == ) 9 | let int : int t = ( = ) 10 | let string : string t = Stdlib.( = ) 11 | let bool : bool t = Stdlib.( = ) 12 | let float : float t = Stdlib.( = ) 13 | let unit () () = true 14 | 15 | let rec list f l1 l2 = 16 | match l1, l2 with 17 | | [], [] -> true 18 | | [], _ | _, [] -> false 19 | | x1 :: l1', x2 :: l2' -> f x1 x2 && list f l1' l2' 20 | 21 | let array eq a b = 22 | let rec aux i = 23 | if i = Array.length a then 24 | true 25 | else 26 | eq a.(i) b.(i) && aux (i + 1) 27 | in 28 | Array.length a = Array.length b && aux 0 29 | 30 | let option f o1 o2 = 31 | match o1, o2 with 32 | | None, None -> true 33 | | Some _, None | None, Some _ -> false 34 | | Some x, Some y -> f x y 35 | 36 | let pair f g (x1, y1) (x2, y2) = f x1 x2 && g y1 y2 37 | let triple f g h (x1, y1, z1) (x2, y2, z2) = f x1 x2 && g y1 y2 && h z1 z2 38 | let map f eq x y = eq (f x) (f y) 39 | let always_eq _ _ = true 40 | let never_eq _ _ = false 41 | 42 | module Infix = struct 43 | let ( >|= ) x f = map f x 44 | end 45 | 46 | include Infix 47 | -------------------------------------------------------------------------------- /src/core/CCEqual.mli: -------------------------------------------------------------------------------- 1 | (* AUTOGENERATED FROM CCEqualLabels.mli *) 2 | 3 | (* This file is free software, part of containers. See file "license" for more details. *) 4 | 5 | (** Equality Combinators *) 6 | 7 | (** @since 1.2 *) 8 | 9 | type 'a t = 'a -> 'a -> bool 10 | (** Equality function. Must be transitive, symmetric, and reflexive. *) 11 | 12 | val poly : 'a t 13 | (** Standard polymorphic equality. *) 14 | 15 | val physical : 'a t 16 | (** Standard physical equality. 17 | @since 2.0 *) 18 | 19 | val int : int t 20 | val string : string t 21 | val bool : bool t 22 | val float : float t 23 | val unit : unit t 24 | val list : 'a t -> 'a list t 25 | val array : 'a t -> 'a array t 26 | val option : 'a t -> 'a option t 27 | val pair : 'a t -> 'b t -> ('a * 'b) t 28 | val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t 29 | 30 | val map : ('a -> 'b) -> 'b t -> 'a t 31 | (** [map f eq] is the equality function that, given objects [x] and [y], 32 | projects [x] and [y] using [f] (e.g. using a record field) and then 33 | compares those projections with [eq]. 34 | Example: 35 | [map fst int] compares values of type [(int * 'a)] by their 36 | first component. *) 37 | 38 | val always_eq : _ t 39 | (** Always returns true. All values are equal. 40 | @since 3.0 *) 41 | 42 | val never_eq : _ t 43 | (** Always returns false. No values are, so this 44 | is not even reflexive (i.e. [x=x] is false). 45 | Be careful! 46 | @since 3.0 *) 47 | 48 | module Infix : sig 49 | val ( >|= ) : 'b t -> ('a -> 'b) -> 'a t 50 | (** Infix equivalent of {!map}. *) 51 | end 52 | 53 | include module type of Infix 54 | -------------------------------------------------------------------------------- /src/core/CCEqualLabels.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | include CCEqual 4 | -------------------------------------------------------------------------------- /src/core/CCEqualLabels.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Equality Combinators (Labeled version of {!CCEqual}) *) 4 | 5 | (** @since 1.2 *) 6 | 7 | type 'a t = 'a -> 'a -> bool 8 | (** Equality function. Must be transitive, symmetric, and reflexive. *) 9 | 10 | val poly : 'a t 11 | (** Standard polymorphic equality. *) 12 | 13 | val physical : 'a t 14 | (** Standard physical equality. 15 | @since 2.0 *) 16 | 17 | val int : int t 18 | val string : string t 19 | val bool : bool t 20 | val float : float t 21 | val unit : unit t 22 | val list : 'a t -> 'a list t 23 | val array : 'a t -> 'a array t 24 | val option : 'a t -> 'a option t 25 | val pair : 'a t -> 'b t -> ('a * 'b) t 26 | val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t 27 | 28 | val map : f:('a -> 'b) -> 'b t -> 'a t 29 | (** [map f eq] is the equality function that, given objects [x] and [y], 30 | projects [x] and [y] using [f] (e.g. using a record field) and then 31 | compares those projections with [eq]. 32 | Example: 33 | [map fst int] compares values of type [(int * 'a)] by their 34 | first component. *) 35 | 36 | val always_eq : _ t 37 | (** Always returns true. All values are equal. 38 | @since 3.9 *) 39 | 40 | val never_eq : _ t 41 | (** Always returns false. No values are, so this 42 | is not even reflexive (i.e. [x=x] is false). 43 | Be careful! 44 | @since 3.9 *) 45 | 46 | module Infix : sig 47 | val ( >|= ) : 'b t -> ('a -> 'b) -> 'a t 48 | (** Infix equivalent of {!map}. *) 49 | end 50 | 51 | include module type of Infix 52 | -------------------------------------------------------------------------------- /src/core/CCFloat.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | type t = float 4 | 5 | type fpclass = Stdlib.fpclass = 6 | | FP_normal 7 | | FP_subnormal 8 | | FP_zero 9 | | FP_infinite 10 | | FP_nan 11 | 12 | module Infix = struct 13 | let ( = ) : t -> t -> bool = Stdlib.( = ) 14 | let ( <> ) : t -> t -> bool = Stdlib.( <> ) 15 | let ( < ) : t -> t -> bool = Stdlib.( < ) 16 | let ( > ) : t -> t -> bool = Stdlib.( > ) 17 | let ( <= ) : t -> t -> bool = Stdlib.( <= ) 18 | let ( >= ) : t -> t -> bool = Stdlib.( >= ) 19 | let ( ~- ) : t -> t = Stdlib.( ~-. ) 20 | let ( + ) : t -> t -> t = Stdlib.( +. ) 21 | let ( - ) : t -> t -> t = Stdlib.( -. ) 22 | let ( * ) : t -> t -> t = Stdlib.( *. ) 23 | let ( / ) : t -> t -> t = Stdlib.( /. ) 24 | end 25 | 26 | include Infix 27 | 28 | [@@@ocaml.warning "-32"] 29 | 30 | let nan = Stdlib.nan 31 | let infinity = Stdlib.infinity 32 | let neg_infinity = Stdlib.neg_infinity 33 | let max_value = infinity 34 | let min_value = neg_infinity 35 | let max_finite_value = Stdlib.max_float 36 | let epsilon = Stdlib.epsilon_float 37 | let pi = 0x1.921fb54442d18p+1 38 | let is_nan x = Stdlib.(classify_float x = Stdlib.FP_nan) 39 | let add = ( +. ) 40 | let sub = ( -. ) 41 | let mul = ( *. ) 42 | let div = ( /. ) 43 | let neg = ( ~-. ) 44 | let abs = Stdlib.abs_float 45 | let scale = ( *. ) 46 | 47 | let min (x : t) y = 48 | match Stdlib.classify_float x, Stdlib.classify_float y with 49 | | FP_nan, _ -> y 50 | | _, FP_nan -> x 51 | | _ -> 52 | if x < y then 53 | x 54 | else 55 | y 56 | 57 | let max (x : t) y = 58 | match Stdlib.classify_float x, Stdlib.classify_float y with 59 | | FP_nan, _ -> y 60 | | _, FP_nan -> x 61 | | _ -> 62 | if x > y then 63 | x 64 | else 65 | y 66 | 67 | let equal (a : float) b = a = b 68 | let hash : t -> int = Hashtbl.hash 69 | let compare (a : float) b = Stdlib.compare a b 70 | 71 | [@@@ocaml.warning "+32"] 72 | 73 | type 'a printer = Format.formatter -> 'a -> unit 74 | type 'a random_gen = Random.State.t -> 'a 75 | 76 | let pp = Format.pp_print_float 77 | 78 | let fsign a = 79 | if is_nan a then 80 | nan 81 | else if a = 0. then 82 | a 83 | else 84 | Stdlib.copysign 1. a 85 | 86 | exception TrapNaN of string 87 | 88 | let sign_exn (a : float) = 89 | if is_nan a then 90 | raise (TrapNaN "sign_exn") 91 | else 92 | compare a 0. 93 | 94 | let round x = 95 | let low = floor x in 96 | let high = ceil x in 97 | if x -. low > high -. x then 98 | high 99 | else 100 | low 101 | 102 | let to_int (a : float) = Stdlib.int_of_float a 103 | let of_int (a : int) = Stdlib.float_of_int a 104 | let to_string (a : float) = Stdlib.string_of_float a 105 | let of_string_exn (a : string) = Stdlib.float_of_string a 106 | 107 | let of_string_opt (a : string) = 108 | try Some (Stdlib.float_of_string a) with Failure _ -> None 109 | 110 | let random n st = Random.State.float st n 111 | let random_small = random 100.0 112 | let random_range i j st = i +. random (j -. i) st 113 | let equal_precision ~epsilon a b = abs_float (a -. b) < epsilon 114 | let classify = Stdlib.classify_float 115 | -------------------------------------------------------------------------------- /src/core/CCFun.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** {1 Basic Functions} *) 4 | 5 | (* import standard implementations, if any *) 6 | 7 | include Sys 8 | include Stdlib 9 | include Fun 10 | 11 | let[@inline] and_pred f g x = f x && g x 12 | let[@inline] or_pred f g x = f x || g x 13 | let[@inline] compose f g x = g (f x) 14 | let[@inline] compose_binop f g x y = g (f x) (f y) 15 | let[@inline] curry f x y = f (x, y) 16 | let[@inline] uncurry f (x, y) = f x y 17 | 18 | let[@inline] tap f x = 19 | ignore (f x); 20 | x 21 | 22 | let lexicographic f1 f2 x y = 23 | let c = f1 x y in 24 | if c <> 0 then 25 | c 26 | else 27 | f2 x y 28 | 29 | let finally ~h ~f = 30 | try 31 | let x = f () in 32 | ignore (h ()); 33 | x 34 | with e -> 35 | ignore (h ()); 36 | raise e 37 | 38 | let finally1 ~h f x = 39 | try 40 | let res = f x in 41 | ignore (h ()); 42 | res 43 | with e -> 44 | ignore (h ()); 45 | raise e 46 | 47 | let finally2 ~h f x y = 48 | try 49 | let res = f x y in 50 | ignore (h ()); 51 | res 52 | with e -> 53 | ignore (h ()); 54 | raise e 55 | 56 | let rec iterate n f x = 57 | if n < 0 then 58 | invalid_arg "CCFun.iterate" 59 | else if n = 0 then 60 | x 61 | else 62 | iterate (n - 1) f (f x) 63 | 64 | let[@inline] with_return (type ret) f : ret = 65 | let exception E of ret in 66 | let return x = raise_notrace (E x) in 67 | match f return with 68 | | res -> res 69 | | exception E res -> res 70 | 71 | module Infix = struct 72 | (* default implem for some operators *) 73 | let ( %> ) = compose 74 | let[@inline] ( % ) f g x = f (g x) 75 | let ( let@ ) = ( @@ ) 76 | let ( ||> ) (a, b) f = f a b 77 | let ( |||> ) (a, b, c) f = f a b c 78 | end 79 | 80 | include Infix 81 | 82 | module Monad (X : sig 83 | type t 84 | end) = 85 | struct 86 | type 'a t = X.t -> 'a 87 | 88 | let[@inline] return x _ = x 89 | let[@inline] ( >|= ) f g x = g (f x) 90 | let[@inline] ( >>= ) f g x = g (f x) x 91 | end 92 | [@@inline] 93 | -------------------------------------------------------------------------------- /src/core/CCHash.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Hash combinators 4 | 5 | The API of this module is stable as per semantic versioning, like the 6 | rest of containers. However the exact implementation of hashing function 7 | can change and should not be relied on (i.e. hashing a value always 8 | returns the same integer {b within a run of a program}, not 9 | across versions of OCaml and Containers). 10 | *) 11 | 12 | (** {2 Definitions} *) 13 | 14 | type hash = int 15 | (** A hash value is a positive integer. *) 16 | 17 | type 'a t = 'a -> hash 18 | (** A hash function for values of type ['a]. *) 19 | 20 | val const : hash -> _ t 21 | (** [const h] hashes any value into [h]. Use with caution!. *) 22 | 23 | val const0 : _ t 24 | (** Always return 0. Useful for ignoring elements. 25 | Example: [Hash.(pair string const0)] will map pairs [("a", 1)] 26 | and [("a", 2)] to the same hash, but not the same as [("b", 1)]. 27 | @since 1.5 *) 28 | 29 | val int : int t 30 | val bool : bool t 31 | val char : char t 32 | val int32 : int32 t 33 | val int64 : int64 t 34 | val nativeint : nativeint t 35 | 36 | val slice : string -> int -> int t 37 | (** [slice s i len state] hashes the slice [i, …, i+len-1] of [s] 38 | into [state]. *) 39 | 40 | val bytes : bytes t 41 | (** Hash a byte array. 42 | @since 3.5 *) 43 | 44 | val string : string t 45 | val list : 'a t -> 'a list t 46 | val array : 'a t -> 'a array t 47 | val opt : 'a t -> 'a option t 48 | val pair : 'a t -> 'b t -> ('a * 'b) t 49 | val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t 50 | val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t 51 | 52 | val map : ('a -> 'b) -> 'b t -> 'a t 53 | (** [map f h] is the hasher that takes [x], 54 | and uses [h] to hash [f x]. 55 | 56 | For example: 57 | {[ 58 | module Str_set = Set.Make(String) 59 | 60 | let hash_str_set : Str_set.t CCHash.t = CCHash.(map Str_set.to_seq @@ seq string) 61 | ]} 62 | 63 | @since 3.5 *) 64 | 65 | val if_ : bool -> 'a t -> 'a t -> 'a t 66 | (** Decide which hash function to use depending on the boolean. *) 67 | 68 | val poly : 'a t 69 | (** [poly x] is [Hashtbl.hash x]. 70 | The regular polymorphic hash function. *) 71 | 72 | val list_comm : 'a t -> 'a list t 73 | (** Commutative version of {!list}. Lists that are equal up to permutation 74 | will have the same hash. 75 | @since 1.0 *) 76 | 77 | val array_comm : 'a t -> 'a array t 78 | (** Commutative version of {!array}. Arrays that are equal up to permutation 79 | will have the same hash. 80 | @since 1.0 *) 81 | 82 | (** {2 Base hash combinators} *) 83 | 84 | val combine : 'a t -> hash -> 'a -> hash 85 | val combine2 : hash -> hash -> hash 86 | val combine3 : hash -> hash -> hash -> hash 87 | val combine4 : hash -> hash -> hash -> hash -> hash 88 | 89 | val combine5 : hash -> hash -> hash -> hash -> hash -> hash 90 | (** @since 2.1 *) 91 | 92 | val combine6 : hash -> hash -> hash -> hash -> hash -> hash -> hash 93 | (** @since 2.1 *) 94 | 95 | (** {2 Iterators} *) 96 | 97 | type 'a iter = ('a -> unit) -> unit 98 | type 'a gen = unit -> 'a option 99 | 100 | val seq : 'a t -> 'a Seq.t t 101 | val iter : 'a t -> 'a iter t 102 | val gen : 'a t -> 'a gen t 103 | -------------------------------------------------------------------------------- /src/core/CCListLabels.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | include CCList 4 | -------------------------------------------------------------------------------- /src/core/CCOpt.ml: -------------------------------------------------------------------------------- 1 | include CCOption 2 | -------------------------------------------------------------------------------- /src/core/CCOpt.mli: -------------------------------------------------------------------------------- 1 | (** Previous Option module 2 | @deprecated use `CCOption` instead. *) 3 | 4 | [@@@ocaml.deprecated "use CCOption instead"] 5 | 6 | include module type of CCOption 7 | -------------------------------------------------------------------------------- /src/core/CCOrd.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** {1 Comparisons} *) 4 | 5 | type 'a t = 'a -> 'a -> int 6 | (** Comparison (total ordering) between two elements, that returns an int *) 7 | 8 | let poly = Stdlib.compare 9 | let compare = Stdlib.compare 10 | let opp f x y = -f x y 11 | 12 | let equiv i j = 13 | if i < 0 then 14 | j < 0 15 | else if i > 0 then 16 | j > 0 17 | else 18 | j = 0 19 | 20 | let int (x : int) y = Stdlib.compare x y 21 | let string (x : string) y = Stdlib.compare x y 22 | let bool (x : bool) y = Stdlib.compare x y 23 | let float (x : float) y = Stdlib.compare x y 24 | 25 | (** {2 Lexicographic Combination} *) 26 | 27 | let ( ) c (ord, x, y) = 28 | if c = 0 then 29 | ord x y 30 | else 31 | c 32 | 33 | let option c o1 o2 = 34 | match o1, o2 with 35 | | None, None -> 0 36 | | None, Some _ -> -1 37 | | Some _, None -> 1 38 | | Some x1, Some x2 -> c x1 x2 39 | 40 | let pair o_x o_y (x1, y1) (x2, y2) = 41 | let c = o_x x1 x2 in 42 | if c = 0 then 43 | o_y y1 y2 44 | else 45 | c 46 | 47 | let triple o_x o_y o_z (x1, y1, z1) (x2, y2, z2) = 48 | let c = o_x x1 x2 in 49 | if c = 0 then ( 50 | let c' = o_y y1 y2 in 51 | if c' = 0 then 52 | o_z z1 z2 53 | else 54 | c' 55 | ) else 56 | c 57 | 58 | let rec list ord l1 l2 = 59 | match l1, l2 with 60 | | [], [] -> 0 61 | | [], _ -> -1 62 | | _, [] -> 1 63 | | x1 :: l1', x2 :: l2' -> 64 | let c = ord x1 x2 in 65 | if c = 0 then 66 | list ord l1' l2' 67 | else 68 | c 69 | 70 | let array ord a1 a2 = 71 | let rec aux i = 72 | if i = Array.length a1 then 73 | if Array.length a1 = Array.length a2 then 74 | 0 75 | else 76 | -1 77 | else if i = Array.length a2 then 78 | 1 79 | else ( 80 | let c = ord a1.(i) a2.(i) in 81 | if c = 0 then 82 | aux (i + 1) 83 | else 84 | c 85 | ) 86 | in 87 | aux 0 88 | 89 | let map f ord a b = ord (f a) (f b) 90 | let ( >|= ) x f = map f x 91 | 92 | module Infix = struct 93 | let ( >|= ) = ( >|= ) 94 | let ( ) = ( ) 95 | end 96 | -------------------------------------------------------------------------------- /src/core/CCOrd.mli: -------------------------------------------------------------------------------- 1 | (** Order combinators *) 2 | 3 | (* This file is free software, part of containers. See file "license" for more details. *) 4 | 5 | (** {2 Comparisons} *) 6 | 7 | type 'a t = 'a -> 'a -> int 8 | (** Comparison (total ordering) between two elements, that returns an int. *) 9 | 10 | val poly : 'a t 11 | (** Polymorphic "magic" comparison. Use with care, as it will fail on 12 | some types. 13 | @since 3.6 *) 14 | 15 | val compare : 'a t 16 | [@@deprecated "use CCOrd.poly instead, this name is too general"] 17 | (** Polymorphic "magic" comparison. 18 | @deprecated since 3.6 in favor of {!poly}. The reason is that 19 | [compare] is easily shadowed, can shadow other comparators, and is just 20 | generally not very descriptive. *) 21 | 22 | val opp : 'a t -> 'a t 23 | (** Opposite order. For example, [opp cmp a b < 0] iff [cmp b a > 0]. 24 | This can be used to sort values in the opposite order, among other things. *) 25 | 26 | val equiv : int -> int -> bool 27 | (** Returns [true] iff the two comparison results are the same. *) 28 | 29 | val int : int t 30 | val string : string t 31 | val bool : bool t 32 | val float : float t 33 | 34 | (** {2 Lexicographic Combination} *) 35 | 36 | val ( ) : int -> 'a t * 'a * 'a -> int 37 | (** [c1 (ord, x, y)] returns the same as [c1] if [c1] is not [0]; 38 | otherwise it uses [ord] to compare the two values [x] and [y], 39 | of type ['a]. 40 | 41 | Example: 42 | {[CCInt.compare 1 3 43 | (String.compare, "a", "b") 44 | (CCBool.compare, true, false)]} 45 | 46 | Same example, using only CCOrd:: 47 | {[CCOrd.(int 1 3 48 | (string, "a", "b") 49 | (bool, true, false))]} 50 | *) 51 | 52 | val option : 'a t -> 'a option t 53 | (** Comparison of optional values. [None] is smaller than any [Some _]. 54 | @since 0.15 *) 55 | 56 | val pair : 'a t -> 'b t -> ('a * 'b) t 57 | val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t 58 | 59 | val list : 'a t -> 'a list t 60 | (** Lexicographic combination on lists. *) 61 | 62 | val array : 'a t -> 'a array t 63 | 64 | val map : ('a -> 'b) -> 'b t -> 'a t 65 | (** [map f ord] is the comparison function that, given objects [x] and [y], 66 | projects [x] and [y] using [f] (e.g. using a record field) and then 67 | compares those projections with [ord]. 68 | Example: 69 | [map fst CCInt.compare] compares values of type [(int * 'a)] by their 70 | first component. *) 71 | 72 | val ( >|= ) : 'b t -> ('a -> 'b) -> 'a t 73 | (** Infix equivalent of {!map}. *) 74 | 75 | module Infix : sig 76 | val ( ) : int -> 'a t * 'a * 'a -> int 77 | (** [c1 (ord, x, y)] returns the same as [c1] if [c1] is not [0]; 78 | otherwise it uses [ord] to compare the two values [x] and [y], 79 | of type ['a]. *) 80 | 81 | val ( >|= ) : 'b t -> ('a -> 'b) -> 'a t 82 | (** Infix equivalent of {!map}. *) 83 | end 84 | -------------------------------------------------------------------------------- /src/core/CCPair.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** {1 Tuple Functions} *) 4 | 5 | type ('a, 'b) t = 'a * 'b 6 | 7 | let make x y = x, y 8 | let map_fst f (x, y) = f x, y 9 | let map_snd f (x, y) = x, f y 10 | let map f g (x, y) = f x, g y 11 | let map_same f (x, y) = f x, f y 12 | let map2 f g (a, b) (x, y) = f a x, g b y 13 | let map_same2 f (a, b) (x, y) = f a x, f b y 14 | let fst_map f (x, _) = f x 15 | let snd_map f (_, x) = f x 16 | let iter f (x, y) = f x y 17 | let swap (x, y) = y, x 18 | let ( <<< ) = map_fst 19 | let ( >>> ) = map_snd 20 | let ( *** ) = map 21 | let ( &&& ) f g x = f x, g x 22 | let merge f (x, y) = f x y 23 | let fold = merge 24 | let dup x = x, x 25 | let dup_map f x = x, f x 26 | let equal f g (x1, y1) (x2, y2) = f x1 x2 && g y1 y2 27 | 28 | let compare f g (x1, y1) (x2, y2) = 29 | let c = f x1 x2 in 30 | if c <> 0 then 31 | c 32 | else 33 | g y1 y2 34 | 35 | let to_string ?(sep = ", ") a_to_string b_to_string (x, y) = 36 | Printf.sprintf "%s%s%s" (a_to_string x) sep (b_to_string y) 37 | 38 | type 'a printer = Format.formatter -> 'a -> unit 39 | 40 | let pp ?(pp_start = fun _ () -> ()) ?(pp_stop = fun _ () -> ()) 41 | ?(pp_sep = fun out () -> Format.fprintf out ",@ ") pa pb out (x, y) = 42 | pp_start out (); 43 | pa out x; 44 | pp_sep out (); 45 | pb out y; 46 | pp_stop out () 47 | -------------------------------------------------------------------------------- /src/core/CCPair.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Tuple Functions *) 4 | 5 | type ('a, 'b) t = 'a * 'b 6 | 7 | val make : 'a -> 'b -> ('a, 'b) t 8 | (** Make a tuple from its components. 9 | @since 0.16 *) 10 | 11 | val map_fst : ('a -> 'b) -> 'a * 'c -> 'b * 'c 12 | (** [map_fst f (x, y)] returns [(f x, y)]. 13 | Renamed from [map1] since 3.0. *) 14 | 15 | val map_snd : ('a -> 'b) -> 'c * 'a -> 'c * 'b 16 | (** [map_snd f (x, y)] returns [(x, f y)]. 17 | Renamed from [map2] since 3.0. *) 18 | 19 | val map : ('a -> 'c) -> ('b -> 'd) -> 'a * 'b -> 'c * 'd 20 | (** Synonym to {!( *** )}. Map on both sides of a tuple. *) 21 | 22 | val map_same : ('a -> 'b) -> 'a * 'a -> 'b * 'b 23 | (** Like {!map} but specialized for pairs with elements of the same type. *) 24 | 25 | val map2 : 26 | ('a1 -> 'b1 -> 'c1) -> 27 | ('a2 -> 'b2 -> 'c2) -> 28 | 'a1 * 'a2 -> 29 | 'b1 * 'b2 -> 30 | 'c1 * 'c2 31 | (** [map2 f g (a,b) (x,y)] return [(f a x, g b y)]. 32 | @since 3.0 *) 33 | 34 | val map_same2 : ('a -> 'b -> 'c) -> 'a * 'a -> 'b * 'b -> 'c * 'c 35 | (** [map_same2 f (a,b) (x,y)] return [(f a x, f b y)]. 36 | @since 3.0 *) 37 | 38 | val fst_map : ('a -> 'b) -> 'a * _ -> 'b 39 | (** Compose the given function with [fst]. 40 | Rename from [map_fst] since 3.0. 41 | @since 0.3.3 *) 42 | 43 | val snd_map : ('a -> 'b) -> _ * 'a -> 'b 44 | (** Compose the given function with [snd]. 45 | Rename from [map_snd] since 3.0. 46 | @since 0.3.3 *) 47 | 48 | val iter : ('a -> 'b -> unit) -> 'a * 'b -> unit 49 | 50 | val swap : 'a * 'b -> 'b * 'a 51 | (** Swap the components of the tuple. *) 52 | 53 | val ( <<< ) : ('a -> 'b) -> 'a * 'c -> 'b * 'c 54 | (** Map on the left side of the tuple. *) 55 | 56 | val ( >>> ) : ('a -> 'b) -> 'c * 'a -> 'c * 'b 57 | (** Map on the right side of the tuple. *) 58 | 59 | val ( *** ) : ('a -> 'c) -> ('b -> 'd) -> 'a * 'b -> 'c * 'd 60 | (** Map on both sides of a tuple. *) 61 | 62 | val ( &&& ) : ('a -> 'b) -> ('a -> 'c) -> 'a -> 'b * 'c 63 | (** [f &&& g] is [fun x -> f x, g x]. It splits the computations into 64 | two parts. *) 65 | 66 | val merge : ('a -> 'b -> 'c) -> 'a * 'b -> 'c 67 | (** Uncurrying (merges the two components of a tuple). *) 68 | 69 | val fold : ('a -> 'b -> 'c) -> 'a * 'b -> 'c 70 | (** Synonym to {!merge}. 71 | @since 0.3.3 *) 72 | 73 | val dup : 'a -> 'a * 'a 74 | (** [dup x = (x,x)] (duplicate the value). 75 | @since 0.3.3 *) 76 | 77 | val dup_map : ('a -> 'b) -> 'a -> 'a * 'b 78 | (** [dup_map f x = (x, f x)]. Duplicates the value and applies the function 79 | to the second copy. 80 | @since 0.3.3 *) 81 | 82 | val equal : 83 | ('a -> 'a -> bool) -> ('b -> 'b -> bool) -> 'a * 'b -> 'a * 'b -> bool 84 | 85 | val compare : 86 | ('a -> 'a -> int) -> ('b -> 'b -> int) -> 'a * 'b -> 'a * 'b -> int 87 | 88 | val to_string : 89 | ?sep:string -> ('a -> string) -> ('b -> string) -> 'a * 'b -> string 90 | (** Print tuple in a string 91 | @since 2.7 *) 92 | 93 | type 'a printer = Format.formatter -> 'a -> unit 94 | 95 | val pp : 96 | ?pp_start:unit printer -> 97 | ?pp_stop:unit printer -> 98 | ?pp_sep:unit printer -> 99 | 'a printer -> 100 | 'b printer -> 101 | ('a * 'b) printer 102 | (** Print a pair given an optional separator, an optional start and stop and a 103 | method for printing each of its elements. *) 104 | -------------------------------------------------------------------------------- /src/core/CCRef.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** {1 References} 4 | 5 | @since 0.9 *) 6 | 7 | type 'a printer = Format.formatter -> 'a -> unit 8 | type 'a ord = 'a -> 'a -> int 9 | type 'a eq = 'a -> 'a -> bool 10 | type 'a iter = ('a -> unit) -> unit 11 | type 'a t = 'a ref 12 | 13 | let create x = ref x 14 | let map f r = ref (f !r) 15 | let iter f r = f !r 16 | let update f r = r := f !r 17 | 18 | let incr_then_get r = 19 | incr r; 20 | !r 21 | 22 | let get_then_incr r = 23 | let x = !r in 24 | incr r; 25 | x 26 | 27 | let compare f r1 r2 = f !r1 !r2 28 | let equal f r1 r2 = f !r1 !r2 29 | 30 | let swap a b = 31 | let x = !a in 32 | a := !b; 33 | b := x 34 | 35 | let protect r x f = 36 | let old = !r in 37 | r := x; 38 | try 39 | let res = f () in 40 | r := old; 41 | res 42 | with e -> 43 | r := old; 44 | raise e 45 | 46 | let to_list r = [ !r ] 47 | let to_iter r yield = yield !r 48 | let pp pp_x out r = pp_x out !r 49 | -------------------------------------------------------------------------------- /src/core/CCRef.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Helpers for references 4 | @since 0.9 *) 5 | 6 | type 'a printer = Format.formatter -> 'a -> unit 7 | type 'a ord = 'a -> 'a -> int 8 | type 'a eq = 'a -> 'a -> bool 9 | type 'a iter = ('a -> unit) -> unit 10 | type 'a t = 'a ref 11 | 12 | val map : ('a -> 'b) -> 'a t -> 'b t 13 | (** Transform the value. *) 14 | 15 | val create : 'a -> 'a t 16 | (** Alias to {!ref}. *) 17 | 18 | val iter : ('a -> unit) -> 'a t -> unit 19 | (** Call the function on the content of the reference. *) 20 | 21 | val update : ('a -> 'a) -> 'a t -> unit 22 | (** Update the reference's content with the given function. *) 23 | 24 | val incr_then_get : int t -> int 25 | (** [incr_then_get r] increments [r] and returns its new value, think [++r]. 26 | @since 0.17 *) 27 | 28 | val get_then_incr : int t -> int 29 | (** [get_then_incr r] increments [r] and returns its old value, think [r++]. 30 | @since 0.17 *) 31 | 32 | val swap : 'a t -> 'a t -> unit 33 | (** [swap t1 t2] puts [!t2] in [t1] and [!t1] in [t2]. 34 | @since 1.4 *) 35 | 36 | val protect : 'a t -> 'a -> (unit -> 'b) -> 'b 37 | (** [protect r x f] sets [r := x]; calls [f()]; restores [r] to its old value; 38 | and returns the result of [f()]. 39 | @since 3.10 *) 40 | 41 | val compare : 'a ord -> 'a t ord 42 | val equal : 'a eq -> 'a t eq 43 | val to_list : 'a t -> 'a list 44 | 45 | val to_iter : 'a t -> 'a iter 46 | (** @since 3.0 *) 47 | 48 | val pp : 'a printer -> 'a t printer 49 | -------------------------------------------------------------------------------- /src/core/CCSet.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Wrapper around Set 4 | 5 | @since 0.9 *) 6 | 7 | type 'a iter = ('a -> unit) -> unit 8 | (** Fast internal iterator. 9 | @since 2.8 *) 10 | 11 | type 'a printer = Format.formatter -> 'a -> unit 12 | 13 | module type OrderedType = Set.OrderedType 14 | (** @since 1.5 *) 15 | 16 | module type S = sig 17 | include Set.S 18 | 19 | val min_elt_opt : t -> elt option 20 | (** Safe version of {!min_elt}. 21 | @since 1.5 *) 22 | 23 | val max_elt_opt : t -> elt option 24 | (** Safe version of {!max_elt}. 25 | @since 1.5 *) 26 | 27 | val choose_opt : t -> elt option 28 | (** Safe version of {!choose}. 29 | @since 1.5 *) 30 | 31 | val find_opt : elt -> t -> elt option 32 | (** Safe version of {!find}. 33 | @since 1.5 *) 34 | 35 | val find_first : (elt -> bool) -> t -> elt 36 | (** Find minimum element satisfying predicate. 37 | @since 1.5 *) 38 | 39 | val find_first_opt : (elt -> bool) -> t -> elt option 40 | (** Safe version of {!find_first}. 41 | @since 1.5 *) 42 | 43 | val find_first_map : (elt -> 'a option) -> t -> 'a option 44 | (** [find_first_map f s] find the minimum element [x] of [s] such that [f x = Some y] 45 | and return [Some y]. Otherwise returns [None]. 46 | @since 3.12 *) 47 | 48 | val find_last : (elt -> bool) -> t -> elt 49 | (** Find maximum element satisfying predicate. 50 | @since 1.5 *) 51 | 52 | val find_last_opt : (elt -> bool) -> t -> elt option 53 | (** Safe version of {!find_last}. 54 | @since 1.5 *) 55 | 56 | val find_last_map : (elt -> 'a option) -> t -> 'a option 57 | (** [find_last_map f s] find the maximum element [x] of [s] such that [f x = Some y] 58 | and return [Some y]. Otherwise returns [None]. 59 | @since 3.12 *) 60 | 61 | val of_iter : elt iter -> t 62 | (** Build a set from the given [iter] of elements. 63 | @since 2.8 *) 64 | 65 | val of_seq : elt Seq.t -> t 66 | (** Build a set from the given [seq] of elements. 67 | @since 3.0 *) 68 | 69 | val add_iter : t -> elt iter -> t 70 | (** @since 2.8 *) 71 | 72 | val add_seq : elt Seq.t -> t -> t 73 | (** @since 3.0 *) 74 | 75 | val to_iter : t -> elt iter 76 | (** [to_iter t] converts the set [t] to a [iter] of the elements. 77 | @since 2.8 *) 78 | 79 | val add_list : t -> elt list -> t 80 | (** @since 0.14 *) 81 | 82 | val to_list : t -> elt list 83 | (** [to_list t] converts the set [t] to a list of the elements. *) 84 | 85 | val to_string : 86 | ?start:string -> 87 | ?stop:string -> 88 | ?sep:string -> 89 | (elt -> string) -> 90 | t -> 91 | string 92 | (** Print the set in a string 93 | @since 2.7 *) 94 | 95 | val pp : 96 | ?pp_start:unit printer -> 97 | ?pp_stop:unit printer -> 98 | ?pp_sep:unit printer -> 99 | elt printer -> 100 | t printer 101 | (** Print the set. *) 102 | end 103 | 104 | module Make (O : Set.OrderedType) : 105 | S with type t = Set.Make(O).t and type elt = O.t 106 | -------------------------------------------------------------------------------- /src/core/CCSexp.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Handling S-expressions 4 | 5 | @since 3.0 moved into containers-core, previously in [containers.sexp] 6 | *) 7 | 8 | type 'a or_error = ('a, string) result 9 | type 'a gen = unit -> 'a option 10 | 11 | module type SEXP = CCSexp_intf.SEXP 12 | (** {2 Abstract representation of S-expressions (extended)} 13 | 14 | @since 2.7 *) 15 | 16 | module type S = CCSexp_intf.S 17 | (** {2 Operations over S-expressions} 18 | 19 | @since 2.7 *) 20 | 21 | (** {2 Functorized operations} 22 | 23 | This builds a parser and printer for S-expressions represented as 24 | in the [Sexp] argument. 25 | 26 | @since 2.7 27 | 28 | @since 3.4 re-bind [loc] to [Sexp.loc] 29 | *) 30 | module Make (Sexp : SEXP) : S with type t = Sexp.t and type loc = Sexp.loc 31 | 32 | (** {2 Basics} *) 33 | 34 | type t = 35 | [ `Atom of string 36 | | `List of t list 37 | ] 38 | (** A simple, structural representation of S-expressions. *) 39 | 40 | include S with type t := t 41 | 42 | val equal : t -> t -> bool 43 | (** @since 3.0 *) 44 | 45 | val compare : t -> t -> int 46 | (** @since 3.0 *) 47 | 48 | val atom : string -> t 49 | (** Build an atom directly from a string. *) 50 | -------------------------------------------------------------------------------- /src/core/CCSexp_lex.mll: -------------------------------------------------------------------------------- 1 | { 2 | type token = 3 | | ATOM of string 4 | | LIST_OPEN 5 | | LIST_CLOSE 6 | | SEXP_COMMENT 7 | | EOI 8 | 9 | (* location + message *) 10 | exception Error of int * int * string 11 | 12 | let error lexbuf msg = 13 | let start = Lexing.lexeme_start_p lexbuf in 14 | let line = start.Lexing.pos_lnum in 15 | let col = start.Lexing.pos_cnum - start.Lexing.pos_bol in 16 | raise (Error (line,col,msg)) 17 | 18 | type unescape_state = 19 | | Not_escaped 20 | | Escaped 21 | | Escaped_int_1 of int 22 | | Escaped_int_2 of int 23 | 24 | let char_equal (a : char) b = Stdlib.(=) a b 25 | 26 | (* remove quotes + unescape *) 27 | let remove_quotes lexbuf s = 28 | assert (char_equal s.[0] '"' && char_equal s.[String.length s - 1] '"'); 29 | let buf = Buffer.create (String.length s) in 30 | let st = ref Not_escaped in 31 | for i = 1 to String.length s-2 do 32 | match !st, s.[i] with 33 | | Escaped, '\\' -> Buffer.add_char buf '\\'; st := Not_escaped 34 | | Not_escaped, '\\' -> st := Escaped 35 | | Escaped, 'n' -> Buffer.add_char buf '\n'; st := Not_escaped 36 | | Escaped, 'r' -> Buffer.add_char buf '\r'; st := Not_escaped 37 | | Escaped, 't' -> Buffer.add_char buf '\t'; st := Not_escaped 38 | | Escaped, 'b' -> Buffer.add_char buf '\b'; st := Not_escaped 39 | | Escaped, '"' -> Buffer.add_char buf '"'; st := Not_escaped 40 | | Escaped, ('0'..'9' as c) -> 41 | st := Escaped_int_1 (Char.code c - Char.code '0') 42 | | Escaped_int_1 i, ('0'..'9' as c) -> 43 | st := Escaped_int_2 (10*i+Char.code c - Char.code '0') 44 | | Escaped_int_2 i, ('0'..'9' as c) -> 45 | let n = 10*i+Char.code c - Char.code '0' in 46 | if n < 256 then ( 47 | Buffer.add_char buf (Char.chr n); 48 | ) else ( 49 | (* non-ascii unicode code point: encode to utf8 on the fly *) 50 | let c = 51 | try Uchar.of_int n 52 | with _ -> 53 | failwith (Printf.sprintf "CCSexp: invalid unicode codepont '%d'" n) 54 | in 55 | CCUtf8_string.uchar_to_bytes c (Buffer.add_char buf) 56 | ); 57 | st := Not_escaped 58 | | (Escaped | Escaped_int_1 _ | Escaped_int_2 _), c -> 59 | error lexbuf (Printf.sprintf "wrong escape `%c`" c) 60 | | Not_escaped, c -> Buffer.add_char buf c; 61 | done; 62 | Buffer.contents buf 63 | 64 | } 65 | 66 | let newline = '\n' | "\r\n" 67 | let white = [' ' '\r' '\t'] | newline 68 | 69 | let comment_line = ';' [^ '\n']* 70 | let printable_char = [^ '\n'] 71 | 72 | let id = [^ ')' '(' '"' ' ' '\t' '\r' '\n']+ 73 | let num = ['0'-'9'] 74 | let string_item = 75 | ([^ '"' '\\'] | "\\\"" | "\\\\" | "\\b" | "\\n" | "\\t" | "\\r" | '\\' num num num ) 76 | let string = '"' string_item* '"' 77 | 78 | rule token = parse 79 | | "#;" { SEXP_COMMENT } 80 | | comment_line { token lexbuf } 81 | | newline { Lexing.new_line lexbuf; token lexbuf } 82 | | white { token lexbuf } 83 | | eof { EOI } 84 | | '(' { LIST_OPEN } 85 | | ')' { LIST_CLOSE } 86 | | id { ATOM (Lexing.lexeme lexbuf) } 87 | | string { ATOM (remove_quotes lexbuf (Lexing.lexeme lexbuf)) } 88 | | _ as c 89 | { error lexbuf (Printf.sprintf "lexing failed on char `%c`" c) } 90 | 91 | -------------------------------------------------------------------------------- /src/core/CCStringLabels.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | include CCString 4 | -------------------------------------------------------------------------------- /src/core/CCUnit.ml: -------------------------------------------------------------------------------- 1 | include Unit 2 | -------------------------------------------------------------------------------- /src/core/containers.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Drop-In replacement to Stdlib *) 4 | 5 | module Array = CCArray 6 | module Bool = CCBool 7 | module Char = CCChar 8 | module Equal = CCEqual 9 | module Either = CCEither 10 | module Float = CCFloat 11 | module Format = CCFormat 12 | module Fun = CCFun 13 | module Hash = CCHash 14 | 15 | (** @since 0.14 *) 16 | module Hashtbl = struct 17 | include ( 18 | Hashtbl : 19 | module type of Hashtbl 20 | with type statistics = Hashtbl.statistics 21 | and module Make = Hashtbl.Make 22 | and type ('a, 'b) t = ('a, 'b) Hashtbl.t) 23 | 24 | include CCHashtbl.Poly 25 | 26 | module type S' = CCHashtbl.S 27 | 28 | module Make' = CCHashtbl.Make 29 | end 30 | 31 | (** {2 Additional modules} *) 32 | 33 | module Byte_buffer = CCByte_buffer 34 | module Byte_slice = CCByte_slice 35 | module Heap = CCHeap 36 | module Int = CCInt 37 | module Int32 = CCInt32 38 | module Int64 = CCInt64 39 | module IO = CCIO 40 | module List = CCList 41 | module Map = CCMap 42 | module Nativeint = CCNativeint 43 | module Option = CCOption 44 | module Ord = CCOrd 45 | module Pair = CCPair 46 | module Parse = CCParse 47 | module Random = CCRandom 48 | module Ref = CCRef 49 | module Result = CCResult 50 | module Seq = CCSeq 51 | module Set = CCSet 52 | module String = CCString 53 | module Vector = CCVector 54 | module Monomorphic = CCMonomorphic 55 | module Utf8_string = CCUtf8_string 56 | module Unit = CCUnit 57 | module Atomic = CCAtomic 58 | module Sexp = CCSexp 59 | module Sexp_intf = CCSexp_intf 60 | module Canonical_sexp = CCCanonical_sexp 61 | module Stdlib = Stdlib 62 | include Monomorphic 63 | -------------------------------------------------------------------------------- /src/core/containersLabels.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Drop-In replacement to Stdlib *) 4 | 5 | module Array = CCArrayLabels 6 | module Bool = CCBool 7 | module Byte_buffer = CCByte_buffer 8 | module Char = CCChar 9 | module Equal = CCEqualLabels 10 | module Either = CCEither 11 | module Float = CCFloat 12 | module Format = CCFormat 13 | module Fun = CCFun 14 | module Hash = CCHash 15 | 16 | (** @since 0.14 *) 17 | module Hashtbl = struct 18 | include ( 19 | Hashtbl : 20 | module type of Hashtbl 21 | with type statistics = Hashtbl.statistics 22 | and module Make = Hashtbl.Make 23 | and type ('a, 'b) t = ('a, 'b) Hashtbl.t) 24 | 25 | include CCHashtbl.Poly 26 | 27 | module type S' = CCHashtbl.S 28 | 29 | module Make' = CCHashtbl.Make 30 | end 31 | 32 | module Heap = CCHeap 33 | module Int = CCInt 34 | module Int32 = CCInt32 35 | module Int64 = CCInt64 36 | module IO = CCIO 37 | module List = CCListLabels 38 | module Map = CCMap 39 | module Nativeint = CCNativeint 40 | module Option = CCOption 41 | module Ord = CCOrd 42 | module Pair = CCPair 43 | module Parse = CCParse 44 | module Random = CCRandom 45 | module Ref = CCRef 46 | module Result = CCResult 47 | module Seq = CCSeq 48 | module Set = CCSet 49 | module String = CCStringLabels 50 | module Vector = CCVector 51 | module Monomorphic = CCMonomorphic 52 | module Utf8_string = CCUtf8_string 53 | module Sexp = CCSexp 54 | module Sexp_intf = CCSexp_intf 55 | module Stdlib = Stdlib 56 | include Monomorphic 57 | -------------------------------------------------------------------------------- /src/core/cpp/dune: -------------------------------------------------------------------------------- 1 | ; our little preprocessor 2 | 3 | (executable 4 | (name cpp) 5 | (flags :standard -warn-error -a+8) 6 | (modes 7 | (best exe)) 8 | (libraries dune.configurator)) 9 | -------------------------------------------------------------------------------- /src/core/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name containers) 3 | (public_name containers) 4 | (wrapped false) 5 | (preprocess 6 | (action 7 | (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))) 8 | (flags :standard -nolabels -open CCMonomorphic) 9 | (libraries either containers.monomorphic)) 10 | 11 | (ocamllex 12 | (modules CCSexp_lex)) 13 | -------------------------------------------------------------------------------- /src/core/tests/check_labelled_mods.ml: -------------------------------------------------------------------------------- 1 | module A = struct 2 | (* test consistency of interfaces *) 3 | module FA = CCArray.Floatarray 4 | 5 | module type L = module type of CCArray with module Floatarray := FA 6 | module type LL = module type of CCArrayLabels with module Floatarray := FA 7 | 8 | let () = ignore (module CCArrayLabels : L) 9 | let () = ignore (module CCArray : LL) 10 | end 11 | 12 | module S = struct 13 | (* test consistency of interfaces *) 14 | module type L = module type of CCString 15 | module type LL = module type of CCStringLabels 16 | 17 | let () = ignore (module CCStringLabels : L) 18 | let () = ignore (module CCString : LL) 19 | end 20 | 21 | module L = struct 22 | (* test consistency of interfaces *) 23 | module type L = module type of CCList 24 | module type LL = module type of CCListLabels 25 | 26 | let () = ignore (module CCListLabels : L) 27 | let () = ignore (module CCList : LL) 28 | end 29 | 30 | let () = print_endline "labelled modules are consistent ✔" 31 | -------------------------------------------------------------------------------- /src/core/tests/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name check_labelled_mods) 3 | (modules check_labelled_mods) 4 | (flags :standard -warn-error -a -w -3-33-35-27-39-48-50-60 -nolabels) 5 | (libraries containers)) 6 | 7 | (executable 8 | (name test_hash) 9 | (modules test_hash) 10 | (flags :standard -warn-error -a+8) 11 | (libraries containers iter)) 12 | 13 | (executable 14 | (name test_random) 15 | (flags :standard -warn-error -a+8) 16 | (modules test_random) 17 | (libraries containers)) 18 | 19 | (rule 20 | (alias runtest) 21 | (locks /ctest) 22 | (package containers) 23 | (action 24 | (run ./test_random.exe))) 25 | 26 | ; what matters is that it compiles 27 | 28 | (rule 29 | (alias runtest) 30 | (locks /ctest) 31 | (package containers) 32 | (action 33 | (run ./check_labelled_mods.exe))) 34 | -------------------------------------------------------------------------------- /src/core/tests/test_hash.ml: -------------------------------------------------------------------------------- 1 | (* test hash functions a bit *) 2 | 3 | module H = CCHash 4 | 5 | module Hist = struct 6 | type t = { 7 | tbl: (int, int) Hashtbl.t; 8 | mutable n_samples: int; 9 | } 10 | 11 | let create () : t = { tbl = Hashtbl.create 32; n_samples = 0 } 12 | 13 | let add_n self x n = 14 | Hashtbl.replace self.tbl x (n + try Hashtbl.find self.tbl x with _ -> 0); 15 | self.n_samples <- n + self.n_samples 16 | 17 | let pp out (self : t) : unit = 18 | let max = Hashtbl.fold (fun k _ n -> max k n) self.tbl 0 in 19 | let min = Hashtbl.fold (fun k _ n -> min k n) self.tbl max in 20 | for i = min to max do 21 | let n = try Hashtbl.find self.tbl i with _ -> 0 in 22 | Format.fprintf out "[v=%-4d, n-inputs %-6d] %s@." i n 23 | (String.make (int_of_float @@ ceil (log (float n))) '#') 24 | done 25 | end 26 | 27 | let reset_line = "\x1b[2K\r" 28 | 29 | let t_int n1 n2 = 30 | Printf.printf "test hash_int on %d--%d\n" n1 n2; 31 | let count = Hashtbl.create 128 in 32 | for i = n1 to n2 do 33 | Printf.printf "%shash %d…%!" reset_line i; 34 | let h = H.int i in 35 | Hashtbl.replace count h (1 + CCHashtbl.get_or count h ~default:0); 36 | if i mod 1024 * 1024 * 1024 = 0 then Gc.major () 37 | done; 38 | Printf.printf "%s%!" reset_line; 39 | (* reverse table *) 40 | let by_count = 41 | CCHashtbl.to_iter count 42 | |> Iter.map (fun (_h, n) -> n) 43 | |> Iter.count ~hash:H.int 44 | in 45 | let hist = Hist.create () in 46 | by_count (fun (n, i) -> Hist.add_n hist n i); 47 | Format.printf "histogram:@.%a@." Hist.pp hist; 48 | (*assert (Hist.check_uniform hist);*) 49 | () 50 | 51 | let () = 52 | t_int 0 2_000_000; 53 | t_int (-4_000_000) (-3_500_000); 54 | () 55 | -------------------------------------------------------------------------------- /src/core/tests/test_random.ml: -------------------------------------------------------------------------------- 1 | open CCRandom 2 | 3 | let uniformity_test ?(size_hint = 10) k rng st = 4 | let histogram = Hashtbl.create size_hint in 5 | let add x = 6 | let n = try Hashtbl.find histogram x with Not_found -> 0 in 7 | Hashtbl.replace histogram x (n + 1) 8 | in 9 | let () = 10 | for _i = 0 to k - 1 do 11 | add (rng st) 12 | done 13 | in 14 | let cardinal = float_of_int (Hashtbl.length histogram) in 15 | let kf = float_of_int k in 16 | (* average number of points assuming an uniform distribution *) 17 | let average = kf /. cardinal in 18 | (* The number of points is a sum of random variables with binomial distribution *) 19 | let p = 1. /. cardinal in 20 | (* The variance of a binomial distribution with average p is *) 21 | let variance = p *. (1. -. p) in 22 | (* Central limit theorem: a confidence interval of 4σ provides a false positive rate 23 | of 0.00634% *) 24 | let confidence = 4. in 25 | let std = confidence *. sqrt (kf *. variance) in 26 | let predicate _key n acc = 27 | let ( < ) (a : float) b = Stdlib.( < ) a b in 28 | acc && abs_float (average -. float_of_int n) < std 29 | in 30 | Hashtbl.fold predicate histogram true 31 | 32 | let () = 33 | let st = Random.State.make_self_init () in 34 | let ok = run ~st (uniformity_test 50_000 (split_list 10 ~len:3)) in 35 | if not ok then failwith "uniformity check failed" 36 | -------------------------------------------------------------------------------- /src/data/CCBijection.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Functor to build a bijection 4 | Represents 1-to-1 mappings between two types. Each element from the "left" 5 | is mapped to one "right" value, and conversely. 6 | 7 | @since 2.1 *) 8 | 9 | type 'a iter = ('a -> unit) -> unit 10 | 11 | module type OrderedType = sig 12 | type t 13 | 14 | val compare : t -> t -> int 15 | end 16 | 17 | module type S = sig 18 | type t 19 | type left 20 | type right 21 | 22 | val empty : t 23 | val is_empty : t -> bool 24 | val equal : t -> t -> bool 25 | val compare : t -> t -> int 26 | 27 | val add : left -> right -> t -> t 28 | (** Add [left] and [right] correspondence to bijection such that 29 | [left] and [right] are unique in their respective sets and only 30 | correspond to each other. *) 31 | 32 | val cardinal : t -> int 33 | (** Number of bindings. O(n) time. *) 34 | 35 | val mem : left -> right -> t -> bool 36 | (** Check both sides for key membership. *) 37 | 38 | val mem_left : left -> t -> bool 39 | (** Check for membership of correspondence using [left] key. *) 40 | 41 | val mem_right : right -> t -> bool 42 | (** Check for membership of correspondence using [right] key. *) 43 | 44 | val find_left : left -> t -> right 45 | (** @raise Not_found if left is not found. *) 46 | 47 | val find_right : right -> t -> left 48 | (** @raise Not_found if right is not found. *) 49 | 50 | val remove : left -> right -> t -> t 51 | (** Remove the [left], [right] binding if it exists. Return the 52 | same bijection otherwise. *) 53 | 54 | val remove_left : left -> t -> t 55 | (** Remove the binding with [left] key if it exists. Return the 56 | same bijection otherwise. *) 57 | 58 | val remove_right : right -> t -> t 59 | (** Remove the binding with [right] key if it exists. Return the 60 | same bijection otherwise. *) 61 | 62 | val list_left : t -> (left * right) list 63 | (** Return the bindings as a list of ([left], [right]) values. *) 64 | 65 | val list_right : t -> (right * left) list 66 | (** Return the bindings as a list of [(right, left)] values. *) 67 | 68 | val add_iter : (left * right) iter -> t -> t 69 | val of_iter : (left * right) iter -> t 70 | val to_iter : t -> (left * right) iter 71 | val add_list : (left * right) list -> t -> t 72 | val of_list : (left * right) list -> t 73 | val to_list : t -> (left * right) list 74 | end 75 | 76 | module Make (L : OrderedType) (R : OrderedType) : 77 | S with type left = L.t and type right = R.t 78 | -------------------------------------------------------------------------------- /src/data/CCBitField.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** {1 Bit Field} *) 4 | 5 | exception TooManyFields 6 | exception Frozen 7 | 8 | let max_width = Sys.word_size - 2 9 | 10 | module type S = sig 11 | type t = private int 12 | (** Generative type of bitfields. Each instantiation of the functor 13 | should create a new, incompatible type *) 14 | 15 | val empty : t 16 | (** Empty bitfields (all bits 0) *) 17 | 18 | type field 19 | 20 | val get : field -> t -> bool 21 | (** Get the value of this field *) 22 | 23 | val set : field -> bool -> t -> t 24 | (** Set the value of this field *) 25 | 26 | val mk_field : unit -> field 27 | (** Make a new field *) 28 | 29 | val freeze : unit -> unit 30 | (** Prevent new fields from being added. From now on, creating 31 | a field will raise Frozen *) 32 | 33 | val total_width : unit -> int 34 | (** Current width of the bitfield *) 35 | end 36 | 37 | (* all bits from 0 to w-1 set to true *) 38 | let rec all_bits_ acc w = 39 | if w = 0 then 40 | acc 41 | else ( 42 | let acc = acc lor ((1 lsl w) - 1) in 43 | all_bits_ acc (w - 1) 44 | ) 45 | 46 | (* increment and return previous value *) 47 | let get_then_incr n = 48 | let x = !n in 49 | incr n; 50 | x 51 | 52 | module Make () : S = struct 53 | type t = int 54 | 55 | let empty = 0 56 | let width_ = ref 0 57 | let frozen_ = ref false 58 | 59 | type field = int (* a mask *) 60 | 61 | let get field x = x land field <> 0 62 | 63 | let set field b x = 64 | if b then 65 | x lor field 66 | else 67 | x land lnot field 68 | 69 | let mk_field () = 70 | if !frozen_ then raise Frozen; 71 | let n = get_then_incr width_ in 72 | if n > max_width then raise TooManyFields; 73 | let mask = 1 lsl n in 74 | mask 75 | 76 | let freeze () = frozen_ := true 77 | let total_width () = !width_ 78 | end 79 | -------------------------------------------------------------------------------- /src/data/CCBitField.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Efficient Bit Field for up to 31 or 61 fiels 4 | 5 | This module defines efficient bitfields 6 | up to 31 or 61 bits (depending on the architecture) in 7 | a relatively type-safe way. 8 | 9 | {[ 10 | module B = CCBitField.Make(struct end);; 11 | 12 | let x = B.mk_field () 13 | let y = B.mk_field () 14 | let z = B.mk_field () 15 | 16 | let f = B.empty |> B.set x true |> B.set y true;; 17 | 18 | assert (not (B.get z f)) ;; 19 | 20 | assert (f |> B.set z true |> B.get z);; 21 | 22 | ]} 23 | *) 24 | 25 | exception TooManyFields 26 | (** Raised when too many fields are packed into one bitfield. *) 27 | 28 | exception Frozen 29 | (** Raised when a frozen bitfield is modified. *) 30 | 31 | val max_width : int 32 | (** System-dependent maximum width for a bitfield, typically 30 or 62. *) 33 | 34 | (** {2 Bitfield Signature} *) 35 | module type S = sig 36 | type t = private int 37 | (** Generative type of bitfields. Each instantiation of the functor 38 | should create a new, incompatible type *) 39 | 40 | val empty : t 41 | (** Empty bitfields (all bits 0). *) 42 | 43 | type field 44 | 45 | val get : field -> t -> bool 46 | (** Get the value of this field. *) 47 | 48 | val set : field -> bool -> t -> t 49 | (** Set the value of this field. *) 50 | 51 | val mk_field : unit -> field 52 | (** Make a new field. *) 53 | 54 | val freeze : unit -> unit 55 | (** Prevent new fields from being added. From now on, creating 56 | a field will raise Frozen. *) 57 | 58 | val total_width : unit -> int 59 | (** Current width of the bitfield. *) 60 | end 61 | 62 | module Make () : S 63 | (** Create a new bitfield type *) 64 | 65 | (**/**) 66 | 67 | val all_bits_ : int -> int -> int 68 | 69 | (**/**) 70 | -------------------------------------------------------------------------------- /src/data/CCHashSet.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Mutable Set 4 | 5 | {b status: unstable} 6 | 7 | @since 0.13 *) 8 | 9 | type 'a iter = ('a -> unit) -> unit 10 | type 'a printer = Format.formatter -> 'a -> unit 11 | 12 | module type S = sig 13 | type t 14 | type elt 15 | 16 | val create : int -> t 17 | (** [create n] makes a new set with the given capacity [n]. *) 18 | 19 | val singleton : elt -> t 20 | (** [singleton x] is the singleton [{x}]. *) 21 | 22 | val clear : t -> unit 23 | (** [clear s] removes all elements from [s]. *) 24 | 25 | val copy : t -> t 26 | (** Fresh copy. *) 27 | 28 | val copy_into : into:t -> t -> unit 29 | (** [copy_into ~into s] copies all elements of [s] into [into]. *) 30 | 31 | val insert : t -> elt -> unit 32 | (** [insert s x] adds [x] into [s]. *) 33 | 34 | val remove : t -> elt -> unit 35 | (** Remove the element, if it were in there. *) 36 | 37 | val cardinal : t -> int 38 | (** [cardinal s] returns the number of elements in [s]. *) 39 | 40 | val mem : t -> elt -> bool 41 | (** [mem s x] returns [true] iff [x] is in [s]. *) 42 | 43 | val find_exn : t -> elt -> elt 44 | (** [find_exn s x] returns [y] if [x] and [y] are equal, and [mem s y]. 45 | @raise Not_found if [x] not in [s]. *) 46 | 47 | val find : t -> elt -> elt option 48 | (** Safe version of {!find_exn}. *) 49 | 50 | val inter : t -> t -> t 51 | (** [inter a b] returns [a ∩ b]. *) 52 | 53 | val inter_mut : into:t -> t -> unit 54 | (** [inter_mut ~into a] changes [into] into [a ∩ into]. *) 55 | 56 | val union : t -> t -> t 57 | (** [union a b] returns [a ∪ b]. *) 58 | 59 | val union_mut : into:t -> t -> unit 60 | (** [union_mut ~into a] changes [into] into [a ∪ into]. *) 61 | 62 | val diff : t -> t -> t 63 | (** [diff a b] returns [a - b]. *) 64 | 65 | val subset : t -> t -> bool 66 | (** [subset a b] returns [true] if all elements of [a] are in [b]. *) 67 | 68 | val equal : t -> t -> bool 69 | (** [equal a b] is extensional equality ([a] and [b] have the same elements). *) 70 | 71 | val for_all : (elt -> bool) -> t -> bool 72 | val exists : (elt -> bool) -> t -> bool 73 | 74 | val iter : (elt -> unit) -> t -> unit 75 | (** Iterate on values. *) 76 | 77 | val fold : ('a -> elt -> 'a) -> 'a -> t -> 'a 78 | (** Fold on values. *) 79 | 80 | val elements : t -> elt list 81 | (** List of elements. *) 82 | 83 | val of_list : elt list -> t 84 | val to_iter : t -> elt iter 85 | val of_iter : elt iter -> t 86 | val add_iter : t -> elt iter -> unit 87 | 88 | val pp : ?pp_sep:unit printer -> elt printer -> t printer 89 | (** [pp pp_elt] returns a set printer, given a printer for 90 | individual elements. *) 91 | end 92 | 93 | module type ELEMENT = sig 94 | type t 95 | 96 | val equal : t -> t -> bool 97 | 98 | val hash : t -> int 99 | (** Positive value *) 100 | end 101 | 102 | module Make (E : ELEMENT) : S with type elt = E.t 103 | -------------------------------------------------------------------------------- /src/data/CCHet.mli: -------------------------------------------------------------------------------- 1 | (** Associative containers with Heterogeneous Values 2 | 3 | This is similar to {!CCMixtbl}, but the injection is directly used as 4 | a key. 5 | 6 | @since 0.17 *) 7 | 8 | (* This file is free software, part of containers. See file "license" for more details. *) 9 | 10 | type 'a iter = ('a -> unit) -> unit 11 | type 'a gen = unit -> 'a option 12 | 13 | (** Keys with a type witness. *) 14 | module Key : sig 15 | type 'a t 16 | (** A key of type ['a t] is used to access the portion of the 17 | map or table that associates keys of type ['a] to values. *) 18 | 19 | val create : unit -> 'a t 20 | (** Make a new key. This is generative, so calling [create ()] twice with the 21 | same return type will produce incompatible keys that cannot see each 22 | other's bindings. *) 23 | 24 | val equal : 'a t -> 'a t -> bool 25 | (** Compare two keys that have compatible types. *) 26 | end 27 | 28 | type pair = Pair : 'a Key.t * 'a -> pair 29 | 30 | (** {2 Imperative table indexed by [Key]} *) 31 | module Tbl : sig 32 | type t 33 | 34 | val create : ?size:int -> unit -> t 35 | val mem : t -> _ Key.t -> bool 36 | val add : t -> 'a Key.t -> 'a -> unit 37 | val remove : t -> _ Key.t -> unit 38 | val length : t -> int 39 | val find : t -> 'a Key.t -> 'a option 40 | 41 | val clear : t -> unit 42 | (** clear the table (like {!Hashtbl.clear}) 43 | @since 3.11 *) 44 | 45 | val reset : t -> unit 46 | (** reset the table (like {!Hashtbl.reset}) 47 | @since 3.11 *) 48 | 49 | val find_exn : t -> 'a Key.t -> 'a 50 | (** @raise Not_found if the key is not in the table. *) 51 | 52 | val iter : (pair -> unit) -> t -> unit 53 | val to_iter : t -> pair iter 54 | val of_iter : pair iter -> t 55 | val add_iter : t -> pair iter -> unit 56 | val add_list : t -> pair list -> unit 57 | val of_list : pair list -> t 58 | val to_list : t -> pair list 59 | end 60 | 61 | (** {2 Immutable map} *) 62 | module Map : sig 63 | type t 64 | 65 | val empty : t 66 | val mem : _ Key.t -> t -> bool 67 | val add : 'a Key.t -> 'a -> t -> t 68 | val remove : _ Key.t -> t -> t 69 | val length : t -> int 70 | val cardinal : t -> int 71 | val find : 'a Key.t -> t -> 'a option 72 | 73 | val find_exn : 'a Key.t -> t -> 'a 74 | (** @raise Not_found if the key is not in the table. *) 75 | 76 | val iter : (pair -> unit) -> t -> unit 77 | val to_iter : t -> pair iter 78 | val of_iter : pair iter -> t 79 | val add_iter : t -> pair iter -> t 80 | val add_list : t -> pair list -> t 81 | val of_list : pair list -> t 82 | val to_list : t -> pair list 83 | end 84 | -------------------------------------------------------------------------------- /src/data/CCImmutArray.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** {1 Immutable Arrays} *) 4 | 5 | (* TODO: transient API? for batch modifications *) 6 | 7 | type 'a t = 'a array 8 | 9 | let empty = [||] 10 | let length = Array.length 11 | let singleton x = [| x |] 12 | let doubleton x y = [| x; y |] 13 | let make n x = Array.make n x 14 | let init n f = Array.init n f 15 | let get = Array.get 16 | 17 | let set a n x = 18 | let a' = Array.copy a in 19 | a'.(n) <- x; 20 | a' 21 | 22 | let sub = Array.sub 23 | (* Would this not be better implemented with CCArray_slice *) 24 | 25 | let map = Array.map 26 | let mapi = Array.mapi 27 | 28 | let append a b = 29 | let na = length a in 30 | Array.init 31 | (na + length b) 32 | (fun i -> 33 | if i < na then 34 | a.(i) 35 | else 36 | b.(i - na)) 37 | 38 | let iter = Array.iter 39 | let iteri = Array.iteri 40 | let fold = Array.fold_left 41 | 42 | let foldi f acc a = 43 | let n = ref 0 in 44 | Array.fold_left 45 | (fun acc x -> 46 | let acc = f acc !n x in 47 | incr n; 48 | acc) 49 | acc a 50 | 51 | exception ExitNow 52 | 53 | let for_all p a = 54 | try 55 | Array.iter (fun x -> if not (p x) then raise ExitNow) a; 56 | true 57 | with ExitNow -> false 58 | 59 | let exists p a = 60 | try 61 | Array.iter (fun x -> if p x then raise ExitNow) a; 62 | false 63 | with ExitNow -> true 64 | 65 | (** {2 Conversions} *) 66 | 67 | type 'a iter = ('a -> unit) -> unit 68 | type 'a gen = unit -> 'a option 69 | 70 | let of_list = Array.of_list 71 | let to_list = Array.to_list 72 | let of_array_unsafe a = a (* careful with that axe, Eugene *) 73 | let to_iter a k = iter k a 74 | 75 | let of_iter s = 76 | let l = ref [] in 77 | s (fun x -> l := x :: !l); 78 | Array.of_list (List.rev !l) 79 | 80 | let rec gen_to_list_ acc g = 81 | match g () with 82 | | None -> List.rev acc 83 | | Some x -> gen_to_list_ (x :: acc) g 84 | 85 | let of_gen g = 86 | let l = gen_to_list_ [] g in 87 | Array.of_list l 88 | 89 | let to_gen a = 90 | let i = ref 0 in 91 | fun () -> 92 | if !i < Array.length a then ( 93 | let x = a.(!i) in 94 | incr i; 95 | Some x 96 | ) else 97 | None 98 | 99 | (** {2 IO} *) 100 | 101 | type 'a printer = Format.formatter -> 'a -> unit 102 | 103 | let pp ?(pp_start = fun _ () -> ()) ?(pp_stop = fun _ () -> ()) 104 | ?(pp_sep = fun out () -> Format.fprintf out ",@ ") pp_item out a = 105 | pp_start out (); 106 | for k = 0 to Array.length a - 1 do 107 | if k > 0 then pp_sep out (); 108 | pp_item out a.(k) 109 | done; 110 | pp_stop out () 111 | -------------------------------------------------------------------------------- /src/data/CCImmutArray.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Immutable Arrays 4 | 5 | Purely functional use of arrays. Update is costly, but reads are very fast. 6 | Sadly, it is not possible to make this type covariant without using black 7 | magic. 8 | 9 | @since 0.17 *) 10 | 11 | type 'a t 12 | (** Array of values of type 'a. The underlying type really is 13 | an array, but it will never be modified. 14 | 15 | It should be covariant but OCaml will not accept it. *) 16 | 17 | val empty : 'a t 18 | val length : _ t -> int 19 | val singleton : 'a -> 'a t 20 | val doubleton : 'a -> 'a -> 'a t 21 | 22 | val make : int -> 'a -> 'a t 23 | (** [make n x] makes an array of [n] times [x]. *) 24 | 25 | val init : int -> (int -> 'a) -> 'a t 26 | (** [init n f] makes the array [[| f 0; f 1; ... ; f (n-1) |]]. 27 | @raise Invalid_argument if [n < 0]. *) 28 | 29 | val get : 'a t -> int -> 'a 30 | (** Access the element. *) 31 | 32 | val set : 'a t -> int -> 'a -> 'a t 33 | (** Copy the array and modify its copy. *) 34 | 35 | val sub : 'a t -> int -> int -> 'a t 36 | (** [sub a start len] returns a fresh array of length len, containing the elements 37 | from [start] to [pstart + len - 1] of array a. 38 | 39 | Raises [Invalid_argument "Array.sub"] if [start] and [len] do not designate a 40 | valid subarray of a; that is, if start < 0, or len < 0, or start + len > Array.length a. 41 | 42 | @since 1.5 *) 43 | 44 | val map : ('a -> 'b) -> 'a t -> 'b t 45 | val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t 46 | val append : 'a t -> 'a t -> 'a t 47 | val iter : ('a -> unit) -> 'a t -> unit 48 | val iteri : (int -> 'a -> unit) -> 'a t -> unit 49 | val foldi : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a 50 | val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a 51 | val for_all : ('a -> bool) -> 'a t -> bool 52 | val exists : ('a -> bool) -> 'a t -> bool 53 | 54 | (** {2 Conversions} *) 55 | 56 | type 'a iter = ('a -> unit) -> unit 57 | type 'a gen = unit -> 'a option 58 | 59 | val of_list : 'a list -> 'a t 60 | val to_list : 'a t -> 'a list 61 | 62 | val of_array_unsafe : 'a array -> 'a t 63 | (** Take ownership of the given array. Careful, the array must {b NOT} 64 | be modified afterwards! *) 65 | 66 | val to_iter : 'a t -> 'a iter 67 | val of_iter : 'a iter -> 'a t 68 | val of_gen : 'a gen -> 'a t 69 | val to_gen : 'a t -> 'a gen 70 | 71 | (** {2 IO} *) 72 | 73 | type 'a printer = Format.formatter -> 'a -> unit 74 | 75 | val pp : 76 | ?pp_start:unit printer -> 77 | ?pp_stop:unit printer -> 78 | ?pp_sep:unit printer -> 79 | 'a printer -> 80 | 'a t printer 81 | (** [pp ~pp_start ~pp_stop ~pp_sep pp_item ppf a] formats the array [a] on [ppf]. 82 | Each element is formatted with [pp_item], [pp_start] is called at the beginning, 83 | [pp_stop] is called at the end, [pp_sep] is called between each elements. 84 | By defaults [pp_start] and [pp_stop] does nothing and [pp_sep] defaults to 85 | (fun out -> Format.fprintf out ",@ "). *) 86 | -------------------------------------------------------------------------------- /src/data/CCLazy_list.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** {1 Lazy List} *) 4 | 5 | type +'a t = 'a node lazy_t 6 | 7 | and +'a node = 8 | | Nil 9 | | Cons of 'a * 'a t 10 | 11 | let empty = Lazy.from_val Nil 12 | let return x = Lazy.from_val (Cons (x, empty)) 13 | 14 | let is_empty = function 15 | | (lazy Nil) -> true 16 | | (lazy (Cons _)) -> false 17 | 18 | let cons x tl = Lazy.from_val (Cons (x, tl)) 19 | 20 | let head = function 21 | | (lazy Nil) -> None 22 | | (lazy (Cons (x, tl))) -> Some (x, tl) 23 | 24 | let length l = 25 | let rec aux acc l = 26 | match l with 27 | | (lazy Nil) -> acc 28 | | (lazy (Cons (_, tl))) -> aux (acc + 1) tl 29 | in 30 | aux 0 l 31 | 32 | let rec map ~f l = 33 | lazy 34 | (match l with 35 | | (lazy Nil) -> Nil 36 | | (lazy (Cons (x, tl))) -> Cons (f x, map ~f tl)) 37 | 38 | let filter ~f l = 39 | let rec aux f l = 40 | match l with 41 | | (lazy Nil) -> Nil 42 | | (lazy (Cons (x, tl))) when f x -> Cons (x, lazy (aux f tl)) 43 | | (lazy (Cons (_, tl))) -> aux f tl 44 | in 45 | lazy (aux f l) 46 | 47 | let rec take n l = 48 | lazy 49 | (match l with 50 | | _ when n = 0 -> Nil 51 | | (lazy Nil) -> Nil 52 | | (lazy (Cons (x, tl))) -> Cons (x, take (n - 1) tl)) 53 | 54 | let rec append a b = 55 | lazy 56 | (match a with 57 | | (lazy Nil) -> Lazy.force b 58 | | (lazy (Cons (x, tl))) -> Cons (x, append tl b)) 59 | 60 | let rec flat_map ~f l = 61 | lazy 62 | (match l with 63 | | (lazy Nil) -> Nil 64 | | (lazy (Cons (x, tl))) -> 65 | let res = append (f x) (flat_map ~f tl) in 66 | Lazy.force res) 67 | 68 | let default ~default l = 69 | lazy 70 | (match l with 71 | | (lazy Nil) -> Lazy.force default 72 | | (lazy l) -> l) 73 | 74 | module Infix = struct 75 | let ( >|= ) x f = map ~f x 76 | let ( >>= ) x f = flat_map ~f x 77 | let ( <|> ) a b = default ~default:b a 78 | end 79 | 80 | include Infix 81 | 82 | type 'a gen = unit -> 'a option 83 | 84 | let rec of_gen g = 85 | lazy 86 | (match g () with 87 | | None -> Nil 88 | | Some x -> Cons (x, of_gen g)) 89 | 90 | let rec of_list = function 91 | | [] -> empty 92 | | x :: tl -> cons x (of_list tl) 93 | 94 | let to_list_rev l = 95 | let rec aux acc = function 96 | | (lazy Nil) -> acc 97 | | (lazy (Cons (x, tl))) -> aux (x :: acc) tl 98 | in 99 | aux [] l 100 | 101 | let to_list l = List.rev (to_list_rev l) 102 | 103 | let to_gen l = 104 | let l = ref l in 105 | fun () -> 106 | match !l with 107 | | (lazy Nil) -> None 108 | | (lazy (Cons (x, tl))) -> 109 | l := tl; 110 | Some x 111 | -------------------------------------------------------------------------------- /src/data/CCLazy_list.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Lazy List 4 | 5 | @since 0.17 *) 6 | 7 | type +'a t = 'a node lazy_t 8 | 9 | and +'a node = 10 | | Nil 11 | | Cons of 'a * 'a t 12 | 13 | val empty : 'a t 14 | (** Empty list. *) 15 | 16 | val return : 'a -> 'a t 17 | (** Return a computed value. *) 18 | 19 | val is_empty : _ t -> bool 20 | (** Evaluate the head. *) 21 | 22 | val length : _ t -> int 23 | (** [length l] returns the number of elements in [l], eagerly (linear time). 24 | Caution, will not terminate if [l] is infinite. *) 25 | 26 | val cons : 'a -> 'a t -> 'a t 27 | 28 | val head : 'a t -> ('a * 'a t) option 29 | (** Evaluate head, return it, or [None] if the list is empty. *) 30 | 31 | val map : f:('a -> 'b) -> 'a t -> 'b t 32 | (** Lazy map. *) 33 | 34 | val filter : f:('a -> bool) -> 'a t -> 'a t 35 | (** Filter values. 36 | @since 0.18 *) 37 | 38 | val take : int -> 'a t -> 'a t 39 | (** Take at most n values. 40 | @since 0.18 *) 41 | 42 | val append : 'a t -> 'a t -> 'a t 43 | (** Lazy concatenation. *) 44 | 45 | val flat_map : f:('a -> 'b t) -> 'a t -> 'b t 46 | (** Monadic flatten + map. *) 47 | 48 | val default : default:'a t -> 'a t -> 'a t 49 | (** Choice operator. 50 | @since 2.1 *) 51 | 52 | module Infix : sig 53 | val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t 54 | val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t 55 | 56 | val ( <|> ) : 'a t -> 'a t -> 'a t 57 | (** Alias to {!default}. 58 | @since 2.1 *) 59 | end 60 | 61 | include module type of Infix 62 | 63 | type 'a gen = unit -> 'a option 64 | 65 | val of_gen : 'a gen -> 'a t 66 | val of_list : 'a list -> 'a t 67 | val to_list : 'a t -> 'a list 68 | val to_list_rev : 'a t -> 'a list 69 | val to_gen : 'a t -> 'a gen 70 | -------------------------------------------------------------------------------- /src/data/CCMixset.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** {1 Set of Heterogeneous Values} *) 4 | 5 | module IMap = Map.Make (struct 6 | type t = int 7 | 8 | let compare : int -> int -> int = compare 9 | end) 10 | 11 | type t = (unit -> unit) IMap.t 12 | 13 | and 'a key = { 14 | id: int; 15 | mutable opt: 'a option; 16 | } 17 | 18 | let newkey_n_ = ref 0 19 | 20 | let newkey () = 21 | let id = !newkey_n_ in 22 | incr newkey_n_; 23 | { id; opt = None } 24 | 25 | let empty = IMap.empty 26 | 27 | let get ~key set = 28 | key.opt <- None; 29 | try 30 | (IMap.find key.id set) (); 31 | key.opt 32 | with Not_found -> None 33 | 34 | let get_exn ~key set = 35 | match get ~key set with 36 | | None -> raise Not_found 37 | | Some v -> v 38 | 39 | let set ~key v set = IMap.add key.id (fun () -> key.opt <- Some v) set 40 | let cardinal set = IMap.cardinal set 41 | -------------------------------------------------------------------------------- /src/data/CCMixset.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Set of Heterogeneous Values 4 | 5 | {[ 6 | let k1 : int key = newkey () in 7 | let k2 : int key = newkey () in 8 | let k3 : string key = newkey () in 9 | let set = 10 | empty 11 | |> set ~key:k1 1 12 | |> set ~key:k2 2 13 | |> set ~key:k3 "3" 14 | in 15 | assert (get ~key:k1 set = Some 1); 16 | assert (get ~key:k2 set = Some 2); 17 | assert (get ~key:k3 set = Some "3"); 18 | () 19 | ]} 20 | 21 | @since 0.11 *) 22 | 23 | type t 24 | (** A set of values of heterogeneous types *) 25 | 26 | type 'a key 27 | (** A unique "key" to access a value of type ['a] in a [set] *) 28 | 29 | val newkey : unit -> 'a key 30 | (** [newkey ()] creates a new unique key that can be used to access 31 | a ['a] value in a set. Each key created with [newkey] is distinct 32 | from any other key, even if they have the same type. 33 | 34 | Not thread-safe. *) 35 | 36 | val empty : t 37 | (** Empty set. *) 38 | 39 | val set : key:'a key -> 'a -> t -> t 40 | (** [set ~key v set] maps [key] to [v] in [set]. It means that 41 | for every [set], [get ~key (set ~key v set) = Some v]. *) 42 | 43 | val get : key:'a key -> t -> 'a option 44 | (** [get ~key set] obtains the value for [key] in [set], if any. *) 45 | 46 | val get_exn : key:'a key -> t -> 'a 47 | (** Same as {!get}, but can fail. 48 | @raise Not_found if the key is not present. *) 49 | 50 | val cardinal : t -> int 51 | (** Number of mappings. *) 52 | -------------------------------------------------------------------------------- /src/data/CCMixtbl.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** {1 Hash Table with Heterogeneous Keys} *) 4 | 5 | type 'b injection = { 6 | get: (unit -> unit) -> 'b option; 7 | set: 'b -> unit -> unit; 8 | } 9 | 10 | type 'a t = ('a, unit -> unit) Hashtbl.t 11 | 12 | let create n = Hashtbl.create n 13 | 14 | let create_inj () = 15 | let r = ref None in 16 | let get f = 17 | r := None; 18 | f (); 19 | !r 20 | and set v () = r := Some v in 21 | { get; set } 22 | 23 | let get ~inj tbl x = try inj.get (Hashtbl.find tbl x) with Not_found -> None 24 | let set ~inj tbl x y = Hashtbl.replace tbl x (inj.set y) 25 | let length tbl = Hashtbl.length tbl 26 | let clear tbl = Hashtbl.clear tbl 27 | let remove tbl x = Hashtbl.remove tbl x 28 | let copy tbl = Hashtbl.copy tbl 29 | 30 | let is_some = function 31 | | None -> false 32 | | Some _ -> true 33 | 34 | let mem ~inj tbl x = 35 | try is_some (inj.get (Hashtbl.find tbl x)) with Not_found -> false 36 | 37 | let find ~inj tbl x = 38 | match inj.get (Hashtbl.find tbl x) with 39 | | None -> raise Not_found 40 | | Some v -> v 41 | 42 | let iter_keys tbl f = Hashtbl.iter (fun x _ -> f x) tbl 43 | let fold_keys tbl acc f = Hashtbl.fold (fun x _ acc -> f acc x) tbl acc 44 | 45 | (** {2 Iterators} *) 46 | 47 | type 'a iter = ('a -> unit) -> unit 48 | 49 | let keys_iter tbl yield = Hashtbl.iter (fun x _ -> yield x) tbl 50 | 51 | let bindings_of ~inj tbl yield = 52 | Hashtbl.iter 53 | (fun k value -> 54 | match inj.get value with 55 | | None -> () 56 | | Some v -> yield (k, v)) 57 | tbl 58 | 59 | type value = Value : ('b injection -> 'b option) -> value 60 | 61 | let bindings tbl yield = 62 | Hashtbl.iter (fun x y -> yield (x, Value (fun inj -> inj.get y))) tbl 63 | -------------------------------------------------------------------------------- /src/data/CCMultiSet.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Multiset *) 4 | 5 | type 'a iter = ('a -> unit) -> unit 6 | type 'a printer = Format.formatter -> 'a -> unit 7 | 8 | module type S = sig 9 | type elt 10 | type t 11 | 12 | val empty : t 13 | val is_empty : t -> bool 14 | val mem : t -> elt -> bool 15 | val count : t -> elt -> int 16 | val singleton : elt -> t 17 | val add : t -> elt -> t 18 | val remove : t -> elt -> t 19 | 20 | val add_mult : t -> elt -> int -> t 21 | (** [add_mult set x n] adds [n] occurrences of [x] to [set]. 22 | @raise Invalid_argument if [n < 0]. 23 | @since 0.6 *) 24 | 25 | val remove_mult : t -> elt -> int -> t 26 | (** [remove_mult set x n] removes at most [n] occurrences of [x] from [set]. 27 | @raise Invalid_argument if [n < 0]. 28 | @since 0.6 *) 29 | 30 | val remove_all : t -> elt -> t 31 | (** [remove_all set x] removes all occurrences of [x] from [set]. 32 | @since 0.22 *) 33 | 34 | val update : t -> elt -> (int -> int) -> t 35 | (** [update set x f] calls [f n] where [n] is the current multiplicity 36 | of [x] in [set] ([0] to indicate its absence); the result of [f n] 37 | is the new multiplicity of [x]. 38 | @raise Invalid_argument if [f n < 0]. 39 | @since 0.6 *) 40 | 41 | val min : t -> elt 42 | (** Minimal element w.r.t the total ordering on elements. *) 43 | 44 | val max : t -> elt 45 | (** Maximal element w.r.t the total ordering on elements. *) 46 | 47 | val union : t -> t -> t 48 | (** [union a b] contains as many occurrences of an element [x] 49 | as [count a x + count b x]. *) 50 | 51 | val meet : t -> t -> t 52 | (** [meet a b] is a multiset such that 53 | [count (meet a b) x = max (count a x) (count b x)]. *) 54 | 55 | val intersection : t -> t -> t 56 | (** [intersection a b] is a multiset such that 57 | [count (intersection a b) x = min (count a x) (count b x)]. *) 58 | 59 | val diff : t -> t -> t 60 | (** MultiSet difference. 61 | [count (diff a b) x = max (count a x - count b x) 0]. *) 62 | 63 | val contains : t -> t -> bool 64 | (** [contains a x = (count m x > 0)]. *) 65 | 66 | val compare : t -> t -> int 67 | val equal : t -> t -> bool 68 | 69 | val cardinal : t -> int 70 | (** Number of distinct elements. *) 71 | 72 | val iter : t -> (int -> elt -> unit) -> unit 73 | val fold : t -> 'b -> ('b -> int -> elt -> 'b) -> 'b 74 | val of_list : elt list -> t 75 | val to_list : t -> elt list 76 | val to_iter : t -> elt iter 77 | val of_iter : elt iter -> t 78 | 79 | val of_list_mult : (elt * int) list -> t 80 | (** @since 0.19 *) 81 | 82 | val to_list_mult : t -> (elt * int) list 83 | (** @since 0.19 *) 84 | 85 | val to_iter_mult : t -> (elt * int) iter 86 | (** @since 0.19 *) 87 | 88 | val of_iter_mult : (elt * int) iter -> t 89 | (** @since 0.19 *) 90 | 91 | val pp : 92 | ?pp_start:unit printer -> 93 | ?pp_stop:unit printer -> 94 | ?pp_sep:unit printer -> 95 | elt printer -> 96 | t printer 97 | (** Print the multiset. 98 | @since 3.14 *) 99 | end 100 | 101 | module Make (O : Set.OrderedType) : S with type elt = O.t 102 | -------------------------------------------------------------------------------- /src/data/CCMutHeap.mli: -------------------------------------------------------------------------------- 1 | (* This code is extracted from Msat ( https://github.com/Gbury/mSAT ). 2 | As such it is under the Apache 2 License. 3 | *) 4 | 5 | (** Mutable Heaps 6 | 7 | The classic binary heap in a vector. 8 | 9 | {b STATUS}: experimental, this might change in breaking ways. 10 | 11 | @since 3.1 *) 12 | 13 | module type RANKED = CCMutHeap_intf.RANKED 14 | module type S = CCMutHeap_intf.S 15 | 16 | module Make (X : RANKED) : S with type elt = X.t 17 | -------------------------------------------------------------------------------- /src/data/CCMutHeap_intf.ml: -------------------------------------------------------------------------------- 1 | (* This code is extracted from Msat ( https://github.com/Gbury/mSAT ). *) 2 | 3 | (** {1 Imperative Heaps} *) 4 | 5 | module type RANKED = sig 6 | type t 7 | 8 | val idx : t -> int 9 | (** Index in heap. return -1 if never set *) 10 | 11 | val set_idx : t -> int -> unit 12 | (** Update index in heap *) 13 | 14 | val lt : t -> t -> bool 15 | (** [cmp a b] is true iff [a < b] *) 16 | end 17 | 18 | module type S = sig 19 | type elt 20 | (** Type of elements *) 21 | 22 | type t 23 | (** Heap of {!elt}, whose priority is increased or decreased 24 | incrementally (see {!decrease} for instance) *) 25 | 26 | val create : unit -> t 27 | (** Create a heap *) 28 | 29 | val decrease : t -> elt -> unit 30 | (** [decrease h x] decreases the value associated to [x] within [h] *) 31 | 32 | val increase : t -> elt -> unit 33 | (** [increase h x] increases the value associated to [x] within [h] *) 34 | 35 | val in_heap : elt -> bool 36 | 37 | val size : t -> int 38 | (** Number of integers within the heap *) 39 | 40 | val is_empty : t -> bool 41 | 42 | val clear : t -> unit 43 | (** Clear the content of the heap *) 44 | 45 | val insert : t -> elt -> unit 46 | (** Insert a new element into the heap *) 47 | 48 | (*val update : (int -> int -> bool) -> t -> int -> unit*) 49 | 50 | val remove_min : t -> elt 51 | (** Remove and return the integer that has the lowest value from the heap 52 | @raise Not_found if the heap is empty *) 53 | 54 | val filter : t -> (elt -> bool) -> unit 55 | (** Filter out values that don't satisfy the predicate *) 56 | end 57 | -------------------------------------------------------------------------------- /src/data/CCSimple_queue.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** Functional queues (fifo) *) 4 | 5 | (** Simple implementation of functional queues 6 | @since 1.3 *) 7 | 8 | type 'a iter = ('a -> unit) -> unit 9 | (** Fast internal iterator. 10 | @since 2.8 *) 11 | 12 | type 'a printer = Format.formatter -> 'a -> unit 13 | type 'a gen = unit -> 'a option 14 | 15 | type +'a t 16 | (** Queue containing elements of type 'a *) 17 | 18 | val empty : 'a t 19 | val is_empty : 'a t -> bool 20 | 21 | val push : 'a -> 'a t -> 'a t 22 | (** Push element at the end of the queue. *) 23 | 24 | val snoc : 'a t -> 'a -> 'a t 25 | (** Flip version of {!push}. *) 26 | 27 | val peek : 'a t -> 'a option 28 | (** First element of the queue. *) 29 | 30 | val peek_exn : 'a t -> 'a 31 | (** Same as {!peek} but 32 | @raise Invalid_argument if the queue is empty. *) 33 | 34 | val pop : 'a t -> ('a * 'a t) option 35 | (** Get and remove the first element. *) 36 | 37 | val pop_exn : 'a t -> 'a * 'a t 38 | (** Same as {!pop}, but fails on empty queues. 39 | @raise Invalid_argument if the queue is empty. *) 40 | 41 | val junk : 'a t -> 'a t 42 | (** Remove first element. If the queue is empty, do nothing. *) 43 | 44 | val append : 'a t -> 'a t -> 'a t 45 | (** Append two queues. Elements from the second one come 46 | after elements of the first one. 47 | Linear in the size of the second queue. *) 48 | 49 | val map : ('a -> 'b) -> 'a t -> 'b t 50 | (** Map values. *) 51 | 52 | val rev : 'a t -> 'a t 53 | (** Reverse the queue. Constant time. *) 54 | 55 | val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool 56 | 57 | module Infix : sig 58 | val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t 59 | (** Alias to {!map}. *) 60 | 61 | val ( @ ) : 'a t -> 'a t -> 'a t 62 | (** Alias to {!append}. *) 63 | 64 | val ( <:: ) : 'a t -> 'a -> 'a t 65 | (** Alias to {!snoc}. *) 66 | end 67 | 68 | include module type of Infix 69 | 70 | val length : 'a t -> int 71 | (** Number of elements in the queue (linear in time). *) 72 | 73 | val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b 74 | val iter : ('a -> unit) -> 'a t -> unit 75 | val to_list : 'a t -> 'a list 76 | val add_list : 'a t -> 'a list -> 'a t 77 | val of_list : 'a list -> 'a t 78 | val to_iter : 'a t -> 'a iter 79 | val add_iter : 'a t -> 'a iter -> 'a t 80 | val of_iter : 'a iter -> 'a t 81 | 82 | val to_seq : 'a t -> 'a Seq.t 83 | (** Renamed from [to_std_seq] since 3.0. 84 | @since 3.0 *) 85 | 86 | val add_seq : 'a t -> 'a Seq.t -> 'a t 87 | (** Renamed from [add_std_seq] since 3.0. 88 | @since 3.0 *) 89 | 90 | val of_seq : 'a Seq.t -> 'a t 91 | (** Renamed from [of_std_seq] since 3.0. 92 | @since 3.0 *) 93 | 94 | val of_gen : 'a gen -> 'a t 95 | val add_gen : 'a t -> 'a gen -> 'a t 96 | val to_gen : 'a t -> 'a gen 97 | 98 | (** {2 IO} *) 99 | 100 | val pp : ?sep:unit printer -> 'a printer -> 'a t printer 101 | -------------------------------------------------------------------------------- /src/data/CCZipper.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** {1 List Zipper} *) 4 | 5 | type 'a t = 'a list * 'a list 6 | 7 | let empty = [], [] 8 | 9 | let is_empty = function 10 | | [], [] -> true 11 | | _ -> false 12 | 13 | let to_list (l, r) = List.rev_append l r 14 | let to_rev_list (l, r) = List.rev_append r l 15 | let make l = [], l 16 | 17 | let left = function 18 | | x :: l, r -> l, x :: r 19 | | [], r -> [], r 20 | 21 | let left_exn = function 22 | | x :: l, r -> l, x :: r 23 | | [], _ -> invalid_arg "zipper.left_exn" 24 | 25 | let right = function 26 | | l, x :: r -> x :: l, r 27 | | l, [] -> l, [] 28 | 29 | let right_exn = function 30 | | l, x :: r -> x :: l, r 31 | | _, [] -> invalid_arg "zipper.right_exn" 32 | 33 | let modify f z = 34 | match z with 35 | | l, [] -> 36 | (match f None with 37 | | None -> z 38 | | Some x -> l, [ x ]) 39 | | l, x :: r -> 40 | (match f (Some x) with 41 | | None -> l, r 42 | | Some _ -> l, x :: r) 43 | 44 | let is_focused = function 45 | | _, _ :: _ -> true 46 | | _, [] -> false 47 | 48 | let focused = function 49 | | _, x :: _ -> Some x 50 | | _, [] -> None 51 | 52 | let focused_exn = function 53 | | _, x :: _ -> x 54 | | _, [] -> raise Not_found 55 | 56 | let insert x (l, r) = l, x :: r 57 | 58 | let remove (l, r) = 59 | match r with 60 | | [] -> l, [] 61 | | _ :: r' -> l, r' 62 | 63 | let drop_before (_, r) = [], r 64 | 65 | let drop_after (l, r) = 66 | match r with 67 | | [] -> l, [] 68 | | x :: _ -> l, [ x ] 69 | 70 | let drop_after_and_focused (l, _) = l, [] 71 | -------------------------------------------------------------------------------- /src/data/CCZipper.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** List Zipper 4 | 5 | @since 1.0 *) 6 | 7 | type 'a t = 'a list * 'a list 8 | (** The pair [l, r] represents the list [List.rev_append l r], but 9 | with the focus on [r] *) 10 | 11 | val empty : 'a t 12 | (** Empty zipper. *) 13 | 14 | val is_empty : _ t -> bool 15 | (** Empty zipper? Returns [true] iff the two lists are empty. *) 16 | 17 | val to_list : 'a t -> 'a list 18 | (** Convert the zipper back to a list. 19 | [to_list (l,r)] is [List.rev_append l r]. *) 20 | 21 | val to_rev_list : 'a t -> 'a list 22 | (** Convert the zipper back to a {i reversed} list. 23 | In other words, [to_list (l,r)] is [List.rev_append r l]. *) 24 | 25 | val make : 'a list -> 'a t 26 | (** Create a zipper pointing at the first element of the list. *) 27 | 28 | val left : 'a t -> 'a t 29 | (** Go to the left, or do nothing if the zipper is already at leftmost pos. *) 30 | 31 | val left_exn : 'a t -> 'a t 32 | (** Go to the left, or 33 | @raise Invalid_argument if the zipper is already at leftmost pos. *) 34 | 35 | val right : 'a t -> 'a t 36 | (** Go to the right, or do nothing if the zipper is already at rightmost pos. *) 37 | 38 | val right_exn : 'a t -> 'a t 39 | (** Go to the right, or 40 | @raise Invalid_argument if the zipper is already at rightmost pos. *) 41 | 42 | val modify : ('a option -> 'a option) -> 'a t -> 'a t 43 | (** Modify the current element, if any, by returning a new element, or 44 | returning [None] if the element is to be deleted. *) 45 | 46 | val insert : 'a -> 'a t -> 'a t 47 | (** Insert an element at the current position. If an element was focused, 48 | [insert x l] adds [x] just before it, and focuses on [x]. *) 49 | 50 | val remove : 'a t -> 'a t 51 | (** [remove l] removes the current element, if any. *) 52 | 53 | val is_focused : _ t -> bool 54 | (** Is the zipper focused on some element? That is, will {!focused} 55 | return a [Some v]? *) 56 | 57 | val focused : 'a t -> 'a option 58 | (** Return the focused element, if any. [focused zip = Some _] iff 59 | [empty zip = false]. *) 60 | 61 | val focused_exn : 'a t -> 'a 62 | (** Return the focused element, or 63 | @raise Not_found if the zipper is at an end. *) 64 | 65 | val drop_before : 'a t -> 'a t 66 | (** Drop every element on the "left" (calling {!left} then will do nothing). *) 67 | 68 | val drop_after : 'a t -> 'a t 69 | (** Drop every element on the "right" (calling {!right} then will do nothing), 70 | keeping the focused element, if any. *) 71 | 72 | val drop_after_and_focused : 'a t -> 'a t 73 | (** Drop every element on the "right" (calling {!right} then will do nothing), 74 | {i including} the focused element if it is present. *) 75 | -------------------------------------------------------------------------------- /src/data/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name containers_data) 3 | (public_name containers-data) 4 | (wrapped false) 5 | (flags 6 | :standard 7 | -warn-error 8 | -3 9 | -w 10 | -70 11 | -color 12 | always 13 | -safe-string 14 | -strict-sequence) 15 | (libraries containers)) 16 | -------------------------------------------------------------------------------- /src/data/top/containers_data_top.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | type 'a printer = Format.formatter -> 'a -> unit 4 | 5 | let eval_exn str = 6 | let lexbuf = Lexing.from_string str in 7 | let phrase = !Toploop.parse_toplevel_phrase lexbuf in 8 | Toploop.execute_phrase false Format.err_formatter phrase 9 | 10 | let install_printer s = 11 | try ignore (eval_exn ("#install_printer " ^ s ^ " ;; ")) 12 | with _ -> 13 | Printexc.print_backtrace stderr; 14 | () 15 | 16 | let install_printers = List.iter install_printer 17 | 18 | let () = 19 | install_printers 20 | [ 21 | "CCBV.pp"; 22 | "CCDeque.pp"; 23 | "CCFQueue.pp"; 24 | "CCFun_vec.pp"; 25 | "CCIntMap.pp"; 26 | "CCPersistentArray.pp"; 27 | ] 28 | -------------------------------------------------------------------------------- /src/data/top/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name containers_data_top) 3 | (public_name containers-data.top) 4 | (wrapped false) 5 | (modes byte) 6 | (flags :standard -warn-error -a+8 -safe-string) 7 | (libraries compiler-libs.common containers containers-data)) 8 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name mdx_runner) 3 | (libraries containers) 4 | (modules mdx_runner)) 5 | -------------------------------------------------------------------------------- /src/leb128/containers_leb128.ml: -------------------------------------------------------------------------------- 1 | (* adapted from ocaml-protoc from code by c-cube *) 2 | 3 | module Byte_slice = CCByte_slice 4 | module Byte_buffer = CCByte_buffer 5 | 6 | module Decode = struct 7 | let skip (sl : Byte_slice.t) off : int = 8 | let shift = ref 0 in 9 | let continue = ref true in 10 | 11 | let off = ref off in 12 | let n_consumed = ref 0 in 13 | 14 | while !continue do 15 | if sl.len <= 0 then invalid_arg "out of bound"; 16 | incr n_consumed; 17 | let b = Char.code (Bytes.get sl.bs !off) in 18 | let cur = b land 0x7f in 19 | if cur <> b then ( 20 | (* at least one byte follows this one *) 21 | incr off; 22 | shift := !shift + 7 23 | ) else if !shift < 63 || b land 0x7f <= 1 then 24 | continue := false 25 | else 26 | invalid_arg "leb128 varint is too long" 27 | done; 28 | 29 | !n_consumed 30 | 31 | let u64 (sl : Byte_slice.t) (off : int) : int64 * int = 32 | let shift = ref 0 in 33 | let res = ref 0L in 34 | let continue = ref true in 35 | 36 | let off = ref off in 37 | let n_consumed = ref 0 in 38 | 39 | while !continue do 40 | if sl.len <= 0 then invalid_arg "out of bound"; 41 | incr n_consumed; 42 | let b = Char.code (Bytes.get sl.bs !off) in 43 | let cur = b land 0x7f in 44 | if cur <> b then ( 45 | (* at least one byte follows this one *) 46 | (res := Int64.(logor !res (shift_left (of_int cur) !shift))); 47 | incr off; 48 | shift := !shift + 7 49 | ) else if !shift < 63 || b land 0x7f <= 1 then ( 50 | (res := Int64.(logor !res (shift_left (of_int b) !shift))); 51 | continue := false 52 | ) else 53 | invalid_arg "leb128 varint is too long" 54 | done; 55 | 56 | !res, !n_consumed 57 | 58 | let[@inline] uint_truncate sl off = 59 | let v, n_consumed = u64 sl off in 60 | Int64.to_int v, n_consumed 61 | 62 | let[@inline] decode_zigzag (v : int64) : int64 = 63 | Int64.(logxor (shift_right v 1) (neg (logand v Int64.one))) 64 | 65 | let[@inline] i64 sl off : int64 * int = 66 | let v, n_consumed = u64 sl off in 67 | decode_zigzag v, n_consumed 68 | 69 | let[@inline] int_truncate sl off = 70 | let v, n_consumed = u64 sl off in 71 | Int64.to_int (decode_zigzag v), n_consumed 72 | end 73 | 74 | module Encode = struct 75 | let[@inline] encode_zigzag (i : int64) : int64 = 76 | Int64.(logxor (shift_left i 1) (shift_right i 63)) 77 | 78 | external varint_size : (int64[@unboxed]) -> int 79 | = "caml_cc_leb128_varint_size_byte" "caml_cc_leb128_varint_size" 80 | [@@noalloc] 81 | (** Compute how many bytes this int would occupy as varint *) 82 | 83 | external varint_slice : bytes -> (int[@untagged]) -> (int64[@unboxed]) -> unit 84 | = "caml_cc_leb128_varint_byte" "caml_cc_leb128_varint" 85 | [@@noalloc] 86 | (** Write this int as varint into the given slice *) 87 | 88 | let[@inline] u64 (buf : Byte_buffer.t) (i : int64) = 89 | let n = varint_size i in 90 | Byte_buffer.ensure_free buf n; 91 | assert (buf.len + n <= Bytes.length buf.bs); 92 | varint_slice buf.bs buf.len i; 93 | buf.len <- buf.len + n 94 | 95 | let[@inline] i64 buf i : unit = u64 buf (encode_zigzag i) 96 | let[@inline] uint buf i : unit = u64 buf (Int64.of_int i) 97 | let[@inline] int buf i : unit = u64 buf (encode_zigzag (Int64.of_int i)) 98 | end 99 | -------------------------------------------------------------------------------- /src/leb128/containers_leb128.mli: -------------------------------------------------------------------------------- 1 | (** LEB128 encoding and decoding. 2 | 3 | See https://en.wikipedia.org/wiki/LEB128 . *) 4 | 5 | module Byte_slice = CCByte_slice 6 | module Byte_buffer = CCByte_buffer 7 | 8 | module Decode : sig 9 | val decode_zigzag : int64 -> int64 10 | (** Turn an unsigned integer into a signed one. 11 | 12 | See https://en.wikipedia.org/wiki/Variable-length_quantity#Zigzag_encoding 13 | *) 14 | 15 | val skip : Byte_slice.t -> int -> int 16 | (** [skip slice off] reads an integer at offset [off], and returns how many 17 | bytes the integer occupies. *) 18 | 19 | val u64 : Byte_slice.t -> int -> int64 * int 20 | (** [u64 slice off] reads an integer at offset [off], and returns a pair 21 | [v, n_consumed]. [v] is the read integer, [n_consumed] is the number of 22 | bytes consumed during reading. *) 23 | 24 | val i64 : Byte_slice.t -> int -> int64 * int 25 | (** Read a signed int64 by reading a u64 and zigzag decoding it *) 26 | 27 | val int_truncate : Byte_slice.t -> int -> int * int 28 | (** Like {!i64} but truncates to integer. Returns a pair [v, n_consumed]. *) 29 | 30 | val uint_truncate : Byte_slice.t -> int -> int * int 31 | (** Like {!u64} but truncates to integer. *) 32 | end 33 | 34 | module Encode : sig 35 | val encode_zigzag : int64 -> int64 36 | (** Turn a signed int64 into a u64 via zigzag encoding. *) 37 | 38 | val u64 : Byte_buffer.t -> int64 -> unit 39 | (** Write a unsigned int *) 40 | 41 | val i64 : Byte_buffer.t -> int64 -> unit 42 | (** Write a signed int via zigzag encoding *) 43 | 44 | val uint : Byte_buffer.t -> int -> unit 45 | (** Turn an uint into a u64 and write it *) 46 | 47 | val int : Byte_buffer.t -> int -> unit 48 | (** Turn an int into a int64 and write it *) 49 | end 50 | -------------------------------------------------------------------------------- /src/leb128/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name containers_leb128) 3 | (public_name containers.leb128) 4 | (synopsis 5 | "LEB128 encoding (https://en.wikipedia.org/wiki/LEB128) for cephalopod") 6 | (libraries containers) 7 | (foreign_stubs 8 | (language c) 9 | (flags :standard -std=c99 -O2) 10 | (names stubs)) 11 | (ocamlopt_flags :standard -inline 100)) 12 | -------------------------------------------------------------------------------- /src/leb128/stubs.c: -------------------------------------------------------------------------------- 1 | 2 | // readapted from ocaml-protoc, original code also from c-cube 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | 10 | static inline int ix_leb128_varint_size(uint64_t i) { 11 | /* generated with: 12 | for i in range(1,10): 13 | ceiling = (1 << (i*7))-1 14 | print(f'if (i <= {ceiling}L) return {i};') 15 | */ 16 | 17 | if (i <= 127L) return 1; 18 | if (i <= 16383L) return 2; 19 | if (i <= 2097151L) return 3; 20 | if (i <= 268435455L) return 4; 21 | if (i <= 34359738367L) return 5; 22 | if (i <= 4398046511103L) return 6; 23 | if (i <= 562949953421311L) return 7; 24 | if (i <= 72057594037927935L) return 8; 25 | if (i <= 9223372036854775807L) return 9; 26 | return 10; 27 | } 28 | 29 | // number of bytes for i 30 | CAMLprim value caml_cc_leb128_varint_size(int64_t i) { 31 | int res = ix_leb128_varint_size(i); 32 | return Val_int(res); 33 | } 34 | 35 | // boxed version, for bytecode 36 | CAMLprim value caml_cc_leb128_varint_size_byte(value v_i) { 37 | CAMLparam1(v_i); 38 | 39 | int64_t i = Int64_val(v_i); 40 | int res = ix_leb128_varint_size(i); 41 | CAMLreturn(Val_int(res)); 42 | } 43 | 44 | // write i at str[idx…] in varint 45 | static inline void ix_leb128_varint(unsigned char *str, uint64_t i) { 46 | while (true) { 47 | uint64_t cur = i & 0x7f; 48 | if (cur == i) { 49 | *str = (unsigned char)cur; 50 | break; 51 | } else { 52 | *str = (unsigned char)(cur | 0x80); 53 | i = i >> 7; 54 | ++str; 55 | } 56 | } 57 | } 58 | 59 | // write `i` starting at `idx` 60 | CAMLprim value caml_cc_leb128_varint(value _str, intnat idx, int64_t i) { 61 | char *str = Bytes_val(_str); 62 | ix_leb128_varint(str + idx, i); 63 | return Val_unit; 64 | } 65 | 66 | CAMLprim value caml_cc_leb128_varint_byte(value _str, value _idx, value _i) { 67 | CAMLparam3(_str, _idx, _i); 68 | char *str = Bytes_val(_str); 69 | int idx = Int_val(_idx); 70 | int64_t i = Int64_val(_i); 71 | ix_leb128_varint(str + idx, i); 72 | CAMLreturn(Val_unit); 73 | } 74 | -------------------------------------------------------------------------------- /src/mdx_runner.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | 3 | let just_copy () = 4 | let ic = open_in "README.md" in 5 | let len = in_channel_length ic in 6 | let buf = Bytes.create len in 7 | really_input ic buf 0 len; 8 | close_in_noerr ic; 9 | 10 | let oc = open_out "README.md.corrected" in 11 | output oc buf 0 len; 12 | flush oc; 13 | close_out_noerr oc 14 | 15 | let () = 16 | try 17 | let e = Sys.command "ocaml-mdx test README.md -o README.md.corrected" in 18 | if e <> 0 then ( 19 | printf "warning: ocaml-mdx exited with code %d\n" e; 20 | just_copy () 21 | ) else 22 | print_endline "ocaml-mdx returned 0 ✔" 23 | with Sys_error e -> 24 | printf "error when running mdx: %s\n" e; 25 | just_copy (); 26 | () 27 | -------------------------------------------------------------------------------- /src/monomorphic/CCMonomorphic.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | let ( = ) : int -> int -> bool = Stdlib.( = ) 4 | let ( <> ) : int -> int -> bool = Stdlib.( <> ) 5 | let ( < ) : int -> int -> bool = Stdlib.( < ) 6 | let ( > ) : int -> int -> bool = Stdlib.( > ) 7 | let ( <= ) : int -> int -> bool = Stdlib.( <= ) 8 | let ( >= ) : int -> int -> bool = Stdlib.( >= ) 9 | let compare : int -> int -> int = Stdlib.compare 10 | 11 | [@@@ifge 4.13] 12 | 13 | let min : int -> int -> int = Int.min 14 | let max : int -> int -> int = Int.max 15 | 16 | [@@@else_] 17 | 18 | let min : int -> int -> int = Stdlib.min 19 | let max : int -> int -> int = Stdlib.max 20 | 21 | [@@@endif] 22 | 23 | let ( =. ) : float -> float -> bool = Stdlib.( = ) 24 | let ( <>. ) : float -> float -> bool = Stdlib.( <> ) 25 | let ( <. ) : float -> float -> bool = Stdlib.( < ) 26 | let ( >. ) : float -> float -> bool = Stdlib.( > ) 27 | let ( <=. ) : float -> float -> bool = Stdlib.( <= ) 28 | let ( >=. ) : float -> float -> bool = Stdlib.( >= ) 29 | let ( == ) = `Consider_using_CCEqual_physical 30 | let ( != ) = `Consider_using_CCEqual_physical 31 | -------------------------------------------------------------------------------- /src/monomorphic/CCMonomorphic.mli: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | (** {1 Shadow unsafe functions and operators from Stdlib} *) 4 | 5 | (** @since 2.0 *) 6 | 7 | val ( = ) : int -> int -> bool 8 | val ( <> ) : int -> int -> bool 9 | val ( < ) : int -> int -> bool 10 | val ( > ) : int -> int -> bool 11 | val ( <= ) : int -> int -> bool 12 | val ( >= ) : int -> int -> bool 13 | val compare : int -> int -> int 14 | val min : int -> int -> int 15 | val max : int -> int -> int 16 | 17 | (** {2 Infix operators for Floats} *) 18 | 19 | val ( =. ) : float -> float -> bool 20 | (** @since 2.1 *) 21 | 22 | val ( <>. ) : float -> float -> bool 23 | (** @since 2.1 *) 24 | 25 | val ( <. ) : float -> float -> bool 26 | (** @since 2.1 *) 27 | 28 | val ( >. ) : float -> float -> bool 29 | (** @since 2.1 *) 30 | 31 | val ( <=. ) : float -> float -> bool 32 | (** @since 2.1 *) 33 | 34 | val ( >=. ) : float -> float -> bool 35 | (** @since 2.1 *) 36 | 37 | (** {2 Shadow Dangerous Operators} *) 38 | 39 | val ( == ) : [ `Consider_using_CCEqual_physical ] 40 | [@@ocaml.deprecated "Please use CCEqual.physical or Stdlib.(==) instead."] 41 | 42 | val ( != ) : [ `Consider_using_CCEqual_physical ] 43 | [@@ocaml.deprecated "Please use [not CCEqual.physical] or Stdlib.(!=) instead."] 44 | (** @since 2.1 *) 45 | -------------------------------------------------------------------------------- /src/monomorphic/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name containers_monomorphic) 3 | (public_name containers.monomorphic) 4 | (preprocess 5 | (action 6 | (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))) 7 | (modules CCMonomorphic) 8 | (wrapped false)) 9 | -------------------------------------------------------------------------------- /src/pp/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name containers_pp) 3 | (public_name containers.pp) 4 | (synopsis "Pretty printer for Containers") 5 | (flags :standard) 6 | (libraries containers)) 7 | -------------------------------------------------------------------------------- /src/pvec/containers_pvec.mli: -------------------------------------------------------------------------------- 1 | (** Functional Vectors. 2 | 3 | These are trees with a large branching factor for logarithmic operations with 4 | a low multiplicative factor. 5 | 6 | {b status: experimental} 7 | 8 | @since 3.13.1 9 | *) 10 | 11 | type 'a iter = ('a -> unit) -> unit 12 | 13 | [@@@ifge 5.0] 14 | 15 | type !'a t 16 | 17 | [@@@else_] 18 | 19 | type 'a t 20 | 21 | [@@@endif] 22 | 23 | val empty : 'a t 24 | (** Empty vector. *) 25 | 26 | val is_empty : _ t -> bool 27 | (** Is the vector empty? *) 28 | 29 | val return : 'a -> 'a t 30 | (** Single element vector. *) 31 | 32 | val length : _ t -> int 33 | (** Number of elements. Constant time. *) 34 | 35 | val make : int -> 'a -> 'a t 36 | (** [make n x] makes a vector with [n] copies 37 | of the element [x] *) 38 | 39 | val push : 'a t -> 'a -> 'a t 40 | (** Add element at the end. *) 41 | 42 | val get : 'a t -> int -> 'a 43 | (** @raise Invalid_argument if key not present. *) 44 | 45 | val get_opt : 'a t -> int -> 'a option 46 | 47 | val last : 'a t -> 'a 48 | (** Last element. 49 | @raise Invalid_argument if the vec is empty *) 50 | 51 | val last_opt : 'a t -> 'a option 52 | 53 | val pop : 'a t -> 'a * 'a t 54 | (** Pop last element. 55 | @raise Invalid_argument in case the vec is empty. *) 56 | 57 | val pop_opt : 'a t -> ('a * 'a t) option 58 | (** Pop last element. *) 59 | 60 | val drop_last : 'a t -> 'a t 61 | (** Like {!pop_opt} but doesn't return the last element. 62 | Returns the same vector if it's empty. *) 63 | 64 | val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool 65 | val iter : ('a -> unit) -> 'a t -> unit 66 | 67 | val iter_rev : ('a -> unit) -> 'a t -> unit 68 | (** Iterate on elements but starting from the end. *) 69 | 70 | val iteri : (int -> 'a -> unit) -> 'a t -> unit 71 | (** Iterate on elements with their index, in increasing order. *) 72 | 73 | val iteri_rev : (int -> 'a -> unit) -> 'a t -> unit 74 | (** Iterate on elements with their index, but starting from the end. *) 75 | 76 | val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b 77 | val fold_rev : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b 78 | val fold_lefti : ('b -> int -> 'a -> 'b) -> 'b -> 'a t -> 'b 79 | val fold_revi : ('b -> int -> 'a -> 'b) -> 'b -> 'a t -> 'b 80 | 81 | val append : 'a t -> 'a t -> 'a t 82 | (** [append a b] adds all elements of [b] at the end of [a]. This is 83 | at least linear in the length of [b]. *) 84 | 85 | val map : ('a -> 'b) -> 'a t -> 'b t 86 | 87 | val choose : 'a t -> 'a option 88 | (** Return an element. It is unspecified which one is returned. *) 89 | 90 | val to_list : 'a t -> 'a list 91 | val of_list : 'a list -> 'a t 92 | val add_list : 'a t -> 'a list -> 'a t 93 | val add_iter : 'a t -> 'a iter -> 'a t 94 | val of_iter : 'a iter -> 'a t 95 | val to_iter : 'a t -> 'a iter 96 | val add_seq : 'a t -> 'a Seq.t -> 'a t 97 | val of_seq : 'a Seq.t -> 'a t 98 | val to_seq : 'a t -> 'a Seq.t 99 | 100 | (**/**) 101 | 102 | module Private_ : sig 103 | type 'a printer = Format.formatter -> 'a -> unit 104 | 105 | val debug : 'a printer -> 'a t printer 106 | end 107 | 108 | (**/**) 109 | -------------------------------------------------------------------------------- /src/pvec/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name containers_pvec) 3 | (public_name containers.pvec) 4 | (preprocess 5 | (action 6 | (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))) 7 | (synopsis "Persistent vector for OCaml")) 8 | -------------------------------------------------------------------------------- /src/scc/containers_scc.mli: -------------------------------------------------------------------------------- 1 | type 'a iter = ('a -> unit) -> unit 2 | 3 | module type ARG = sig 4 | type t 5 | type node 6 | 7 | val children : t -> node -> node iter 8 | 9 | module Node_tbl : Hashtbl.S with type key = node 10 | end 11 | 12 | module type S = sig 13 | module A : ARG 14 | 15 | val scc : A.t -> A.node list -> A.node list list 16 | end 17 | 18 | module Make (A : ARG) : S with module A = A 19 | 20 | val scc : 21 | tbl:(module Hashtbl.S with type key = 'node) -> 22 | graph:'graph -> 23 | children:('graph -> 'node -> 'node iter) -> 24 | nodes:'node list -> 25 | unit -> 26 | 'node list list 27 | (** Compute the strongly connected components of the given [graph], 28 | reachable from [nodes]. 29 | 30 | @param graph the graph state 31 | @param children maps a node to its direct descendants (children) 32 | @param nodes initial nodes. 33 | @param tbl a hashtable implementation that takes nodes as keys 34 | *) 35 | -------------------------------------------------------------------------------- /src/scc/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name containers_scc) 3 | (public_name containers.scc) 4 | (synopsis "strongly connected components algorithm") 5 | (libraries containers)) 6 | -------------------------------------------------------------------------------- /src/testlib/containers_testlib.mli: -------------------------------------------------------------------------------- 1 | type 'a eq = 'a -> 'a -> bool 2 | type 'a print = 'a -> string 3 | 4 | module Test : sig 5 | type t 6 | end 7 | 8 | module type S = sig 9 | module Q = QCheck 10 | 11 | val t : ?name:string -> (unit -> bool) -> unit 12 | val eq : ?name:string -> ?cmp:'a eq -> ?printer:'a print -> 'a -> 'a -> unit 13 | 14 | val q : 15 | ?name:string -> 16 | ?count:int -> 17 | ?long_factor:int -> 18 | ?max_gen:int -> 19 | ?max_fail:int -> 20 | ?if_assumptions_fail:[ `Fatal | `Warning ] * float -> 21 | 'a Q.arbitrary -> 22 | ('a -> bool) -> 23 | unit 24 | 25 | val assert_equal : 26 | ?printer:('a -> string) -> ?cmp:('a -> 'a -> bool) -> 'a -> 'a -> unit 27 | 28 | val assert_bool : string -> bool -> unit 29 | val assert_failure : string -> 'a 30 | val assert_raises : (exn -> bool) -> (unit -> 'b) -> unit 31 | val get : unit -> Test.t list 32 | end 33 | 34 | val make : __FILE__:string -> unit -> (module S) 35 | 36 | val run_all : 37 | ?seed:string -> ?long:bool -> descr:string -> Test.t list list -> unit 38 | -------------------------------------------------------------------------------- /src/testlib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name containers_testlib) 3 | (synopsis "Test library for containers") 4 | (preprocess 5 | (action 6 | (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))) 7 | (libraries containers qcheck-core unix)) 8 | -------------------------------------------------------------------------------- /src/top/containers_top.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of containers. See file "license" for more details. *) 2 | 3 | type 'a printer = Format.formatter -> 'a -> unit 4 | 5 | let eval_exn str = 6 | let lexbuf = Lexing.from_string str in 7 | let phrase = !Toploop.parse_toplevel_phrase lexbuf in 8 | Toploop.execute_phrase false Format.err_formatter phrase 9 | 10 | let install_printer s = 11 | try ignore (eval_exn ("#install_printer " ^ s ^ " ;; ")) 12 | with _ -> 13 | Printexc.print_backtrace stderr; 14 | () 15 | 16 | let install_printers = List.iter install_printer 17 | let () = install_printers [ "CCHashtbl.pp"; "CCSexp.pp" ] 18 | -------------------------------------------------------------------------------- /src/top/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name containers_top) 3 | (public_name containers.top) 4 | (wrapped false) 5 | (modes byte) 6 | (libraries compiler-libs.common containers containers.unix)) 7 | -------------------------------------------------------------------------------- /src/unix/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name containers_unix) 3 | (public_name containers.unix) 4 | (wrapped false) 5 | (optional) 6 | (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string) 7 | (libraries unix)) 8 | -------------------------------------------------------------------------------- /tests/cbor/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name t_appendix_a) 3 | (modules t_appendix_a) 4 | (preprocess 5 | (action 6 | (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))) 7 | (libraries yojson containers containers.cbor)) 8 | 9 | (rule 10 | (alias runtest) 11 | (deps t_appendix_a.exe appendix_a.json) 12 | (package containers) 13 | (action 14 | (run ./t_appendix_a.exe ./appendix_a.json))) 15 | -------------------------------------------------------------------------------- /tests/core/compat/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (names t_compat) 3 | (flags :standard -nolabels) 4 | (libraries containers)) 5 | -------------------------------------------------------------------------------- /tests/core/compat/t_compat.ml: -------------------------------------------------------------------------------- 1 | (* test consistency of interfaces *) 2 | module type L = module type of CCEqual 3 | module type LL = module type of CCEqualLabels;; 4 | 5 | ignore (module CCEqualLabels : L);; 6 | ignore (module CCEqual : LL) 7 | -------------------------------------------------------------------------------- /tests/core/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name t) 3 | (flags :standard -strict-sequence -warn-error -a+8 -w -48-60) 4 | (modes 5 | (best exe)) 6 | (package containers) 7 | (preprocess 8 | (action 9 | (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))) 10 | (libraries 11 | containers 12 | containers.bencode 13 | containers.cbor 14 | containers.unix 15 | containers.pp 16 | threads 17 | containers_testlib 18 | iter 19 | gen 20 | uutf 21 | csexp)) 22 | -------------------------------------------------------------------------------- /tests/core/reg/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (ocamlopt_flags :standard -inline 1000) 3 | (names t_reg454) 4 | (libraries containers)) 5 | -------------------------------------------------------------------------------- /tests/core/reg/t_reg454.expected: -------------------------------------------------------------------------------- 1 | 123456 2 | 123456 3 | -------------------------------------------------------------------------------- /tests/core/reg/t_reg454.ml: -------------------------------------------------------------------------------- 1 | module Vec = CCVector 2 | 3 | let () = 4 | let arr : Int32.t Vec.vector = Vec.create () in 5 | Vec.push arr (Int32.of_int 123456); 6 | Format.printf "%d\n" (Int32.to_int (Vec.get arr 0)); 7 | let x = Vec.get arr 0 in 8 | Format.printf "%d\n" (Int32.to_int x) 9 | -------------------------------------------------------------------------------- /tests/core/t.ml: -------------------------------------------------------------------------------- 1 | Containers_testlib.run_all ~descr:"containers" 2 | [ 3 | T_pp.get (); 4 | T_list.get (); 5 | T_array.get (); 6 | T_bool.get (); 7 | T_byte_buffer.get (); 8 | T_canonical_sexp.get (); 9 | T_char.get (); 10 | T_either.get (); 11 | T_eq.get (); 12 | T_float.get (); 13 | T_format.get (); 14 | T_fun.get (); 15 | T_hash.get (); 16 | T_hashtbl.get (); 17 | T_heap.get (); 18 | T_IO.get (); 19 | T_int.get (); 20 | T_int32.get (); 21 | T_int64.get (); 22 | T_map.get (); 23 | T_nativeint.get (); 24 | T_option.get (); 25 | T_ord.get (); 26 | T_parse.get (); 27 | T_random.get (); 28 | T_result.get (); 29 | T_set.get (); 30 | T_seq.get (); 31 | T_sexp.get (); 32 | T_string.get (); 33 | T_utf8string.get (); 34 | T_vector.get (); 35 | T_bencode.get (); 36 | T_cbor.get (); 37 | T_unix.get (); 38 | ] 39 | -------------------------------------------------------------------------------- /tests/core/t_IO.ml: -------------------------------------------------------------------------------- 1 | open CCIO 2 | module T = (val Containers_testlib.make ~__FILE__ ()) 3 | include T;; 4 | 5 | t @@ fun () -> 6 | let s = String.make 200 'y' in 7 | let s = Printf.sprintf "a\nb\n %s\nlast line\n" s in 8 | File.with_temp ~prefix:"test_containers" ~suffix:"" (fun name -> 9 | with_out name @@ fun oc -> 10 | output_string oc s; 11 | flush oc; 12 | let s' = with_in name read_all in 13 | assert_equal ~printer:(fun s -> s) s s'); 14 | true 15 | ;; 16 | 17 | q 18 | Q.(list_of_size Gen.(0 -- 40) printable_string) 19 | (fun l -> 20 | let l' = ref [] in 21 | File.with_temp ~prefix:"test_containers" ~suffix:"" (fun name -> 22 | with_out name @@ fun oc -> 23 | write_lines_l oc l; 24 | flush oc; 25 | l' := with_in name read_lines_l); 26 | String.concat "\n" l = String.concat "\n" !l') 27 | ;; 28 | 29 | q 30 | Q.(list_of_size Gen.(0 -- 40) printable_string) 31 | (fun l -> 32 | let l' = ref [] in 33 | File.with_temp ~prefix:"test_containers" ~suffix:"" (fun name -> 34 | with_out name @@ fun oc -> 35 | write_lines oc (Gen.of_list l); 36 | flush oc; 37 | l' := with_in name (fun ic -> read_lines_gen ic |> Gen.to_list)); 38 | String.concat "\n" l = String.concat "\n" !l') 39 | ;; 40 | 41 | q 42 | Q.(list_of_size Gen.(0 -- 40) printable_string) 43 | (fun l -> 44 | let s = ref "" in 45 | File.with_temp ~prefix:"test_containers1" ~suffix:"" (fun name1 -> 46 | with_out name1 @@ fun oc1 -> 47 | write_gen ~sep:"" oc1 (Gen.of_list l); 48 | flush oc1; 49 | File.with_temp ~prefix:"test_containers2" ~suffix:"" (fun name2 -> 50 | with_out name2 @@ fun oc2 -> 51 | CCIO.with_in name1 (fun ic1 -> copy_into ic1 oc2); 52 | flush oc2; 53 | s := with_in name2 read_all)); 54 | String.concat "" l = !s) 55 | ;; 56 | 57 | t @@ fun () -> 58 | File.walk "." 59 | |> Gen.for_all (function 60 | | `File, f -> not (Sys.is_directory f) 61 | | `Dir, f -> Sys.is_directory f) 62 | -------------------------------------------------------------------------------- /tests/core/t_bencode.ml: -------------------------------------------------------------------------------- 1 | module T = (val Containers_testlib.make ~__FILE__ ()) 2 | include T 3 | open Containers_bencode;; 4 | 5 | eq ~printer:to_string_debug (map_of_list []) (Decode.of_string_exn "de");; 6 | 7 | eq ~printer:to_string_debug 8 | (list [ int 1; int 2; string "foo" ]) 9 | (Decode.of_string_exn "li1ei2e3:fooe") 10 | 11 | module B = Containers_bencode 12 | 13 | let rec size = function 14 | | Int _ | String _ -> 1 15 | | List l -> List.fold_left (fun n x -> n + size x) 0 l 16 | | Map m -> Str_map.fold (fun _ v n -> size v + n) m 0 17 | 18 | let g_rand_b = 19 | Q.Gen.( 20 | sized_size (0 -- 7) 21 | @@ fix 22 | @@ fun self n -> 23 | let str n = string_size ~gen:char (0 -- n) in 24 | let base = [ int >|= B.int; str 100 >|= B.string ] in 25 | match n with 26 | | 0 -> oneof base 27 | | n -> 28 | frequency 29 | @@ List.map (fun x -> 2, x) base 30 | @ [ 31 | 1, list_size (0 -- 10) (self (n - 1)) >|= B.list; 32 | ( 1, 33 | list_size (0 -- 10) (pair (str 10) (self (n - 1))) >|= B.map_of_list 34 | ); 35 | ]) 36 | 37 | let rec shrink_b self = 38 | Q.( 39 | Iter.( 40 | match self with 41 | | Int i -> Shrink.int64 i >|= B.int64 42 | | String s -> Shrink.string s >|= B.string 43 | | List l -> Shrink.list ~shrink:shrink_b l >|= B.list 44 | | Map l -> 45 | let l = Str_map.fold (fun k v l -> (k, v) :: l) l [] in 46 | Shrink.list 47 | ~shrink:(fun (k, v) -> 48 | Shrink.string k 49 | >|= (fun k -> k, v) 50 | <+> (shrink_b v >|= fun v -> k, v)) 51 | l 52 | >|= B.map_of_list)) 53 | 54 | let rand_b = 55 | Q.make ~print:to_string_debug 56 | ~stats:[ "size", size ] 57 | ~shrink:shrink_b g_rand_b 58 | ;; 59 | 60 | q rand_b (fun b -> 61 | let s = Encode.to_string b in 62 | equal (Decode.of_string_exn s) b) 63 | -------------------------------------------------------------------------------- /tests/core/t_bool.ml: -------------------------------------------------------------------------------- 1 | open CCBool 2 | module T = (val Containers_testlib.make ~__FILE__ ()) 3 | include T;; 4 | 5 | eq 1 (to_int true);; 6 | eq 0 (to_int false);; 7 | eq true (of_int 1);; 8 | eq false (of_int 0);; 9 | eq true (of_int 42);; 10 | eq true (of_int max_int);; 11 | eq true (of_int min_int);; 12 | eq (Some "true") (if_then (Fun.const "true") true);; 13 | eq None (if_then (Fun.const "true") false);; 14 | eq "true" (if_then_else (Fun.const "true") (Fun.const "false") true);; 15 | eq "false" (if_then_else (Fun.const "true") (Fun.const "false") false) 16 | -------------------------------------------------------------------------------- /tests/core/t_canonical_sexp.ml: -------------------------------------------------------------------------------- 1 | open CCCanonical_sexp 2 | module T = (val Containers_testlib.make ~__FILE__ ()) 3 | include T 4 | 5 | let csexp_bijective s = to_string s |> parse_string = Ok s;; 6 | 7 | eq 8 | ~printer:CCFormat.(to_string (Dump.result pp)) 9 | (Ok (`List [ `Atom "" ])) 10 | (parse_string {|(0:)|}) 11 | ;; 12 | 13 | eq 14 | ~printer:CCFormat.(to_string (Dump.result pp)) 15 | (Ok (`List [ `Atom "a"; `Atom "b " ])) 16 | (parse_string {|(1:a2:b )|}) 17 | ;; 18 | 19 | t @@ fun () -> csexp_bijective (`List [ `Atom "" ]) 20 | 21 | let sexp_gen = 22 | let mkatom a = `Atom a and mklist l = `List l in 23 | let atom = Q.Gen.(map mkatom (string_size ~gen:char (1 -- 30))) in 24 | let gen = 25 | Q.Gen.( 26 | sized 27 | (fix (fun self n st -> 28 | match n with 29 | | 0 -> atom st 30 | | _ -> 31 | frequency 32 | [ 33 | 1, atom; 2, map mklist (list_size (0 -- 10) (self (n / 10))); 34 | ] 35 | st))) 36 | in 37 | let rec small = function 38 | | `Atom s -> String.length s 39 | | `List l -> List.fold_left (fun n x -> n + small x) 0 l 40 | and print = function 41 | | `Atom s -> Printf.sprintf "`Atom \"%s\"" s 42 | | `List l -> "`List " ^ Q.Print.list print l 43 | and shrink = function 44 | | `Atom s -> Q.Iter.map mkatom (Q.Shrink.string s) 45 | | `List l -> Q.Iter.map mklist (Q.Shrink.list ~shrink l) 46 | in 47 | Q.make ~print ~small ~shrink gen 48 | ;; 49 | 50 | q ~count:100 sexp_gen csexp_bijective;; 51 | 52 | t @@ fun () -> 53 | let s1 = 54 | `List 55 | (CCList.init 100_000 (fun i -> 56 | `List [ `Atom "-"; `Atom (string_of_int i); `Atom ")(\n]" ])) 57 | in 58 | let str = to_string s1 in 59 | (match parse_string str with 60 | | Ok s2 -> assert_equal s1 s2 61 | | Error e -> assert_failure e); 62 | true 63 | -------------------------------------------------------------------------------- /tests/core/t_cbor.ml: -------------------------------------------------------------------------------- 1 | include (val Containers_testlib.make ~__FILE__ ()) 2 | module Cbor = Containers_cbor 3 | 4 | let gen_c : Cbor.t Q.Gen.t = 5 | let open Q.Gen in 6 | sized @@ fix 7 | @@ fun self size -> 8 | let recurse = self (size - 1) in 9 | let base = 10 | [ 11 | 1, return `Null; 12 | 1, return `Undefined; 13 | ( 3, 14 | let+ x = int >|= Int64.of_int in 15 | `Int x ); 16 | ( 1, 17 | let+ b = bool in 18 | `Bool b ); 19 | ( 1, 20 | let+ x = 0 -- 19 in 21 | `Simple x ); 22 | ( 1, 23 | let+ x = 26 -- 127 in 24 | `Simple x ); 25 | ( 1, 26 | let+ f = float in 27 | `Float f ); 28 | ( 2, 29 | let* n = frequency [ 20, 0 -- 150; 1, 151 -- 100_000 ] in 30 | let+ s = string_size ~gen:printable (return n) in 31 | `Text s ); 32 | ( 2, 33 | let* n = frequency [ 20, 0 -- 150; 1, 151 -- 100_000 ] in 34 | let+ s = string_size ~gen:char (return n) in 35 | `Bytes s ); 36 | ] 37 | in 38 | let g_base = frequency base in 39 | let rec_ = 40 | [ 41 | ( 2, 42 | let+ l = 43 | if size > 10 then 44 | list_size (0 -- 1024) g_base 45 | else 46 | list_size (0 -- 10) recurse 47 | in 48 | `Array l ); 49 | ( 2, 50 | let+ l = 51 | if size > 10 then 52 | list_size (0 -- 1024) (pair g_base g_base) 53 | else 54 | list_size (0 -- 5) (pair g_base recurse) 55 | in 56 | `Map l ); 57 | ( 1, 58 | let+ i = 0 -- 1024 and+ sub = self (size - 1) in 59 | `Tag (i, sub) ); 60 | ] 61 | in 62 | frequency 63 | (if size > 0 then 64 | base @ rec_ 65 | else 66 | base) 67 | 68 | let rec shrink (c : Cbor.t) : Cbor.t Q.Iter.t = 69 | let open Q.Iter in 70 | match c with 71 | | `Null | `Undefined | `Bool false -> empty 72 | | `Bool true -> return (`Bool false) 73 | | `Simple i -> 74 | let+ i = Q.Shrink.int i in 75 | `Simple i 76 | | `Int i -> 77 | let+ i = Q.Shrink.int (Int64.to_int i) in 78 | `Int (Int64.of_int i) 79 | | `Tag (t, i) -> 80 | let+ i = shrink i in 81 | `Tag (t, i) 82 | | `Float _ -> empty 83 | | `Array l -> 84 | let+ l = Q.Shrink.list ~shrink l in 85 | `Array l 86 | | `Map l -> 87 | let shrink_pair (a, b) = 88 | (let+ a = shrink a in 89 | a, b) 90 | <+> let+ b = shrink b in 91 | a, b 92 | in 93 | let+ l = Q.Shrink.list ~shrink:shrink_pair l in 94 | `Map l 95 | | `Text s -> 96 | let+ s = Q.Shrink.string s in 97 | `Text s 98 | | `Bytes s -> 99 | let+ s = Q.Shrink.string s in 100 | `Bytes s 101 | 102 | let arb = Q.make ~shrink ~print:Cbor.to_string_diagnostic gen_c;; 103 | 104 | q ~count:1_000 ~long_factor:10 arb @@ fun c -> 105 | let s = Cbor.encode c in 106 | let c' = Cbor.decode_exn s in 107 | if not (c = c') then 108 | Q.Test.fail_reportf "@[roundtrip failed:@ from %a@ to %a@]" 109 | Cbor.pp_diagnostic c Cbor.pp_diagnostic c'; 110 | true 111 | -------------------------------------------------------------------------------- /tests/core/t_char.ml: -------------------------------------------------------------------------------- 1 | open CCChar 2 | module T = (val Containers_testlib.make ~__FILE__ ()) 3 | include T;; 4 | 5 | eq (Some 'a') (of_int (to_int 'a'));; 6 | eq None (of_int 257);; 7 | 8 | q 9 | (Q.string_of_size (Q.Gen.return 1)) 10 | (fun s -> Stdlib.( = ) (to_string s.[0]) s) 11 | ;; 12 | 13 | q (Q.int_range 65 90 |> Q.map Char.chr) CCChar.is_uppercase_ascii;; 14 | 15 | q 16 | (Q.int_range 0 64 |> Q.map Char.chr) 17 | (fun c -> not @@ CCChar.is_uppercase_ascii c) 18 | ;; 19 | 20 | q 21 | (Q.int_range 91 127 |> Q.map Char.chr) 22 | (fun c -> not @@ CCChar.is_uppercase_ascii c) 23 | ;; 24 | 25 | q (Q.int_range 97 122 |> Q.map Char.chr) CCChar.is_lowercase_ascii;; 26 | 27 | q 28 | (Q.int_range 0 96 |> Q.map Char.chr) 29 | (fun c -> not @@ CCChar.is_lowercase_ascii c) 30 | ;; 31 | 32 | q 33 | (Q.int_range 123 127 |> Q.map Char.chr) 34 | (fun c -> not @@ CCChar.is_lowercase_ascii c) 35 | ;; 36 | 37 | q (Q.int_range 48 57 |> Q.map Char.chr) CCChar.is_digit_ascii;; 38 | q (Q.int_range 0 47 |> Q.map Char.chr) (fun c -> not @@ CCChar.is_digit_ascii c) 39 | ;; 40 | 41 | q 42 | (Q.int_range 58 127 |> Q.map Char.chr) 43 | (fun c -> not @@ CCChar.is_digit_ascii c) 44 | ;; 45 | 46 | eq true 47 | (Stdlib.List.for_all CCChar.is_whitespace_ascii 48 | [ '\n'; '\t'; ' '; '\010'; '\011'; '\012'; '\013' ]) 49 | ;; 50 | 51 | eq false 52 | (Stdlib.List.exists CCChar.is_whitespace_ascii 53 | [ 54 | 'H'; 55 | 'e'; 56 | 'l'; 57 | 'l'; 58 | 'o'; 59 | '!'; 60 | '-'; 61 | '-'; 62 | 'N'; 63 | 'O'; 64 | 't'; 65 | 'h'; 66 | 'i'; 67 | 'n'; 68 | 'a'; 69 | '\055'; 70 | 'k'; 71 | 'a'; 72 | 'g'; 73 | '$'; 74 | '$'; 75 | '$'; 76 | '%'; 77 | '^'; 78 | 'b'; 79 | 'c'; 80 | 'h'; 81 | '\008'; 82 | 'h'; 83 | ]) 84 | -------------------------------------------------------------------------------- /tests/core/t_either.ml: -------------------------------------------------------------------------------- 1 | open CCEither 2 | module T = (val Containers_testlib.make ~__FILE__ ()) 3 | include T;; 4 | 5 | eq (is_left (Left 1)) true;; 6 | eq (is_left (Right 1)) false;; 7 | eq (is_left (Left 1)) true;; 8 | eq (is_left (Right 1)) false;; 9 | eq (is_right (Left 1)) false;; 10 | eq (is_right (Right 1)) true;; 11 | eq (find_left (Left 1)) (Some 1);; 12 | eq (find_left (Right 1)) None;; 13 | eq (find_right (Left 1)) None;; 14 | eq (find_right (Right 1)) (Some 1) 15 | -------------------------------------------------------------------------------- /tests/core/t_eq.ml: -------------------------------------------------------------------------------- 1 | open CCEqual 2 | module T = (val Containers_testlib.make ~__FILE__ ()) 3 | include T;; 4 | 5 | q 6 | Q.( 7 | let p = small_list (pair small_int bool) in 8 | pair p p) 9 | (fun (l1, l2) -> (list (pair int bool)) l1 l2 = (l1 = l2)) 10 | -------------------------------------------------------------------------------- /tests/core/t_float.ml: -------------------------------------------------------------------------------- 1 | open CCFloat 2 | module T = (val Containers_testlib.make ~__FILE__ ()) 3 | include T;; 4 | 5 | t @@ fun () -> max nan 1. = 1.;; 6 | t @@ fun () -> min nan 1. = 1.;; 7 | t @@ fun () -> max 1. nan = 1.;; 8 | t @@ fun () -> min 1. nan = 1.;; 9 | 10 | q 11 | Q.(pair float float) 12 | (fun (x, y) -> is_nan x || is_nan y || (min x y <= x && min x y <= y)) 13 | ;; 14 | 15 | q 16 | Q.(pair float float) 17 | (fun (x, y) -> is_nan x || is_nan y || (max x y >= x && max x y >= y)) 18 | ;; 19 | 20 | eq 2. (round 1.6);; 21 | eq 1. (round 1.4);; 22 | eq 0. (round 0.) 23 | -------------------------------------------------------------------------------- /tests/core/t_fun.ml: -------------------------------------------------------------------------------- 1 | [@@@ocaml.warning "-33"] 2 | 3 | open CCFun 4 | module T = (val Containers_testlib.make ~__FILE__ ()) 5 | include T;; 6 | 7 | eq ~printer:Q.Print.int 10 (iterate 0 succ 10);; 8 | eq ~printer:Q.Print.int 11 (iterate 1 succ 10);; 9 | eq ~printer:Q.Print.int 12 (iterate 2 succ 10);; 10 | eq ~printer:Q.Print.int 15 (iterate 5 succ 10);; 11 | 12 | t @@ fun () -> 13 | assert_raises 14 | (function 15 | | Invalid_argument _ -> true 16 | | _ -> false) 17 | (fun () -> iterate (-1) succ 10); 18 | true 19 | ;; 20 | 21 | t @@ fun () -> CCFun.((succ %> string_of_int) 2 = "3");; 22 | t @@ fun () -> CCFun.((( * ) 3 % succ) 5 = 18);; 23 | t @@ fun () -> CCFun.(succ @@ ( * ) 2 @@ pred @@ 3 = 5) 24 | 25 | let find_array arr x = 26 | let@ return = with_return in 27 | for i = 0 to Array.length arr - 1 do 28 | if arr.(i) = x then return i 29 | done; 30 | -1 31 | ;; 32 | 33 | eq 1 @@ find_array [| "a"; "b"; "c" |] "b";; 34 | eq 2 @@ find_array [| "a"; "b"; "c" |] "c";; 35 | eq (-1) @@ find_array [| "a"; "b"; "c" |] "hello" 36 | -------------------------------------------------------------------------------- /tests/core/t_hash.ml: -------------------------------------------------------------------------------- 1 | open CCHash 2 | module T = (val Containers_testlib.make ~__FILE__ ()) 3 | include T;; 4 | 5 | t @@ fun () -> int 42 >= 0;; 6 | t @@ fun () -> int max_int >= 0;; 7 | t @@ fun () -> int max_int = int max_int;; 8 | t @@ fun () -> int min_int >= 0;; 9 | t @@ fun () -> int 0 >= 0;; 10 | t @@ fun () -> char 'c' >= 0;; 11 | t @@ fun () -> int 152352 = int 152352;; 12 | t @@ fun () -> list_comm int [ 1; 2 ] = list_comm int [ 2; 1 ];; 13 | t @@ fun () -> list_comm int [ 1; 2 ] <> list_comm int [ 2; 3 ];; 14 | t @@ fun () -> string "abcd" >= 0;; 15 | t @@ fun () -> string "abc" <> string "abcd";; 16 | 17 | q Q.int (fun i -> 18 | Q.assume (i >= 0); 19 | int i = int64 (Int64.of_int i)) 20 | -------------------------------------------------------------------------------- /tests/core/t_hashtbl.ml: -------------------------------------------------------------------------------- 1 | module T = (val Containers_testlib.make ~__FILE__ ()) 2 | include T 3 | open CCHashtbl;; 4 | 5 | eq "c" 6 | (let tbl = of_list [ 1, "a"; 2, "b" ] in 7 | get_or tbl 3 ~default:"c") 8 | ;; 9 | 10 | eq "b" 11 | (let tbl = of_list [ 1, "a"; 2, "b" ] in 12 | get_or tbl 2 ~default:"c") 13 | ;; 14 | 15 | t @@ fun () -> 16 | of_list [ 1, "a"; 2, "b" ] 17 | |> map_list (fun x y -> string_of_int x ^ y) 18 | |> List.sort Stdlib.compare = [ "1a"; "2b" ] 19 | ;; 20 | 21 | t @@ fun () -> 22 | let tbl = Hashtbl.create 32 in 23 | update tbl ~f:(fun _ _ -> Some "1") ~k:1; 24 | assert_equal (Some "1") (get tbl 1); 25 | update tbl 26 | ~f:(fun _ v -> 27 | match v with 28 | | Some _ -> assert false 29 | | None -> Some "2") 30 | ~k:2; 31 | assert_equal (Some "2") (get tbl 2); 32 | assert_equal 2 (Hashtbl.length tbl); 33 | update tbl ~f:(fun _ _ -> None) ~k:1; 34 | assert_equal None (get tbl 1); 35 | true 36 | ;; 37 | 38 | t @@ fun () -> 39 | let tbl = Hashtbl.create 32 in 40 | let v1 = get_or_add tbl ~f:(fun _ -> "1") ~k:1 in 41 | assert_equal "1" v1; 42 | assert_equal (Some "1") (get tbl 1); 43 | let v2 = get_or_add tbl ~f:(fun _ -> "2") ~k:2 in 44 | assert_equal "2" v2; 45 | assert_equal (Some "2") (get tbl 2); 46 | assert_equal "2" (get_or_add tbl ~f:(fun _ -> assert false) ~k:2); 47 | assert_equal 2 (Hashtbl.length tbl); 48 | true 49 | 50 | module TI = Make (CCInt);; 51 | 52 | eq "c" 53 | (let tbl = TI.of_list [ 1, "a"; 2, "b" ] in 54 | TI.get_or tbl 3 ~default:"c") 55 | ;; 56 | 57 | eq "b" 58 | (let tbl = TI.of_list [ 1, "a"; 2, "b" ] in 59 | TI.get_or tbl 2 ~default:"c") 60 | ;; 61 | 62 | t @@ fun () -> 63 | let tbl = TI.create 32 in 64 | TI.incr tbl 1; 65 | TI.incr tbl 2; 66 | TI.incr tbl 1; 67 | assert_equal 2 (TI.find tbl 1); 68 | assert_equal 1 (TI.find tbl 2); 69 | assert_equal 2 (TI.length tbl); 70 | TI.decr tbl 2; 71 | assert_equal 0 (TI.get_or tbl 2 ~default:0); 72 | assert_equal 1 (TI.length tbl); 73 | assert (not (TI.mem tbl 2)); 74 | true 75 | -------------------------------------------------------------------------------- /tests/core/t_map.ml: -------------------------------------------------------------------------------- 1 | module T = (val Containers_testlib.make ~__FILE__ ()) 2 | include T 3 | open CCMap 4 | module M = CCMap.Make (String) 5 | 6 | let eq' = eq ~printer:CCFormat.(to_string @@ Dump.(list (pair string int)));; 7 | 8 | eq' 9 | [ "a", 1; "b", 20 ] 10 | (M.of_list [ "b", 2; "c", 3 ] 11 | |> M.update "a" (function _ -> Some 1) 12 | |> M.update "c" (fun _ -> None) 13 | |> M.update "b" (CCOption.map (fun x -> x * 10)) 14 | |> M.to_list |> List.sort CCOrd.poly) 15 | 16 | module M2 = Make (CCInt);; 17 | 18 | q 19 | Q.(list (pair small_int small_int)) 20 | M2.( 21 | fun l -> to_list (of_list l) = to_list (of_list_with ~f:(fun _ v _ -> v) l)) 22 | ;; 23 | 24 | q 25 | Q.(list (pair small_int small_int)) 26 | M2.( 27 | fun l -> 28 | to_list (of_iter @@ Iter.of_list l) 29 | = to_list (of_iter_with ~f:(fun _ v _ -> v) @@ Iter.of_list l)) 30 | ;; 31 | 32 | q 33 | Q.(list (pair small_int small_int)) 34 | M2.( 35 | fun l -> 36 | to_list (of_seq @@ CCSeq.of_list l) 37 | = to_list (of_seq_with ~f:(fun _ v _ -> v) @@ CCSeq.of_list l)) 38 | -------------------------------------------------------------------------------- /tests/core/t_nativeint.ml: -------------------------------------------------------------------------------- 1 | open CCNativeint 2 | module T = (val Containers_testlib.make ~__FILE__ ()) 3 | include T;; 4 | 5 | t @@ fun () -> pow 2n 10n = 1024n;; 6 | t @@ fun () -> pow 2n 15n = 32768n;; 7 | t @@ fun () -> pow 10n 5n = 100000n;; 8 | t @@ fun () -> pow 42n 0n = 1n;; 9 | t @@ fun () -> pow 0n 1n = 0n;; 10 | t @@ fun () -> floor_div 3n 5n = 0n;; 11 | t @@ fun () -> floor_div 5n 5n = 1n;; 12 | t @@ fun () -> floor_div 20n 5n = 4n;; 13 | t @@ fun () -> floor_div 12n 5n = 2n;; 14 | t @@ fun () -> floor_div 0n 5n = 0n;; 15 | t @@ fun () -> floor_div (-1n) 5n = -1n;; 16 | t @@ fun () -> floor_div (-5n) 5n = -1n;; 17 | t @@ fun () -> floor_div (-12n) 5n = -3n;; 18 | t @@ fun () -> floor_div 0n (-5n) = 0n;; 19 | t @@ fun () -> floor_div 3n (-5n) = -1n;; 20 | t @@ fun () -> floor_div 5n (-5n) = -1n;; 21 | t @@ fun () -> floor_div 9n (-5n) = -2n;; 22 | t @@ fun () -> floor_div 20n (-5n) = -4n;; 23 | t @@ fun () -> floor_div (-2n) (-5n) = 0n;; 24 | t @@ fun () -> floor_div (-8n) (-5n) = 1n;; 25 | t @@ fun () -> floor_div (-35n) (-5n) = 7n;; 26 | 27 | t @@ fun () -> 28 | try 29 | ignore (floor_div 12n 0n); 30 | false 31 | with Division_by_zero -> true 32 | ;; 33 | 34 | t @@ fun () -> 35 | try 36 | ignore (floor_div (-12n) 0n); 37 | false 38 | with Division_by_zero -> true 39 | ;; 40 | 41 | q 42 | (Q.pair (Q.map of_int Q.small_signed_int) (Q.map of_int Q.small_nat)) 43 | (fun (n, m) -> 44 | let m = m + 1n in 45 | floor_div n m = of_float @@ floor (to_float n /. to_float m)) 46 | ;; 47 | 48 | q 49 | (Q.pair (Q.map of_int Q.small_signed_int) (Q.map of_int Q.small_nat)) 50 | (fun (n, m) -> 51 | let m = m + 1n in 52 | floor_div n (-m) = of_float @@ floor (to_float n /. to_float (-m))) 53 | 54 | let eq' = eq ~printer:Q.Print.(list to_string);; 55 | 56 | eq' [ 0n; 1n; 2n; 3n; 4n; 5n ] (range 0n 5n |> Iter.to_list);; 57 | eq' [ 0n ] (range 0n 0n |> Iter.to_list);; 58 | eq' [ 5n; 4n; 3n; 2n ] (range 5n 2n |> Iter.to_list) 59 | 60 | (* note: the last test checks that no error occurs due to overflows. *) 61 | let eq' = eq ~printer:Q.Print.(list to_string);; 62 | 63 | eq' [ 0n ] (range_by ~step:1n 0n 0n |> Iter.to_list);; 64 | eq' [] (range_by ~step:1n 5n 0n |> Iter.to_list);; 65 | eq' [] (range_by ~step:2n 1n 0n |> Iter.to_list);; 66 | eq' [ 0n; 2n; 4n ] (range_by ~step:2n 0n 4n |> Iter.to_list);; 67 | eq' [ 0n; 2n; 4n ] (range_by ~step:2n 0n 5n |> Iter.to_list);; 68 | eq' [ 0n ] (range_by ~step:(neg 1n) 0n 0n |> Iter.to_list);; 69 | eq' [] (range_by ~step:(neg 1n) 0n 5n |> Iter.to_list);; 70 | eq' [] (range_by ~step:(neg 2n) 0n 1n |> Iter.to_list);; 71 | eq' [ 5n; 3n; 1n ] (range_by ~step:(neg 2n) 5n 1n |> Iter.to_list);; 72 | eq' [ 5n; 3n; 1n ] (range_by ~step:(neg 2n) 5n 0n |> Iter.to_list);; 73 | eq' [ 0n ] (range_by ~step:max_int 0n 2n |> Iter.to_list);; 74 | 75 | q 76 | Q.(pair (map of_int small_int) (map of_int small_int)) 77 | (fun (i, j) -> 78 | let i = min i j and j = max i j in 79 | CCList.equal CCNativeint.equal 80 | (CCNativeint.range_by ~step:1n i j |> Iter.to_list) 81 | (CCNativeint.range i j |> Iter.to_list)) 82 | ;; 83 | 84 | eq ~printer:CCFun.id "0b111" (to_string_binary 7n);; 85 | eq ~printer:CCFun.id "-0b111" (to_string_binary (-7n));; 86 | eq ~printer:CCFun.id "0b0" (to_string_binary 0n) 87 | -------------------------------------------------------------------------------- /tests/core/t_option.ml: -------------------------------------------------------------------------------- 1 | open CCOption 2 | module T = (val Containers_testlib.make ~__FILE__ ()) 3 | include T;; 4 | 5 | eq None (filter (( = ) 0) (Some 1));; 6 | eq (Some 0) (filter (( = ) 0) (Some 0));; 7 | eq None (filter (fun _ -> true) None);; 8 | 9 | eq 10 | (try 11 | get_exn_or "ohno" (None : unit option); 12 | false 13 | with Invalid_argument s -> s = "ohno") 14 | ;; 15 | 16 | t @@ fun () -> 123 = get_exn_or "yes" (Some 123);; 17 | t @@ fun () -> sequence_l [ None; Some 1; Some 2 ] = None;; 18 | t @@ fun () -> sequence_l [ Some 1; Some 2; Some 3 ] = Some [ 1; 2; 3 ];; 19 | t @@ fun () -> sequence_l [] = Some [];; 20 | t @@ fun () -> choice_iter (Iter.of_list [ None; Some 1; Some 2 ]) = Some 1;; 21 | t @@ fun () -> choice_iter Iter.empty = None;; 22 | t @@ fun () -> choice_iter (Iter.repeat None |> Iter.take 100) = None;; 23 | t @@ fun () -> choice_seq (CCSeq.of_list [ None; Some 1; Some 2 ]) = Some 1;; 24 | t @@ fun () -> choice_seq CCSeq.empty = None;; 25 | t @@ fun () -> choice_seq (CCSeq.repeat None |> CCSeq.take 100) = None;; 26 | t @@ fun () -> flatten None = None;; 27 | t @@ fun () -> flatten (Some None) = None;; 28 | t @@ fun () -> flatten (Some (Some 1)) = Some 1;; 29 | t @@ fun () -> return_if false 1 = None;; 30 | t @@ fun () -> return_if true 1 = Some 1 31 | -------------------------------------------------------------------------------- /tests/core/t_ord.ml: -------------------------------------------------------------------------------- 1 | open CCOrd 2 | module T = (val Containers_testlib.make ~__FILE__ ()) 3 | include T;; 4 | 5 | t @@ fun () -> equiv 1 2;; 6 | t @@ fun () -> equiv ~-1 ~-10;; 7 | t @@ fun () -> equiv 0 0;; 8 | t @@ fun () -> equiv ~-1 ~-1;; 9 | t @@ fun () -> not (equiv 0 1);; 10 | t @@ fun () -> not (equiv 1 ~-1);; 11 | t @@ fun () -> not (equiv 1 0);; 12 | q Q.(pair int int) (fun (x, y) -> equiv x y = equiv y x);; 13 | 14 | q 15 | Q.(triple int int int) 16 | (fun (x, y, z) -> 17 | if equiv x y && equiv y z then 18 | equiv x z 19 | else 20 | true) 21 | ;; 22 | 23 | t @@ fun () -> bool true false > 0;; 24 | t @@ fun () -> bool false true < 0;; 25 | t @@ fun () -> bool true true = 0;; 26 | t @@ fun () -> bool false false = 0;; 27 | q Q.(option int) (fun o -> option int None o <= 0);; 28 | t @@ fun () -> pair int string (1, "b") (2, "a") < 0;; 29 | t @@ fun () -> pair int string (1, "b") (0, "a") > 0;; 30 | t @@ fun () -> pair int string (1, "b") (1, "b") = 0;; 31 | t @@ fun () -> list int [ 1; 2; 3 ] [ 1; 2; 3; 4 ] < 0;; 32 | t @@ fun () -> list int [ 1; 2; 3; 4 ] [ 1; 2; 3 ] > 0;; 33 | t @@ fun () -> list int [ 1; 2; 3; 4 ] [ 1; 3; 4 ] < 0;; 34 | 35 | q 36 | Q.(pair (list int) (list int)) 37 | CCOrd.(fun (l1, l2) -> equiv (list int l1 l2) (Stdlib.compare l1 l2)) 38 | ;; 39 | 40 | t @@ fun () -> array int [| 1; 2; 3 |] [| 1; 2; 3; 4 |] < 0;; 41 | t @@ fun () -> array int [| 1; 2; 3; 4 |] [| 1; 2; 3 |] > 0;; 42 | t @@ fun () -> array int [| 1; 2; 3; 4 |] [| 1; 3; 4 |] < 0;; 43 | 44 | q 45 | Q.(pair (array int) (array int)) 46 | CCOrd.( 47 | fun (a1, a2) -> 48 | equiv (array int a1 a2) (list int (Array.to_list a1) (Array.to_list a2))) 49 | -------------------------------------------------------------------------------- /tests/core/t_pp.ml: -------------------------------------------------------------------------------- 1 | include (val Containers_testlib.make ~__FILE__ ()) 2 | open Containers_pp 3 | 4 | let spf = Printf.sprintf 5 | 6 | let () = 7 | eq "hello world" (Flatten.to_string @@ text "hello" ^ newline ^ text "world") 8 | 9 | let () = 10 | eq ~name:"split text" ~printer:(spf "%S") "let rec f x =\n x+2\n" 11 | (let d = text "let rec f x =\n x+2\n" in 12 | Pretty.to_string ~width:15 d) 13 | 14 | let () = 15 | eq ~name:"l1" ~printer:(spf "%S") "[0; 1; 2; 3;\n 4; 5; 6; 7;\n 8; 9]" 16 | (let d = Dump.list (CCList.init 10 int) in 17 | Pretty.to_string ~width:10 d) 18 | 19 | let () = 20 | eq ~name:"l2" ~printer:(spf "%S") 21 | "[[0; 1; 2; 3;\n\ 22 | \ 4; 5];\n\ 23 | \ [1; 2; 3; 4;\n\ 24 | \ 5; 6];\n\ 25 | \ [2; 3; 4; 5;\n\ 26 | \ 6; 7];\n\ 27 | \ [3; 4; 5; 6;\n\ 28 | \ 7; 8];\n\ 29 | \ [4; 5; 6; 7;\n\ 30 | \ 8; 9];\n\ 31 | \ [5; 6; 7; 8;\n\ 32 | \ 9; 10]]" 33 | (let d = 34 | Dump.list 35 | (CCList.init 6 (fun i -> 36 | Dump.list (CCList.init 6 (fun j -> int @@ (i + j))))) 37 | in 38 | Pretty.to_string ~width:10 d) 39 | 40 | let () = 41 | eq ~name:"s1" ~printer:(spf "%S") "(foo\n bar\n baaz\n (g 42 10))" 42 | (let d = 43 | sexp_apply "foo" 44 | [ text "bar"; text "baaz"; sexp_apply "g" [ int 42; int 10 ] ] 45 | in 46 | Pretty.to_string ~width:10 d) 47 | 48 | let ext_coucou = 49 | Ext.make ~name:"coucou" 50 | ~pre:(fun out ~inside:_ () -> out.string "") 51 | ~post:(fun out ~inside:_ () -> out.string "") 52 | () 53 | 54 | let () = 55 | eq ~name:"wrap1" ~printer:(spf "%S") 56 | "(foo\n bar\n (g 42 10))" 57 | (let d = 58 | sexp_apply "foo" 59 | [ text "bar"; ext ext_coucou () (sexp_apply "g" [ int 42; int 10 ]) ] 60 | in 61 | Pretty.to_string ~width:10 d) 62 | 63 | let () = 64 | eq ~name:"nested color" ~printer:(spf "%S") 65 | "hello \027[32mworld \027[31moh my!\027[32m!?\027[43moh well\027[32m\027[0m" 66 | (let d = 67 | text "hello" 68 | ^+ Term_color.color `Green 69 | (text "world" 70 | ^+ Term_color.color `Red (text "oh my!") 71 | ^ text "!?" 72 | ^ Term_color.style_l [ `BG `Yellow ] (text "oh well")) 73 | in 74 | Pretty.to_string ~width:1000 d) 75 | -------------------------------------------------------------------------------- /tests/core/t_random.ml: -------------------------------------------------------------------------------- 1 | open CCRandom 2 | module T = (val Containers_testlib.make ~__FILE__ ()) 3 | include T;; 4 | 5 | q Q.(list small_int) (fun l -> l = [] || List.mem (run (pick_list l)) l);; 6 | 7 | q 8 | Q.(pair small_int small_int) 9 | (fun (i, j) -> 10 | let len, n = 2 + min i j, max i j in 11 | let l = QCheck.Gen.generate1 (split_list n ~len) in 12 | match l with 13 | | None -> true 14 | | Some l -> l <> [] && List.for_all (fun x -> x > 0) l) 15 | ;; 16 | 17 | t @@ fun () -> 18 | let open Containers in 19 | ignore (List.random_choose [ 1; 2; 3 ] (Random.get_state ()) : int); 20 | true 21 | -------------------------------------------------------------------------------- /tests/core/t_result.ml: -------------------------------------------------------------------------------- 1 | open CCResult 2 | module T = (val Containers_testlib.make ~__FILE__ ()) 3 | include T;; 4 | 5 | t @@ fun () -> Error "ohno 42" = fail_printf "ohno %d" 42;; 6 | t @@ fun () -> Error "ohno 42" = fail_fprintf "ohno %d" 42;; 7 | 8 | eq (Error "error\ncontext:message(number 42, foo: true)") 9 | (add_ctxf "message(number %d, foo: %B)" 42 true (Error "error")) 10 | ;; 11 | 12 | t @@ fun () -> 13 | let called_with = ref None in 14 | let f e = called_with := Some e in 15 | iter_err f (Ok 1); 16 | assert (!called_with = None); 17 | iter_err f (Error 1); 18 | assert (!called_with = Some 1); 19 | true 20 | ;; 21 | 22 | t @@ fun () -> get_or_failwith (Ok 1) = 1;; 23 | 24 | t @@ fun () -> 25 | try 26 | ignore @@ get_or_failwith (Error "e"); 27 | false 28 | with Failure msg -> msg = "e" 29 | ;; 30 | 31 | eq (get_lazy (fun _ -> 2) (Ok 1)) 1;; 32 | eq (get_lazy (fun _ -> 2) (Error "error")) 2;; 33 | eq 42 (fold_ok ( + ) 2 (Ok 40));; 34 | eq 40 (fold_ok ( + ) 40 (Error "foo"));; 35 | eq (Ok []) (flatten_l []);; 36 | eq (Ok [ 1; 2; 3 ]) (flatten_l [ Ok 1; Ok 2; Ok 3 ]);; 37 | eq (Error "ohno") (flatten_l [ Ok 1; Error "ohno"; Ok 2; Ok 3; Error "wut" ]) 38 | -------------------------------------------------------------------------------- /tests/core/t_set.ml: -------------------------------------------------------------------------------- 1 | module T = (val Containers_testlib.make ~__FILE__ ()) 2 | include T 3 | 4 | module S = CCSet.Make (struct 5 | type t = int 6 | 7 | let compare x y = Stdlib.compare x y 8 | end) 9 | ;; 10 | 11 | eq ~printer:(fun s -> s) (S.to_string string_of_int (S.of_list [ 4; 3 ])) "3,4" 12 | ;; 13 | 14 | q 15 | Q.(list int) 16 | (fun l -> 17 | let s = S.of_list l in 18 | S.to_string string_of_int s 19 | = (CCList.sort_uniq ~cmp:CCInt.compare l 20 | |> List.map string_of_int |> String.concat ",")) 21 | ;; 22 | 23 | q 24 | Q.(list int) 25 | (fun l -> 26 | let s = S.of_list l in 27 | S.to_string ~sep:" " string_of_int s 28 | = (CCList.sort_uniq ~cmp:CCInt.compare l 29 | |> List.map string_of_int |> String.concat " ")) 30 | -------------------------------------------------------------------------------- /tests/core/t_unix.ml: -------------------------------------------------------------------------------- 1 | module T = (val Containers_testlib.make ~__FILE__ ()) 2 | include T 3 | open CCUnix;; 4 | 5 | t @@ fun () -> escape_str "foo" = "foo";; 6 | t @@ fun () -> escape_str "foo bar" = "'foo bar'";; 7 | t @@ fun () -> escape_str "fo'o b'ar" = "'fo'\\''o b'\\''ar'";; 8 | t @@ fun () -> call_full ~stdin:(`Str "abc") "cat" |> stdout = "abc";; 9 | t @@ fun () -> call_full "echo %s" (escape_str "a'b'c") |> stdout = "a'b'c\n";; 10 | t @@ fun () -> call_full "echo %s" "a'b'c" |> stdout = "abc\n";; 11 | t @@ fun () -> call_stdout ~stdin:(`Str "abc") "cat" = "abc";; 12 | t @@ fun () -> call_stdout "echo %s" (escape_str "a'b'c") = "a'b'c\n";; 13 | t @@ fun () -> call_stdout "echo %s" "a'b'c" = "abc\n";; 14 | 15 | t @@ fun () -> 16 | let m = 200 in 17 | let n = 50 in 18 | let write_atom filename s = 19 | with_file_lock ~kind:`Write filename (fun () -> 20 | CCIO.with_out ~flags:[ Open_append; Open_creat ] filename (fun oc -> 21 | output_string oc s; 22 | flush oc)) 23 | in 24 | let f filename = 25 | for _j = 1 to m do 26 | write_atom filename "foo\n" 27 | done 28 | in 29 | CCIO.File.with_temp ~prefix:"containers_" ~suffix:".txt" (fun filename -> 30 | let a = Array.init n (fun _ -> Thread.create f filename) in 31 | Array.iter Thread.join a; 32 | let lines = CCIO.with_in filename CCIO.read_lines_l in 33 | assert_equal ~printer:string_of_int (n * m) (List.length lines); 34 | assert (List.for_all (( = ) "foo") lines)); 35 | true 36 | ;; 37 | 38 | t @@ fun () -> 39 | let filename = 40 | with_temp_dir "test_containers" (fun dir -> 41 | let name = Filename.concat dir "test" in 42 | CCIO.with_out name (fun oc -> 43 | output_string oc "content"; 44 | flush oc); 45 | assert (Sys.file_exists name); 46 | name) 47 | in 48 | assert (not (Sys.file_exists filename)); 49 | true 50 | -------------------------------------------------------------------------------- /tests/data/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name t) 3 | (flags :standard -strict-sequence -warn-error -a+8 -w -48) 4 | (modes 5 | (best exe)) 6 | (package containers-data) 7 | (libraries containers containers-data containers_testlib iter gen)) 8 | -------------------------------------------------------------------------------- /tests/data/t.ml: -------------------------------------------------------------------------------- 1 | Containers_testlib.run_all ~descr:"containers-data" 2 | [ 3 | T_bv.Test.get (); 4 | T_bijection.Test.get (); 5 | T_bitfield.Test.get (); 6 | T_cache.Test.get (); 7 | T_deque.Test.get (); 8 | T_fqueue.Test.get (); 9 | T_fun_vec.Test.get (); 10 | T_graph.Test.get (); 11 | T_hashset.Test.get (); 12 | T_hashtrie.Test.get (); 13 | T_het.Test.get (); 14 | T_immutarray.Test.get (); 15 | T_intmap.Test.get (); 16 | T_lazylist.Test.get (); 17 | T_misc.Test.get (); 18 | T_mutheap.Test.get (); 19 | T_persistenthashtbl.Test.get (); 20 | T_ral.Test.get (); 21 | T_ringbuffer.Test.get (); 22 | T_simplequeue.Test.get (); 23 | T_trie.Test.get (); 24 | T_wbt.Test.get (); 25 | T_zipper.Test.get (); 26 | ] 27 | -------------------------------------------------------------------------------- /tests/data/t_bijection.ml: -------------------------------------------------------------------------------- 1 | module Test = (val Containers_testlib.make ~__FILE__ ()) 2 | open Test 3 | open CCBijection 4 | module M = Make (CCInt) (String);; 5 | 6 | eq 2 (M.of_list [ 1, "1"; 2, "2" ] |> M.cardinal);; 7 | eq "1" (M.of_list [ 1, "1"; 2, "2" ] |> M.find_left 1);; 8 | eq "2" (M.of_list [ 1, "1"; 2, "2" ] |> M.find_left 2);; 9 | eq 1 (M.of_list [ 1, "1"; 2, "2" ] |> M.find_right "1");; 10 | eq 2 (M.of_list [ 1, "1"; 2, "2" ] |> M.find_right "2") 11 | -------------------------------------------------------------------------------- /tests/data/t_bitfield.ml: -------------------------------------------------------------------------------- 1 | module Test = (val Containers_testlib.make ~__FILE__ ()) 2 | open Test 3 | open CCBitField;; 4 | 5 | t @@ fun () -> 6 | let module B = CCBitField.Make () in 7 | let x = B.mk_field () in 8 | let y = B.mk_field () in 9 | let z = B.mk_field () in 10 | 11 | let f = B.empty |> B.set x true |> B.set y true in 12 | 13 | assert_bool "z_false" (not (B.get z f)); 14 | 15 | assert_bool "z_true" (f |> B.set z true |> B.get z); 16 | true 17 | ;; 18 | 19 | t @@ fun () -> 20 | let module B = CCBitField.Make () in 21 | let _ = B.mk_field () in 22 | B.freeze (); 23 | assert_bool "must raise" 24 | (try 25 | ignore (B.mk_field ()); 26 | false 27 | with Frozen -> true); 28 | true 29 | ;; 30 | 31 | t @@ fun () -> 32 | let module B = CCBitField.Make () in 33 | let x = B.mk_field () in 34 | let y = B.mk_field () in 35 | let z = B.mk_field () in 36 | let u = B.mk_field () in 37 | B.freeze (); 38 | 39 | let f = B.empty |> B.set y true |> B.set z true in 40 | 41 | assert_equal ~printer:CCInt.to_string 6 (f :> int); 42 | 43 | assert_equal false (B.get x f); 44 | assert_equal true (B.get y f); 45 | assert_equal true (B.get z f); 46 | 47 | let f' = B.set u true f in 48 | 49 | assert_equal false (B.get x f'); 50 | assert_equal true (B.get y f'); 51 | assert_equal true (B.get z f'); 52 | assert_equal true (B.get u f'); 53 | true 54 | ;; 55 | 56 | t @@ fun () -> all_bits_ 0 1 = 1;; 57 | t @@ fun () -> all_bits_ 0 2 = 3;; 58 | t @@ fun () -> all_bits_ 0 3 = 7;; 59 | t @@ fun () -> all_bits_ 0 4 = 15 60 | -------------------------------------------------------------------------------- /tests/data/t_cache.ml: -------------------------------------------------------------------------------- 1 | module Test = (val Containers_testlib.make ~__FILE__ ()) 2 | open Test 3 | open CCCache;; 4 | 5 | t @@ fun () -> 6 | let c = unbounded ~eq:Int64.equal 256 in 7 | let fib = 8 | with_cache_rec c (fun self n -> 9 | match n with 10 | | 1L | 2L -> 1L 11 | | _ -> CCInt64.(self (n - 1L) + self (n - 2L))) 12 | in 13 | assert_equal 55L (fib 10L); 14 | assert_equal 832040L (fib 30L); 15 | assert_equal 12586269025L (fib 50L); 16 | assert_equal 190392490709135L (fib 70L); 17 | true 18 | ;; 19 | 20 | t @@ fun () -> 21 | let eq (i1, _) (i2, _) = i1 = i2 and hash (i, _) = CCInt.hash i in 22 | let c = lru ~eq ~hash 2 in 23 | ignore (with_cache c CCFun.id (1, true)); 24 | ignore (with_cache c CCFun.id (1, false)); 25 | with_cache c CCFun.id (1, false) = (1, true) 26 | ;; 27 | 28 | t @@ fun () -> 29 | let f = 30 | let r = ref 0 in 31 | fun _ -> 32 | incr r; 33 | !r 34 | in 35 | let c = lru ~eq:CCInt.equal 2 in 36 | let res1 = with_cache c f 1 in 37 | let res2 = with_cache c f 2 in 38 | let res3 = with_cache c f 3 in 39 | let res1_bis = with_cache c f 1 in 40 | res1 <> res2 && res2 <> res3 && res3 <> res1_bis && res1_bis <> res1 41 | ;; 42 | 43 | t @@ fun () -> 44 | let f = 45 | let r = ref 0 in 46 | fun _ -> 47 | incr r; 48 | !r 49 | in 50 | let c = lru ~eq:CCEqual.unit 2 in 51 | let x = with_cache c f () in 52 | assert_equal 1 x; 53 | assert_equal 1 (size c); 54 | clear c; 55 | assert_equal 0 (size c); 56 | let y = with_cache c f () in 57 | assert_equal 2 y; 58 | true 59 | -------------------------------------------------------------------------------- /tests/data/t_graph.ml: -------------------------------------------------------------------------------- 1 | module Test = (val Containers_testlib.make ~__FILE__ ()) 2 | open Test 3 | open CCGraph;; 4 | 5 | t @@ fun () -> 6 | let l = 7 | let tbl = mk_table ~eq:CCInt.equal 128 in 8 | Traverse.Event.dfs ~tbl ~eq:CCInt.equal ~graph:divisors_graph 9 | (Iter.return 345614) 10 | |> Iter.to_list 11 | in 12 | let expected = 13 | [ 14 | `Enter (345614, 0, []); 15 | `Edge (345614, (), 172807, `Forward); 16 | `Enter (172807, 1, [ 345614, (), 172807 ]); 17 | `Edge (172807, (), 1, `Forward); 18 | `Enter (1, 2, [ 172807, (), 1; 345614, (), 172807 ]); 19 | `Exit 1; 20 | `Exit 172807; 21 | `Edge (345614, (), 2, `Forward); 22 | `Enter (2, 3, [ 345614, (), 2 ]); 23 | `Edge (2, (), 1, `Cross); 24 | `Exit 2; 25 | `Edge (345614, (), 1, `Cross); 26 | `Exit 345614; 27 | ] 28 | in 29 | assert_equal expected l; 30 | true 31 | ;; 32 | 33 | t @@ fun () -> 34 | let tbl = mk_table ~eq:CCInt.equal 128 in 35 | let l = topo_sort ~eq:CCInt.equal ~tbl ~graph:divisors_graph (Iter.return 42) in 36 | List.for_all 37 | (fun (i, j) -> 38 | let idx_i = CCList.find_idx (( = ) i) l |> CCOption.get_exn_or "" |> fst in 39 | let idx_j = CCList.find_idx (( = ) j) l |> CCOption.get_exn_or "" |> fst in 40 | idx_i < idx_j) 41 | [ 42, 21; 14, 2; 3, 1; 21, 7; 42, 3 ] 42 | ;; 43 | 44 | t @@ fun () -> 45 | let tbl = mk_table ~eq:CCInt.equal 128 in 46 | let l = 47 | topo_sort ~eq:CCInt.equal ~rev:true ~tbl ~graph:divisors_graph 48 | (Iter.return 42) 49 | in 50 | List.for_all 51 | (fun (i, j) -> 52 | let idx_i = CCList.find_idx (( = ) i) l |> CCOption.get_exn_or "" |> fst in 53 | let idx_j = CCList.find_idx (( = ) j) l |> CCOption.get_exn_or "" |> fst in 54 | idx_i > idx_j) 55 | [ 42, 21; 14, 2; 3, 1; 21, 7; 42, 3 ] 56 | ;; 57 | 58 | (* example from https://en.wikipedia.org/wiki/Strongly_connected_component *) 59 | t @@ fun () -> 60 | let set_eq ?(eq = ( = )) l1 l2 = 61 | CCList.subset ~eq l1 l2 && CCList.subset ~eq l2 l1 62 | in 63 | let graph = 64 | of_list ~eq:CCString.equal 65 | [ 66 | "a", "b"; 67 | "b", "e"; 68 | "e", "a"; 69 | "b", "f"; 70 | "e", "f"; 71 | "f", "g"; 72 | "g", "f"; 73 | "b", "c"; 74 | "c", "g"; 75 | "c", "d"; 76 | "d", "c"; 77 | "d", "h"; 78 | "h", "d"; 79 | "h", "g"; 80 | ] 81 | in 82 | let tbl = mk_table ~eq:CCString.equal 128 in 83 | let res = scc ~tbl ~graph (Iter.return "a") |> Iter.to_list in 84 | assert_bool "scc" 85 | (set_eq ~eq:(set_eq ?eq:None) res 86 | [ [ "a"; "b"; "e" ]; [ "f"; "g" ]; [ "c"; "d"; "h" ] ]); 87 | true 88 | -------------------------------------------------------------------------------- /tests/data/t_hashset.ml: -------------------------------------------------------------------------------- 1 | module Test = (val Containers_testlib.make ~__FILE__ ()) 2 | open Test 3 | open CCHashSet;; 4 | 5 | t @@ fun () -> 6 | let module IS = Make (CCInt) in 7 | IS.cardinal (IS.create 10) = 0 8 | ;; 9 | 10 | t @@ fun () -> 11 | let module IS = Make (CCInt) in 12 | IS.find (IS.of_list [ 1; 2; 3 ]) 3 = Some 3 13 | ;; 14 | 15 | t @@ fun () -> 16 | let module IS = Make (CCInt) in 17 | IS.find (IS.of_list [ 1; 2; 3 ]) 5 = None 18 | ;; 19 | 20 | t @@ fun () -> 21 | let module IS = Make (CCInt) in 22 | IS.(equal (inter (of_list [ 1; 2; 3 ]) (of_list [ 2; 5; 4 ])) (of_list [ 2 ])) 23 | ;; 24 | 25 | t @@ fun () -> 26 | let module IS = Make (CCInt) in 27 | IS.( 28 | equal 29 | (union (of_list [ 1; 2; 3 ]) (of_list [ 2; 5; 4 ])) 30 | (of_list [ 1; 2; 3; 4; 5 ])) 31 | ;; 32 | 33 | t @@ fun () -> 34 | let module IS = Make (CCInt) in 35 | IS.(equal (diff (of_list [ 1; 2; 3 ]) (of_list [ 2; 4; 5 ])) (of_list [ 1; 3 ])) 36 | -------------------------------------------------------------------------------- /tests/data/t_het.ml: -------------------------------------------------------------------------------- 1 | module Test = (val Containers_testlib.make ~__FILE__ ()) 2 | open Test 3 | open CCHet;; 4 | 5 | t @@ fun () -> 6 | let k1 : int Key.t = Key.create () in 7 | let k2 : int Key.t = Key.create () in 8 | let k3 : string Key.t = Key.create () in 9 | let k4 : float Key.t = Key.create () in 10 | 11 | let tbl = Tbl.create () in 12 | 13 | Tbl.add tbl k1 1; 14 | Tbl.add tbl k2 2; 15 | Tbl.add tbl k3 "k3"; 16 | 17 | assert_equal (Some 1) (Tbl.find tbl k1); 18 | assert_equal (Some 2) (Tbl.find tbl k2); 19 | assert_equal (Some "k3") (Tbl.find tbl k3); 20 | assert_equal None (Tbl.find tbl k4); 21 | assert_equal 3 (Tbl.length tbl); 22 | 23 | Tbl.add tbl k1 10; 24 | assert_equal (Some 10) (Tbl.find tbl k1); 25 | assert_equal 3 (Tbl.length tbl); 26 | assert_equal None (Tbl.find tbl k4); 27 | 28 | Tbl.add tbl k4 0.0; 29 | assert_equal (Some 0.0) (Tbl.find tbl k4); 30 | true 31 | -------------------------------------------------------------------------------- /tests/data/t_immutarray.ml: -------------------------------------------------------------------------------- 1 | module Test = (val Containers_testlib.make ~__FILE__ ()) 2 | open Test 3 | open CCImmutArray 4 | 5 | let print_array f a = to_list a |> Array.of_list |> Q.Print.(array f);; 6 | 7 | eq ~printer:(print_array Q.Print.int) (of_list [ 0 ]) (set (of_list [ 5 ]) 0 0) 8 | ;; 9 | 10 | eq ~printer:(print_array Q.Print.int) 11 | (of_list [ 1; 3; 4; 5 ]) 12 | (set (of_list [ 1; 2; 4; 5 ]) 1 3) 13 | 14 | let eq' = eq ~printer:(print_array Q.Print.int);; 15 | 16 | eq' empty (append empty empty);; 17 | eq' (of_list [ 1; 2; 3 ]) (append empty (of_list [ 1; 2; 3 ]));; 18 | eq' (of_list [ 1; 2; 3 ]) (append (of_list [ 1; 2; 3 ]) empty);; 19 | 20 | eq' 21 | (of_list [ 3; 1; 4; 1; 5 ]) 22 | (append (of_list [ 3; 1 ]) (of_list [ 4; 1; 5 ])) 23 | ;; 24 | 25 | eq 26 | ~printer:Q.Print.(list (pair int string)) 27 | [ 2, "baz"; 1, "bar"; 0, "foo" ] 28 | (foldi (fun l i a -> (i, a) :: l) [] (of_list [ "foo"; "bar"; "baz" ])) 29 | 30 | let eq' = eq ~printer:Q.Print.bool;; 31 | 32 | eq' true (for_all (fun _ -> false) empty);; 33 | eq' false (for_all (fun _ -> false) (singleton 3));; 34 | eq' true (for_all (fun n -> n mod 2 = 0) (of_list [ 2; 4; 8 ]));; 35 | eq' false (for_all (fun n -> n mod 2 = 0) (of_list [ 2; 4; 5; 8 ]));; 36 | eq' false (exists (fun _ -> true) empty);; 37 | eq' true (exists (fun _ -> true) (singleton 3));; 38 | eq' false (exists (fun _ -> false) (singleton 3));; 39 | eq' false (exists (fun n -> n mod 2 = 1) (of_list [ 2; 4; 8 ]));; 40 | eq' true (exists (fun n -> n mod 2 = 1) (of_list [ 2; 4; 5; 8 ]));; 41 | 42 | q 43 | Q.(list bool) 44 | (fun l -> 45 | let a = of_list l in 46 | not @@ exists (fun b -> b) a = for_all not a) 47 | ;; 48 | 49 | q 50 | Q.(list bool) 51 | (fun l -> 52 | let a = of_list l in 53 | not @@ for_all (fun b -> b) a = exists not a) 54 | ;; 55 | 56 | q 57 | Q.(list bool) 58 | (fun l -> exists (fun b -> b) (of_list l) = List.fold_left ( || ) false l) 59 | ;; 60 | 61 | q 62 | Q.(list bool) 63 | (fun l -> for_all (fun b -> b) (of_list l) = List.fold_left ( && ) true l) 64 | ;; 65 | 66 | q 67 | Q.(list int) 68 | (fun l -> 69 | let g = Iter.of_list l in 70 | of_iter g |> to_iter |> Iter.to_list = l) 71 | ;; 72 | 73 | q 74 | Q.(list int) 75 | (fun l -> 76 | let g = Gen.of_list l in 77 | of_gen g |> to_gen |> Gen.to_list = l) 78 | -------------------------------------------------------------------------------- /tests/data/t_lazylist.ml: -------------------------------------------------------------------------------- 1 | module Test = (val Containers_testlib.make ~__FILE__ ()) 2 | open Test 3 | open CCLazy_list;; 4 | 5 | q Q.(list int) (fun l -> length (of_list l) = List.length l);; 6 | 7 | eq [ 2; 4; 6 ] 8 | (of_list [ 1; 2; 3; 4; 5; 6; 7 ] 9 | |> filter ~f:(fun x -> x mod 2 = 0) 10 | |> to_list) 11 | ;; 12 | 13 | eq [ 2; 4; 6 ] 14 | (of_gen Gen.(1 -- max_int) 15 | |> filter ~f:(fun x -> x mod 2 = 0) 16 | |> take 3 |> to_list) 17 | ;; 18 | 19 | q 20 | Q.(pair (list int) (list int)) 21 | (fun (l1, l2) -> 22 | length (append (of_list l1) (of_list l2)) = List.length l1 + List.length l2) 23 | ;; 24 | 25 | eq [ 1 ] (default ~default:(return 1) empty |> to_list);; 26 | q Q.(list int) (fun l -> l = (Gen.of_list l |> of_gen |> to_list));; 27 | q Q.(list int) (fun l -> l = to_list (of_list l));; 28 | q Q.(list int) (fun l -> l = (of_list l |> to_gen |> Gen.to_list)) 29 | -------------------------------------------------------------------------------- /tests/data/t_mutheap.ml: -------------------------------------------------------------------------------- 1 | module Test = (val Containers_testlib.make ~__FILE__ ()) 2 | open Test 3 | 4 | type elt = { 5 | x: string; 6 | mutable rank: int; 7 | mutable idx: int; 8 | } 9 | 10 | module Elt = struct 11 | type t = elt 12 | 13 | let idx x = x.idx 14 | let set_idx x i = x.idx <- i 15 | 16 | let lt a b = 17 | if a.rank = b.rank then 18 | a.x < b.x 19 | else 20 | a.rank < b.rank 21 | end 22 | 23 | module H = CCMutHeap.Make (Elt);; 24 | 25 | t @@ fun () -> 26 | let h = H.create () in 27 | let x1 = { x = "a"; rank = 10; idx = -1 } in 28 | let x2 = { x = "b"; rank = 10; idx = -1 } in 29 | let x3 = { x = "c"; rank = 10; idx = -1 } in 30 | H.insert h x1; 31 | assert (H.in_heap x1); 32 | assert (not (H.in_heap x2)); 33 | assert (not (H.in_heap x3)); 34 | H.insert h x2; 35 | H.insert h x3; 36 | 37 | assert (Elt.lt x1 x2); 38 | assert (Elt.lt x2 x3); 39 | 40 | let x = H.remove_min h in 41 | assert (x == x1); 42 | 43 | let x = H.remove_min h in 44 | assert (x == x2); 45 | 46 | let x = H.remove_min h in 47 | assert (x == x3); 48 | 49 | assert ( 50 | try 51 | ignore (H.remove_min h); 52 | false 53 | with Not_found -> true); 54 | true 55 | ;; 56 | 57 | t @@ fun () -> 58 | let h = H.create () in 59 | let x1 = { x = "a"; rank = 10; idx = -1 } in 60 | let x2 = { x = "b"; rank = 10; idx = -1 } in 61 | let x3 = { x = "c"; rank = 10; idx = -1 } in 62 | H.insert h x1; 63 | H.insert h x2; 64 | H.insert h x3; 65 | 66 | x3.rank <- 2; 67 | H.decrease h x3; 68 | 69 | assert (Elt.lt x3 x1); 70 | assert (Elt.lt x3 x2); 71 | 72 | let x = H.remove_min h in 73 | assert (x == x3); 74 | 75 | x1.rank <- 20; 76 | H.increase h x1; 77 | 78 | let x = H.remove_min h in 79 | assert (x == x2); 80 | 81 | let x = H.remove_min h in 82 | assert (x == x1); 83 | 84 | assert ( 85 | try 86 | ignore (H.remove_min h); 87 | false 88 | with Not_found -> true); 89 | true 90 | -------------------------------------------------------------------------------- /tests/data/t_simplequeue.ml: -------------------------------------------------------------------------------- 1 | module Test = (val Containers_testlib.make ~__FILE__ ()) 2 | open Test 3 | open CCSimple_queue;; 4 | 5 | q 6 | Q.(list small_int) 7 | (fun l -> 8 | let q = of_list l in 9 | equal CCInt.equal (Gen.unfold pop q |> of_gen) q) 10 | ;; 11 | 12 | q 13 | Q.(list small_int) 14 | (fun l -> equal CCInt.equal (of_list l |> rev) (of_list (List.rev l))) 15 | ;; 16 | 17 | q 18 | Q.(list small_int) 19 | (fun l -> 20 | let q = of_list l in 21 | equal CCInt.equal q (q |> rev |> rev)) 22 | ;; 23 | 24 | q Q.(list small_int) (fun l -> length (of_list l) = List.length l);; 25 | 26 | q 27 | Q.(list small_int) 28 | (fun l -> equal CCInt.equal (of_list l) (List.fold_left snoc empty l)) 29 | ;; 30 | 31 | q 32 | Q.(list small_int) 33 | (fun l -> equal CCInt.equal (of_iter (Iter.of_list l)) (of_list l)) 34 | ;; 35 | 36 | q Q.(list small_int) (fun l -> l = (of_list l |> to_iter |> Iter.to_list));; 37 | 38 | q 39 | Q.(pair (list small_int) (list small_int)) 40 | (fun (l1, l2) -> equal CCInt.equal (of_list l1) (of_list l2) = (l1 = l2)) 41 | ;; 42 | 43 | q 44 | Q.(pair (list small_int) (list small_int)) 45 | (fun (l1, l2) -> 46 | equal CCInt.equal 47 | (append (of_list l1) (of_list l2)) 48 | (of_list (List.append l1 l2))) 49 | -------------------------------------------------------------------------------- /tests/data/t_zipper.ml: -------------------------------------------------------------------------------- 1 | module Test = (val Containers_testlib.make ~__FILE__ ()) 2 | open Test 3 | open CCZipper;; 4 | 5 | t @@ fun () -> is_empty empty;; 6 | t @@ fun () -> not ([ 42 ] |> make |> right |> is_empty) 7 | 8 | let zip_gen = Q.(pair (small_list int) (small_list int));; 9 | 10 | q zip_gen (fun z -> to_list z = List.rev (to_rev_list z));; 11 | q zip_gen (fun g -> is_focused g = (focused g |> CCOption.is_some));; 12 | 13 | q 14 | Q.(triple int (list small_int) (list small_int)) 15 | (fun (x, l, r) -> insert x (l, r) |> remove = (l, r)) 16 | ;; 17 | 18 | eq ([ 1 ], [ 2 ]) (drop_after ([ 1 ], [ 2; 3 ]));; 19 | eq ([ 1 ], []) (drop_after ([ 1 ], []));; 20 | eq ([ 1 ], []) (drop_after_and_focused ([ 1 ], [ 2; 3 ])) 21 | -------------------------------------------------------------------------------- /tests/pvec/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name t) 3 | (flags :standard -strict-sequence -warn-error -a+8 -w -48) 4 | (modes 5 | (best exe)) 6 | (package containers) 7 | (libraries containers containers.pvec containers_testlib iter)) 8 | -------------------------------------------------------------------------------- /tests/pvec/t.ml: -------------------------------------------------------------------------------- 1 | Containers_testlib.run_all ~descr:"containers.pvec" [ T_pvec.Test.get () ] 2 | --------------------------------------------------------------------------------