simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2026-01-23 17:46:40 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge branch 'master' into stable for 2.0~alpha1

Browse source
This commit is contained in:
Simon Cruanes 2018-01-21 15:31:24 -06:00
commit d0223f053f
121 changed files with 2140 additions and 12306 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -9,3 +9,4 @@ TAGS
setup.*
qtest*
*.html
.merlin

21
.merlin
View file

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

6
.travis.yml
View file

@ -1,6 +1,5 @@
language: c
env:
- OCAML_VERSION=4.01.0
- OCAML_VERSION=4.02.3
- OCAML_VERSION=4.04.2
- OCAML_VERSION=4.05.0
@ -26,12 +25,9 @@ before_install:
install:
# Install dependencies
- opam pin add --no-action containers .
- opam install oasis
- opam install jbuilder base-bytes result
- opam install --deps-only containers
script:
- ./configure --enable-unix --enable-thread --disable-tests --disable-bench
- make build
- opam install sequence qcheck qtest gen
- ./configure --enable-unix --enable-thread --enable-tests --enable-docs --disable-bench
- make test
- make doc

133
Makefile
View file

@ -1,130 +1,31 @@
# OASIS_START
# DO NOT EDIT (digest: a3c674b4239234cbbe53afe090018954)
all: build test
SETUP = ocaml setup.ml
build:
jbuilder build @install
build: setup.data
$(SETUP) -build $(BUILDFLAGS)
doc: setup.data build
$(SETUP) -doc $(DOCFLAGS)
test: setup.data build
$(SETUP) -test $(TESTFLAGS)
all:
$(SETUP) -all $(ALLFLAGS)
install: setup.data
$(SETUP) -install $(INSTALLFLAGS)
uninstall: setup.data
$(SETUP) -uninstall $(UNINSTALLFLAGS)
reinstall: setup.data
$(SETUP) -reinstall $(REINSTALLFLAGS)
test:
jbuilder runtest --no-buffer
clean:
$(SETUP) -clean $(CLEANFLAGS)
jbuilder clean
distclean:
$(SETUP) -distclean $(DISTCLEANFLAGS)
doc:
jbuilder build @doc
setup.data:
$(SETUP) -configure $(CONFIGUREFLAGS)
BENCH_TARGETS=run_benchs.exe run_bench_hash.exe
configure:
$(SETUP) -configure $(CONFIGUREFLAGS)
benchs:
jbuilder build $(addprefix bench/, $(BENCH_TARGETS))
.PHONY: build doc test all install uninstall reinstall clean distclean configure
examples:
jbuilder build examples/id_sexp.exe
# OASIS_STOP
EXAMPLES = examples/mem_size.native examples/collatz.native \
examples/bencode_write.native # examples/crawl.native
OPTIONS = -use-ocamlfind -I _build
examples: all
ocamlbuild $(OPTIONS) -package unix -I . $(EXAMPLES)
push_doc: doc
rsync -tavu containers.docdir/* cedeela.fr:~/simon/root/software/containers/
push_doc_gh: doc
git checkout gh-pages && \
rm -rf dev/ && \
mkdir -p dev && \
cp -r containers.docdir/* dev/ && \
git add --all dev
DONTTEST=myocamlbuild.ml setup.ml $(wildcard src/**/*.cppo.*) $(wildcard src/**/*Labels*)
QTESTABLE=$(filter-out $(DONTTEST), \
$(wildcard src/core/*.ml) \
$(wildcard src/core/*.mli) \
$(wildcard src/data/*.ml) \
$(wildcard src/data/*.mli) \
$(wildcard src/string/*.ml) \
$(wildcard src/string/*.mli) \
$(wildcard src/unix/*.ml) \
$(wildcard src/unix/*.mli) \
$(wildcard src/sexp/*.ml) \
$(wildcard src/sexp/*.mli) \
$(wildcard src/iter/*.ml) \
$(wildcard src/iter/*.mli) \
$(wildcard src/bigarray/*.ml) \
$(wildcard src/bigarray/*.mli) \
$(wildcard src/threads/*.ml) \
$(wildcard src/threads/*.mli) \
)
qtest-clean:
@rm -rf qtest/
QTEST_PREAMBLE='open CCFun;; '
#qtest-build: qtest-clean build
# @mkdir -p qtest
# @qtest extract --preamble $(QTEST_PREAMBLE) \
# -o qtest/qtest_all.ml \
# $(QTESTABLE) 2> /dev/null
# @ocamlbuild $(OPTIONS) -pkg oUnit,QTest2Lib,ocamlbuildlib \
# -I core -I misc -I string \
# qtest/qtest_all.native
qtest-gen:
@mkdir -p qtest
@if which qtest > /dev/null ; then \
qtest extract --preamble $(QTEST_PREAMBLE) \
-o qtest/run_qtest.ml \
$(QTESTABLE) 2> /dev/null ; \
else touch qtest/run_qtest.ml ; \
fi
push-stable:
git checkout stable
git merge master -m 'merge from master'
oasis setup
git commit -a -m 'oasis files'
git push origin
git checkout master
clean-generated:
rm **/*.{mldylib,mlpack,mllib} myocamlbuild.ml -f
tags:
otags *.ml *.mli
VERSION=$(shell awk '/^Version:/ {print $$2}' _oasis)
VERSION=$(shell awk '/^version:/ {print $$2}' containers.opam)
update_next_tag:
@echo "update version to $(VERSION)..."
zsh -c 'sed -i "s/NEXT_VERSION/$(VERSION)/g" **/*.ml **/*.mli'
zsh -c 'sed -i "s/NEXT_RELEASE/$(VERSION)/g" **/*.ml **/*.mli'
devel:
./configure --enable-bench --enable-tests --enable-unix \
--enable-thread
make all
sed -i "s/NEXT_VERSION/$(VERSION)/g" src/*.ml src/*.mli
sed -i "s/NEXT_RELEASE/$(VERSION)/g" src/*.ml src/*.mli
watch:
while find src/ benchs/ -print0 | xargs -0 inotifywait -e delete_self -e modify ; do \
@ -137,4 +38,4 @@ reindent:
@find src '(' -name '*.ml' -or -name '*.mli' ')' -type f -print0 | xargs -0 echo "reindenting: "
@find src '(' -name '*.ml' -or -name '*.mli' ')' -type f -print0 | xargs -0 ocp-indent -i
.PHONY: examples push_doc tags qtest-gen qtest-clean devel update_next_tag
.PHONY: all test clean build doc update_next_tag watch

161
_oasis
View file

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

123
_tags
View file

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

10
benchs/jbuild Normal file
View file

@ -0,0 +1,10 @@
(executables
((names (run_benchs run_bench_hash))
(libraries (containers containers.data containers.iter
containers.thread benchmark gen sequence))
(flags (:standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -color always))
(ocamlopt_flags (:standard -O3 -color always
-unbox-closures -unbox-closures-factor 20))
))

34
benchs/run_benchs.ml
View file

@ -280,7 +280,7 @@ module Arr = struct
let a2 = Array.copy a1 in
sort_std a1;
quicksort ~limit:10 a2;
assert (a1 = a2))
assert (CCArray.equal CCInt.equal a1 a2))
[ 10; 100; 1000]
let bench_sort ?(time=2) n =
@ -366,16 +366,16 @@ module Cache = struct
let bench_fib n =
let l =
[ "replacing_fib (128)", make_fib (C.replacing 128), n
; "LRU_fib (128)", make_fib (C.lru 128), n
; "replacing_fib (16)", make_fib (C.replacing 16), n
; "LRU_fib (16)", make_fib (C.lru 16), n
; "unbounded", make_fib (C.unbounded 32), n
[ "replacing_fib (128)", make_fib (C.replacing ~eq:CCInt.equal 128), n
; "LRU_fib (128)", make_fib (C.lru ~eq:CCInt.equal 128), n
; "replacing_fib (16)", make_fib (C.replacing ~eq:CCInt.equal 16), n
; "LRU_fib (16)", make_fib (C.lru ~eq:CCInt.equal 16), n
; "unbounded", make_fib (C.unbounded ~eq:CCInt.equal 32), n
]
in
let l = if n <= 20
then [ "linear_fib (5)", make_fib (C.linear 5), n
; "linear_fib (32)", make_fib (C.linear 32), n
then [ "linear_fib (5)", make_fib (C.linear ~eq:CCInt.equal 5), n
; "linear_fib (32)", make_fib (C.linear ~eq:CCInt.equal 32), n
; "dummy_fib", make_fib C.dummy, n
] @ l
else l
@ -862,7 +862,7 @@ module Deque = struct
let take_back d =
match !d with
| None -> raise Empty
| Some first when first == first.prev ->
| Some first when Pervasives.(==) first first.prev ->
(* only one element *)
d := None;
first.content
@ -875,7 +875,7 @@ module Deque = struct
let take_front d =
match !d with
| None -> raise Empty
| Some first when first == first.prev ->
| Some first when Pervasives.(==) first first.prev ->
(* only one element *)
d := None;
first.content
@ -1045,7 +1045,7 @@ module Graph = struct
let dfs_event n () =
let tbl = CCGraph.mk_table ~eq:CCInt.equal ~hash:CCInt.hash (n+10) in
CCGraph.Traverse.Event.dfs ~tbl ~graph:div_graph_
CCGraph.Traverse.Event.dfs ~tbl ~eq:CCInt.equal ~graph:div_graph_
(Sequence.return n)
|> Sequence.fold
(fun acc -> function
@ -1154,7 +1154,7 @@ module Str = struct
and mk_current () = CCString.find_all_l ~sub:needle haystack
and mk_current_compiled =
let f = CCString.find_all_l ~start:0 ~sub:needle in fun () -> f haystack in
assert (mk_naive () = mk_current ());
assert (CCList.equal CCInt.equal (mk_naive ()) (mk_current ()));
B.throughputN 3 ~repeat
[ "naive", mk_naive, ()
; "current", mk_current, ()
@ -1168,7 +1168,7 @@ module Str = struct
pp_pb needle haystack;
let mk_naive () = find_all_l ~sub:needle haystack
and mk_current () = CCString.find_all_l ~sub:needle haystack in
assert (mk_naive () = mk_current ());
assert (CCList.equal CCInt.equal (mk_naive ()) (mk_current ()));
B.throughputN 3 ~repeat
[ "naive", mk_naive, ()
; "current", mk_current, ()
@ -1182,7 +1182,7 @@ module Str = struct
let rec same s1 s2 i =
if i = String.length s1 then true
else (
String.unsafe_get s1 i = String.unsafe_get s2 i && same s1 s2 (i+1)
CCChar.equal (String.unsafe_get s1 i) (String.unsafe_get s2 i) && same s1 s2 (i+1)
)
in
String.length pre <= String.length s &&
@ -1193,7 +1193,7 @@ module Str = struct
begin
let i = ref 0 in
while !i < String.length pre &&
String.unsafe_get s !i = String.unsafe_get pre !i
CCChar.equal (String.unsafe_get s !i) (String.unsafe_get pre !i)
do incr i done;
!i = String.length pre
end
@ -1225,7 +1225,7 @@ module Str = struct
else
let rec loop str p i =
if i = len then true
else if String.unsafe_get str i <> String.unsafe_get p i then false
else if not (CCChar.equal (String.unsafe_get str i) (String.unsafe_get p i)) then false
else loop str p (i + 1)
in loop str p 0
@ -1256,7 +1256,7 @@ module Str = struct
Array.iteri
(fun i (pre, y) ->
let res = f ~pre y in
assert (res = output.(i)))
assert (CCBool.equal res output.(i)))
input
in
Benchmark.throughputN 3

27
configure vendored
View file

@ -1,27 +0,0 @@
#!/bin/sh
# OASIS_START
# DO NOT EDIT (digest: dc86c2ad450f91ca10c931b6045d0499)
set -e
FST=true
for i in "$@"; do
if $FST; then
set --
FST=false
fi
case $i in
--*=*)
ARG=${i%%=*}
VAL=${i##*=}
set -- "$@" "$ARG" "$VAL"
;;
*)
set -- "$@" "$i"
;;
esac
done
ocaml setup.ml -configure "$@"
# OASIS_STOP

39
containers.opam Normal file
View file

@ -0,0 +1,39 @@
opam-version: "1.2"
name: "containers"
version: "2.0~alpha1"
author: "Simon Cruanes"
maintainer: "simon.cruanes.2007@m4x.org"
build: [
["jbuilder" "build" "-p" name "-j" jobs]
]
build-doc: [ make "doc" ]
build-test: [ make "test" ]
depends: [
"jbuilder" {build}
"base-bytes"
"result"
]
depopts: [
"base-unix"
"base-threads"
"qtest" { test }
]
conflicts: [
"sequence" { < "0.5" }
]
tags: [ "stdlib" "containers" "iterators" "list" "heap" "queue" ]
homepage: "https://github.com/c-cube/ocaml-containers/"
doc: "https://c-cube.github.io/ocaml-containers"
available: [ocaml-version >= "4.02.0"]
dev-repo: "https://github.com/c-cube/ocaml-containers.git"
bug-reports: "https://github.com/c-cube/ocaml-containers/issues/"
post-messages: [
"Major release with some breaking changes in the API.
These changes belong to 3 categories:
- make `open Containers` replace polymorphic operators with monomorphic ones
- make most optional arguments relying on polymorphic operators mandatory
- improve consistency of printers
changelog: https://github.com/c-cube/ocaml-containers/blob/2.0~alpha1/CHANGELOG.adoc"
]

10
examples/jbuild Normal file
View file

@ -0,0 +1,10 @@
(executables
((names (id_sexp))
(libraries (containers.sexp))
(flags (:standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -color always))
(ocamlopt_flags (:standard -O3 -color always
-unbox-closures -unbox-closures-factor 20))
))

938
myocamlbuild.ml
View file

@ -1,938 +0,0 @@
(* OASIS_START *)
(* DO NOT EDIT (digest: 9ebeddeee0d56b1f8c98544fabcbbd9b) *)
module OASISGettext = struct
(* # 22 "src/oasis/OASISGettext.ml" *)
let ns_ str = str
let s_ str = str
let f_ (str: ('a, 'b, 'c, 'd) format4) = str
let fn_ fmt1 fmt2 n =
if n = 1 then
fmt1^^""
else
fmt2^^""
let init = []
end
module OASISString = struct
(* # 22 "src/oasis/OASISString.ml" *)
(** Various string utilities.
Mostly inspired by extlib and batteries ExtString and BatString libraries.
@author Sylvain Le Gall
*)
let nsplitf str f =
if str = "" then
[]
else
let buf = Buffer.create 13 in
let lst = ref [] in
let push () =
lst := Buffer.contents buf :: !lst;
Buffer.clear buf
in
let str_len = String.length str in
for i = 0 to str_len - 1 do
if f str.[i] then
push ()
else
Buffer.add_char buf str.[i]
done;
push ();
List.rev !lst
(** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
separator.
*)
let nsplit str c =
nsplitf str ((=) c)
let find ~what ?(offset=0) str =
let what_idx = ref 0 in
let str_idx = ref offset in
while !str_idx < String.length str &&
!what_idx < String.length what do
if str.[!str_idx] = what.[!what_idx] then
incr what_idx
else
what_idx := 0;
incr str_idx
done;
if !what_idx <> String.length what then
raise Not_found
else
!str_idx - !what_idx
let sub_start str len =
let str_len = String.length str in
if len >= str_len then
""
else
String.sub str len (str_len - len)
let sub_end ?(offset=0) str len =
let str_len = String.length str in
if len >= str_len then
""
else
String.sub str 0 (str_len - len)
let starts_with ~what ?(offset=0) str =
let what_idx = ref 0 in
let str_idx = ref offset in
let ok = ref true in
while !ok &&
!str_idx < String.length str &&
!what_idx < String.length what do
if str.[!str_idx] = what.[!what_idx] then
incr what_idx
else
ok := false;
incr str_idx
done;
!what_idx = String.length what
let strip_starts_with ~what str =
if starts_with ~what str then
sub_start str (String.length what)
else
raise Not_found
let ends_with ~what ?(offset=0) str =
let what_idx = ref ((String.length what) - 1) in
let str_idx = ref ((String.length str) - 1) in
let ok = ref true in
while !ok &&
offset <= !str_idx &&
0 <= !what_idx do
if str.[!str_idx] = what.[!what_idx] then
decr what_idx
else
ok := false;
decr str_idx
done;
!what_idx = -1
let strip_ends_with ~what str =
if ends_with ~what str then
sub_end str (String.length what)
else
raise Not_found
let replace_chars f s =
let buf = Buffer.create (String.length s) in
String.iter (fun c -> Buffer.add_char buf (f c)) s;
Buffer.contents buf
let lowercase_ascii =
replace_chars
(fun c ->
if (c >= 'A' && c <= 'Z') then
Char.chr (Char.code c + 32)
else
c)
let uncapitalize_ascii s =
if s <> "" then
(lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
else
s
let uppercase_ascii =
replace_chars
(fun c ->
if (c >= 'a' && c <= 'z') then
Char.chr (Char.code c - 32)
else
c)
let capitalize_ascii s =
if s <> "" then
(uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
else
s
end
module OASISUtils = struct
(* # 22 "src/oasis/OASISUtils.ml" *)
open OASISGettext
module MapExt =
struct
module type S =
sig
include Map.S
val add_list: 'a t -> (key * 'a) list -> 'a t
val of_list: (key * 'a) list -> 'a t
val to_list: 'a t -> (key * 'a) list
end
module Make (Ord: Map.OrderedType) =
struct
include Map.Make(Ord)
let rec add_list t =
function
| (k, v) :: tl -> add_list (add k v t) tl
| [] -> t
let of_list lst = add_list empty lst
let to_list t = fold (fun k v acc -> (k, v) :: acc) t []
end
end
module MapString = MapExt.Make(String)
module SetExt =
struct
module type S =
sig
include Set.S
val add_list: t -> elt list -> t
val of_list: elt list -> t
val to_list: t -> elt list
end
module Make (Ord: Set.OrderedType) =
struct
include Set.Make(Ord)
let rec add_list t =
function
| e :: tl -> add_list (add e t) tl
| [] -> t
let of_list lst = add_list empty lst
let to_list = elements
end
end
module SetString = SetExt.Make(String)
let compare_csl s1 s2 =
String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2)
module HashStringCsl =
Hashtbl.Make
(struct
type t = string
let equal s1 s2 = (compare_csl s1 s2) = 0
let hash s = Hashtbl.hash (OASISString.lowercase_ascii s)
end)
module SetStringCsl =
SetExt.Make
(struct
type t = string
let compare = compare_csl
end)
let varname_of_string ?(hyphen='_') s =
if String.length s = 0 then
begin
invalid_arg "varname_of_string"
end
else
begin
let buf =
OASISString.replace_chars
(fun c ->
if ('a' <= c && c <= 'z')
||
('A' <= c && c <= 'Z')
||
('0' <= c && c <= '9') then
c
else
hyphen)
s;
in
let buf =
(* Start with a _ if digit *)
if '0' <= s.[0] && s.[0] <= '9' then
"_"^buf
else
buf
in
OASISString.lowercase_ascii buf
end
let varname_concat ?(hyphen='_') p s =
let what = String.make 1 hyphen in
let p =
try
OASISString.strip_ends_with ~what p
with Not_found ->
p
in
let s =
try
OASISString.strip_starts_with ~what s
with Not_found ->
s
in
p^what^s
let is_varname str =
str = varname_of_string str
let failwithf fmt = Printf.ksprintf failwith fmt
let rec file_location ?pos1 ?pos2 ?lexbuf () =
match pos1, pos2, lexbuf with
| Some p, None, _ | None, Some p, _ ->
file_location ~pos1:p ~pos2:p ?lexbuf ()
| Some p1, Some p2, _ ->
let open Lexing in
let fn, lineno = p1.pos_fname, p1.pos_lnum in
let c1 = p1.pos_cnum - p1.pos_bol in
let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in
Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2
| _, _, Some lexbuf ->
file_location
~pos1:(Lexing.lexeme_start_p lexbuf)
~pos2:(Lexing.lexeme_end_p lexbuf)
()
| None, None, None ->
s_ "<position undefined>"
let failwithpf ?pos1 ?pos2 ?lexbuf fmt =
let loc = file_location ?pos1 ?pos2 ?lexbuf () in
Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt
end
module OASISExpr = struct
(* # 22 "src/oasis/OASISExpr.ml" *)
open OASISGettext
open OASISUtils
type test = string
type flag = string
type t =
| EBool of bool
| ENot of t
| EAnd of t * t
| EOr of t * t
| EFlag of flag
| ETest of test * string
type 'a choices = (t * 'a) list
let eval var_get t =
let rec eval' =
function
| EBool b ->
b
| ENot e ->
not (eval' e)
| EAnd (e1, e2) ->
(eval' e1) && (eval' e2)
| EOr (e1, e2) ->
(eval' e1) || (eval' e2)
| EFlag nm ->
let v =
var_get nm
in
assert(v = "true" || v = "false");
(v = "true")
| ETest (nm, vl) ->
let v =
var_get nm
in
(v = vl)
in
eval' t
let choose ?printer ?name var_get lst =
let rec choose_aux =
function
| (cond, vl) :: tl ->
if eval var_get cond then
vl
else
choose_aux tl
| [] ->
let str_lst =
if lst = [] then
s_ "<empty>"
else
String.concat
(s_ ", ")
(List.map
(fun (cond, vl) ->
match printer with
| Some p -> p vl
| None -> s_ "<no printer>")
lst)
in
match name with
| Some nm ->
failwith
(Printf.sprintf
(f_ "No result for the choice list '%s': %s")
nm str_lst)
| None ->
failwith
(Printf.sprintf
(f_ "No result for a choice list: %s")
str_lst)
in
choose_aux (List.rev lst)
end
# 437 "myocamlbuild.ml"
module BaseEnvLight = struct
(* # 22 "src/base/BaseEnvLight.ml" *)
module MapString = Map.Make(String)
type t = string MapString.t
let default_filename = Filename.concat (Sys.getcwd ()) "setup.data"
let load ?(allow_empty=false) ?(filename=default_filename) ?stream () =
let line = ref 1 in
let lexer st =
let st_line =
Stream.from
(fun _ ->
try
match Stream.next st with
| '\n' -> incr line; Some '\n'
| c -> Some c
with Stream.Failure -> None)
in
Genlex.make_lexer ["="] st_line
in
let rec read_file lxr mp =
match Stream.npeek 3 lxr with
| [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
Stream.junk lxr; Stream.junk lxr; Stream.junk lxr;
read_file lxr (MapString.add nm value mp)
| [] -> mp
| _ ->
failwith
(Printf.sprintf "Malformed data file '%s' line %d" filename !line)
in
match stream with
| Some st -> read_file (lexer st) MapString.empty
| None ->
if Sys.file_exists filename then begin
let chn = open_in_bin filename in
let st = Stream.of_channel chn in
try
let mp = read_file (lexer st) MapString.empty in
close_in chn; mp
with e ->
close_in chn; raise e
end else if allow_empty then begin
MapString.empty
end else begin
failwith
(Printf.sprintf
"Unable to load environment, the file '%s' doesn't exist."
filename)
end
let rec var_expand str env =
let buff = Buffer.create ((String.length str) * 2) in
Buffer.add_substitute
buff
(fun var ->
try
var_expand (MapString.find var env) env
with Not_found ->
failwith
(Printf.sprintf
"No variable %s defined when trying to expand %S."
var
str))
str;
Buffer.contents buff
let var_get name env = var_expand (MapString.find name env) env
let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst
end
# 517 "myocamlbuild.ml"
module MyOCamlbuildFindlib = struct
(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
(** OCamlbuild extension, copied from
* https://ocaml.org/learn/tutorials/ocamlbuild/Using_ocamlfind_with_ocamlbuild.html
* by N. Pouillard and others
*
* Updated on 2016-06-02
*
* Modified by Sylvain Le Gall
*)
open Ocamlbuild_plugin
type conf = {no_automatic_syntax: bool}
let run_and_read = Ocamlbuild_pack.My_unix.run_and_read
let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings
let exec_from_conf exec =
let exec =
let env = BaseEnvLight.load ~allow_empty:true () in
try
BaseEnvLight.var_get exec env
with Not_found ->
Printf.eprintf "W: Cannot get variable %s\n" exec;
exec
in
let fix_win32 str =
if Sys.os_type = "Win32" then begin
let buff = Buffer.create (String.length str) in
(* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'.
*)
String.iter
(fun c -> Buffer.add_char buff (if c = '\\' then '/' else c))
str;
Buffer.contents buff
end else begin
str
end
in
fix_win32 exec
let split s ch =
let buf = Buffer.create 13 in
let x = ref [] in
let flush () =
x := (Buffer.contents buf) :: !x;
Buffer.clear buf
in
String.iter
(fun c ->
if c = ch then
flush ()
else
Buffer.add_char buf c)
s;
flush ();
List.rev !x
let split_nl s = split s '\n'
let before_space s =
try
String.before s (String.index s ' ')
with Not_found -> s
(* ocamlfind command *)
let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x]
(* This lists all supported packages. *)
let find_packages () =
List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list"))
(* Mock to list available syntaxes. *)
let find_syntaxes () = ["camlp4o"; "camlp4r"]
let well_known_syntax = [
"camlp4.quotations.o";
"camlp4.quotations.r";
"camlp4.exceptiontracer";
"camlp4.extend";
"camlp4.foldgenerator";
"camlp4.listcomprehension";
"camlp4.locationstripper";
"camlp4.macro";
"camlp4.mapgenerator";
"camlp4.metagenerator";
"camlp4.profiler";
"camlp4.tracer"
]
let dispatch conf =
function
| After_options ->
(* By using Before_options one let command line options have an higher
* priority on the contrary using After_options will guarantee to have
* the higher priority override default commands by ocamlfind ones *)
Options.ocamlc := ocamlfind & A"ocamlc";
Options.ocamlopt := ocamlfind & A"ocamlopt";
Options.ocamldep := ocamlfind & A"ocamldep";
Options.ocamldoc := ocamlfind & A"ocamldoc";
Options.ocamlmktop := ocamlfind & A"ocamlmktop";
Options.ocamlmklib := ocamlfind & A"ocamlmklib"
| After_rules ->
(* Avoid warnings for unused tag *)
flag ["tests"] N;
(* When one link an OCaml library/binary/package, one should use
* -linkpkg *)
flag ["ocaml"; "link"; "program"] & A"-linkpkg";
(* For each ocamlfind package one inject the -package option when
* compiling, computing dependencies, generating documentation and
* linking. *)
List.iter
begin fun pkg ->
let base_args = [A"-package"; A pkg] in
(* TODO: consider how to really choose camlp4o or camlp4r. *)
let syn_args = [A"-syntax"; A "camlp4o"] in
let (args, pargs) =
(* Heuristic to identify syntax extensions: whether they end in
".syntax"; some might not.
*)
if not (conf.no_automatic_syntax) &&
(Filename.check_suffix pkg "syntax" ||
List.mem pkg well_known_syntax) then
(syn_args @ base_args, syn_args)
else
(base_args, [])
in
flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
(* TODO: Check if this is allowed for OCaml < 3.12.1 *)
flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs;
flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs;
flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs;
flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs;
end
(find_packages ());
(* Like -package but for extensions syntax. Morover -syntax is useless
* when linking. *)
List.iter begin fun syntax ->
flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "infer_interface"; "syntax_"^syntax] &
S[A"-syntax"; A syntax];
end (find_syntaxes ());
(* The default "thread" tag is not compatible with ocamlfind.
* Indeed, the default rules add the "threads.cma" or "threads.cmxa"
* options when using this tag. When using the "-linkpkg" option with
* ocamlfind, this module will then be added twice on the command line.
*
* To solve this, one approach is to add the "-thread" option when using
* the "threads" package using the previous plugin.
*)
flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]);
flag ["c"; "pkg_threads"; "compile"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]);
flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]);
flag ["c"; "package(threads)"; "compile"] (S[A "-thread"]);
| _ ->
()
end
module MyOCamlbuildBase = struct
(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
(** Base functions for writing myocamlbuild.ml
@author Sylvain Le Gall
*)
open Ocamlbuild_plugin
module OC = Ocamlbuild_pack.Ocaml_compiler
type dir = string
type file = string
type name = string
type tag = string
type t =
{
lib_ocaml: (name * dir list * string list) list;
lib_c: (name * dir * file list) list;
flags: (tag list * (spec OASISExpr.choices)) list;
(* Replace the 'dir: include' from _tags by a precise interdepends in
* directory.
*)
includes: (dir * dir list) list;
}
(* # 110 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
let env_filename = Pathname.basename BaseEnvLight.default_filename
let dispatch_combine lst =
fun e ->
List.iter
(fun dispatch -> dispatch e)
lst
let tag_libstubs nm =
"use_lib"^nm^"_stubs"
let nm_libstubs nm =
nm^"_stubs"
let dispatch t e =
let env = BaseEnvLight.load ~allow_empty:true () in
match e with
| Before_options ->
let no_trailing_dot s =
if String.length s >= 1 && s.[0] = '.' then
String.sub s 1 ((String.length s) - 1)
else
s
in
List.iter
(fun (opt, var) ->
try
opt := no_trailing_dot (BaseEnvLight.var_get var env)
with Not_found ->
Printf.eprintf "W: Cannot get variable %s\n" var)
[
Options.ext_obj, "ext_obj";
Options.ext_lib, "ext_lib";
Options.ext_dll, "ext_dll";
]
| After_rules ->
(* Declare OCaml libraries *)
List.iter
(function
| nm, [], intf_modules ->
ocaml_lib nm;
let cmis =
List.map (fun m -> (OASISString.uncapitalize_ascii m) ^ ".cmi")
intf_modules in
dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis
| nm, dir :: tl, intf_modules ->
ocaml_lib ~dir:dir (dir^"/"^nm);
List.iter
(fun dir ->
List.iter
(fun str ->
flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir]))
["compile"; "infer_interface"; "doc"])
tl;
let cmis =
List.map (fun m -> dir^"/"^(OASISString.uncapitalize_ascii m)^".cmi")
intf_modules in
dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"]
cmis)
t.lib_ocaml;
(* Declare directories dependencies, replace "include" in _tags. *)
List.iter
(fun (dir, include_dirs) ->
Pathname.define_context dir include_dirs)
t.includes;
(* Declare C libraries *)
List.iter
(fun (lib, dir, headers) ->
(* Handle C part of library *)
flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib]
(S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib";
A("-l"^(nm_libstubs lib))]);
flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib]
(S[A"-cclib"; A("-l"^(nm_libstubs lib))]);
if bool_of_string (BaseEnvLight.var_get "native_dynlink" env) then
flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
(S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
(* When ocaml link something that use the C library, then one
need that file to be up to date.
This holds both for programs and for libraries.
*)
dep ["link"; "ocaml"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
dep ["compile"; "ocaml"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
(* TODO: be more specific about what depends on headers *)
(* Depends on .h files *)
dep ["compile"; "c"]
headers;
(* Setup search path for lib *)
flag ["link"; "ocaml"; "use_"^lib]
(S[A"-I"; P(dir)]);
)
t.lib_c;
(* Add flags *)
List.iter
(fun (tags, cond_specs) ->
let spec = BaseEnvLight.var_choose cond_specs env in
let rec eval_specs =
function
| S lst -> S (List.map eval_specs lst)
| A str -> A (BaseEnvLight.var_expand str env)
| spec -> spec
in
flag tags & (eval_specs spec))
t.flags
| _ ->
()
let dispatch_default conf t =
dispatch_combine
[
dispatch t;
MyOCamlbuildFindlib.dispatch conf;
]
end
# 878 "myocamlbuild.ml"
open Ocamlbuild_plugin;;
let package_default =
{
MyOCamlbuildBase.lib_ocaml =
[
("containers", ["src/core"], []);
("containers_unix", ["src/unix"], []);
("containers_sexp", ["src/sexp"], []);
("containers_data", ["src/data"], []);
("containers_iter", ["src/iter"], []);
("containers_thread", ["src/threads"], []);
("containers_top", ["src/top"], [])
];
lib_c = [];
flags = [];
includes =
[
("src/top",
["src/core"; "src/data"; "src/iter"; "src/sexp"; "src/unix"]);
("src/threads", ["src/core"]);
("qtest",
[
"src/core";
"src/data";
"src/iter";
"src/sexp";
"src/threads";
"src/unix"
]);
("examples", ["src/sexp"]);
("benchs", ["src/core"; "src/data"; "src/iter"; "src/threads"])
]
}
;;
let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
# 919 "myocamlbuild.ml"
(* OASIS_STOP *)
let doc_intro = "doc/intro.txt" ;;
Ocamlbuild_plugin.dispatch dispatch_default;;
dispatch
(MyOCamlbuildBase.dispatch_combine [
begin function
| After_rules ->
(* Documentation index *)
dep ["ocaml"; "doc"; "extension:html"] & [doc_intro] ;
flag ["ocaml"; "doc"; "extension:html"]
& S[A"-t"; A"Containers doc"; A"-intro"; P doc_intro ];
| _ -> ()
end;
dispatch_default
])

49
opam
View file

@ -1,49 +0,0 @@
opam-version: "1.2"
name: "containers"
version: "1.5.2"
author: "Simon Cruanes"
maintainer: "simon.cruanes@inria.fr"
build: [
["./configure"
"--prefix" prefix
"--disable-bench"
"--disable-tests"
"--%{base-unix:enable}%-unix"
"--enable-docs"
]
[make "build"]
]
install: [
[make "install"]
]
build-doc: [ make "doc" ]
build-test: [ make "test" ]
remove: [
["ocamlfind" "remove" "containers"]
]
depends: [
"ocamlfind" {build}
"base-bytes"
"result"
"ocamlbuild" {build}
]
depopts: [
"base-unix"
"base-threads"
"qtest" { test }
]
conflicts: [
"sequence" { < "0.5" }
]
tags: [ "stdlib" "containers" "iterators" "list" "heap" "queue" ]
homepage: "https://github.com/c-cube/ocaml-containers/"
doc: "http://cedeela.fr/~simon/software/containers/"
available: [ocaml-version >= "4.01.0"]
dev-repo: "https://github.com/c-cube/ocaml-containers.git"
bug-reports: "https://github.com/c-cube/ocaml-containers/issues/"
post-messages: [
"Small release with many bugfixes and a few new functions.
A summary hub.com/c-cube/ocaml-containers/issues/84
changelog: https://github.com/c-cube/ocaml-containers/blob/1.3/CHANGELOG.adoc"
]

31
qtest/Makefile Normal file
View file

@ -0,0 +1,31 @@
QTEST_PREAMBLE='open CCFun;;'
DONTTEST=$(wildcard ../src/**/*.cppo.*) $(wildcard ../src/**/*Labels*)
QTESTABLE=$(filter-out $(DONTTEST), \
$(wildcard ../src/core/*.ml) \
$(wildcard ../src/core/*.mli) \
$(wildcard ../src/data/*.ml) \
$(wildcard ../src/data/*.mli) \
$(wildcard ../src/string/*.ml) \
$(wildcard ../src/string/*.mli) \
$(wildcard ../src/unix/*.ml) \
$(wildcard ../src/unix/*.mli) \
$(wildcard ../src/sexp/*.ml) \
$(wildcard ../src/sexp/*.mli) \
$(wildcard ../src/iter/*.ml) \
$(wildcard ../src/iter/*.mli) \
$(wildcard ../src/bigarray/*.ml) \
$(wildcard ../src/bigarray/*.mli) \
$(wildcard ../src/threads/*.ml) \
$(wildcard ../src/threads/*.mli) \
)
qtest-gen:
@if which qtest > /dev/null ; then \
echo "generate qtest"; \
qtest extract --preamble $(QTEST_PREAMBLE) \
-o run_qtest.ml \
$(QTESTABLE) 2> /dev/null ; \
else touch qtest/run_qtest.ml ; \
fi

23
qtest/jbuild Normal file
View file

@ -0,0 +1,23 @@
(rule
((targets (run_qtest.ml))
(deps ((file Makefile)))
(fallback)
;(libraries (qtest qcheck))
(action
(run make qtest-gen))
))
(executable
((name run_qtest)
(libraries (sequence gen qcheck containers containers.unix
containers.data containers.thread containers.iter
containers.sexp))
))
(alias
((name runtest)
(deps (run_qtest.exe))
(action (run ${<}))
))

8915
setup.ml
View file

File diff suppressed because it is too large Load diff

39
src/core/CCArray.ml
View file

@ -176,8 +176,7 @@ let sort_indices cmp a =
*)
let sort_ranking cmp a =
let cmp_int : int -> int -> int = Pervasives.compare in
sort_indices cmp_int (sort_indices cmp a)
sort_indices compare (sort_indices cmp a)
(*$= & ~cmp:(=) ~printer:Q.Print.(array int)
[||] (sort_ranking Pervasives.compare [||])
@ -297,24 +296,24 @@ let _lookup_exn ~cmp k a i j =
| n when n<0 -> _lookup_rec ~cmp k a (i+1) (j-1)
| _ -> raise Not_found (* too high *)
let lookup_exn ?(cmp=Pervasives.compare) k a =
let lookup_exn ~cmp k a =
_lookup_exn ~cmp k a 0 (Array.length a-1)
let lookup ?(cmp=Pervasives.compare) k a =
let lookup ~cmp k a =
try Some (_lookup_exn ~cmp k a 0 (Array.length a-1))
with Not_found -> None
(*$T
lookup 2 [|0;1;2;3;4;5|] = Some 2
lookup 4 [|0;1;2;3;4;5|] = Some 4
lookup 0 [|1;2;3;4;5|] = None
lookup 6 [|1;2;3;4;5|] = None
lookup 3 [| |] = None
lookup 1 [| 1 |] = Some 0
lookup 2 [| 1 |] = None
lookup ~cmp:CCInt.compare 2 [|0;1;2;3;4;5|] = Some 2
lookup ~cmp:CCInt.compare 4 [|0;1;2;3;4;5|] = Some 4
lookup ~cmp:CCInt.compare 0 [|1;2;3;4;5|] = None
lookup ~cmp:CCInt.compare 6 [|1;2;3;4;5|] = None
lookup ~cmp:CCInt.compare 3 [| |] = None
lookup ~cmp:CCInt.compare 1 [| 1 |] = Some 0
lookup ~cmp:CCInt.compare 2 [| 1 |] = None
*)
let bsearch ?(cmp=Pervasives.compare) k a =
let bsearch ~cmp k a =
let rec aux i j =
if i > j
then `Just_after j
@ -333,13 +332,13 @@ let bsearch ?(cmp=Pervasives.compare) k a =
| _ -> aux 0 (n-1)
(*$T bsearch
bsearch 3 [|1; 2; 2; 3; 4; 10|] = `At 3
bsearch 5 [|1; 2; 2; 3; 4; 10|] = `Just_after 4
bsearch 1 [|1; 2; 5; 5; 11; 12|] = `At 0
bsearch 12 [|1; 2; 5; 5; 11; 12|] = `At 5
bsearch 10 [|1; 2; 2; 3; 4; 9|] = `All_lower
bsearch 0 [|1; 2; 2; 3; 4; 9|] = `All_bigger
bsearch 3 [| |] = `Empty
bsearch ~cmp:CCInt.compare 3 [|1; 2; 2; 3; 4; 10|] = `At 3
bsearch ~cmp:CCInt.compare 5 [|1; 2; 2; 3; 4; 10|] = `Just_after 4
bsearch ~cmp:CCInt.compare 1 [|1; 2; 5; 5; 11; 12|] = `At 0
bsearch ~cmp:CCInt.compare 12 [|1; 2; 5; 5; 11; 12|] = `At 5
bsearch ~cmp:CCInt.compare 10 [|1; 2; 2; 3; 4; 9|] = `All_lower
bsearch ~cmp:CCInt.compare 0 [|1; 2; 2; 3; 4; 9|] = `All_bigger
bsearch ~cmp:CCInt.compare 3 [| |] = `Empty
*)
let (>>=) a f = flat_map f a
@ -664,7 +663,7 @@ end
let sort_generic (type arr)(type elt)
(module A : MONO_ARRAY with type t = arr and type elt = elt)
?(cmp=Pervasives.compare) a
~cmp a
=
let module S = SortGeneric(A) in
S.sort ~cmp a

131
src/core/CCArray.mli
View file

@ -28,23 +28,39 @@ val swap : 'a t -> int -> int -> unit
@since 1.4 *)
val get : 'a t -> int -> 'a
(** [get a n] returns the element number [n] of array [a].
The first element has number 0.
The last element has number [length a - 1].
You can also write [a.(n)] instead of [get a n].
Raise [Invalid_argument "index out of bounds"]
if [n] is outside the range 0 to [(length a - 1)]. *)
val get_safe : 'a t -> int -> 'a option
(** [get_safe a i] returns [Some a.(i)] if [i] is a valid index
(** [get_safe a i] returns [Some a.(i)] if [i] is a valid index.
@since 0.18 *)
val set : 'a t -> int -> 'a -> unit
(** [set a n x] modifies array [a] in place, replacing
element number [n] with [x].
You can also write [a.(n) <- x] instead of [set a n x].
Raise [Invalid_argument "index out of bounds"]
if [n] is outside the range 0 to [length a - 1]. *)
val length : _ t -> int
(** Return the length (number of elements) of the given array. *)
val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
(** [fold f x a] computes [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)],
where [n] is the length of the array [a]. *)
val foldi : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a
(** Fold left on array, with index *)
(** Fold left on array, with index. *)
val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a
(** Fold left on array until a stop condition via [('a, `Stop)] is
indicated by the accumulator
indicated by the accumulator.
@since 0.8 *)
val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a t -> 'acc * 'b t
@ -54,20 +70,32 @@ val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a t -> 'acc * 'b t
val scan_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc t
(** [scan_left f acc a] returns the array
[ [|acc; f acc x0; f (f acc a.(0)) a.(1); …|] ]
[ [|acc; f acc x0; f (f acc a.(0)) a.(1); …|] ].
@since 1.2 *)
val iter : ('a -> unit) -> 'a t -> unit
(** [iter f a] applies function [f] in turn to all
the elements of [a]. It is equivalent to
[f a.(0); f a.(1); ...; f a.(length a - 1); ()]. *)
val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** Same as {!Array.iter}, but the
function is applied with the index of the element as first argument,
and the element itself as second argument. *)
val blit : 'a t -> int -> 'a t -> int -> int -> unit
(** [blit from i into j len] copies [len] elements from the first array
to the second. See {!Array.blit}. *)
(** [blit v1 o1 v2 o2 len] copies [len] elements
from array [v1], starting at element number [o1], to array [v2],
starting at element number [o2]. It works correctly even if
[v1] and [v2] are the same array, and the source and
destination chunks overlap.
Raise [Invalid_argument "Array.blit"] if [o1] and [len] do not
designate a valid subarray of [v1], or if [o2] and [len] do not
designate a valid subarray of [v2]. *)
val reverse_in_place : 'a t -> unit
(** Reverse the array in place *)
(** Reverse the array in place. *)
val sorted : ('a -> 'a -> int) -> 'a t -> 'a array
(** [sorted cmp a] makes a copy of [a] and sorts it with [cmp].
@ -80,7 +108,6 @@ val sort_indices : ('a -> 'a -> int) -> 'a t -> int array
In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a].
[sort_indices] yields the inverse permutation of {!sort_ranking}.
@since 1.0 *)
val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array
@ -92,17 +119,16 @@ val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array
[sort_ranking] yields the inverse permutation of {!sort_indices}.
In the absence of duplicate elements in [a], we also have
[lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)]
[lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)].
@since 1.0 *)
val find_map : ('a -> 'b option) -> 'a t -> 'b option
(** [find_map f a] returns [Some y] if there is an element [x] such
that [f x = Some y], else it returns [None]
@since 1.3
*)
that [f x = Some y], else it returns [None].
@since 1.3 *)
val find : ('a -> 'b option) -> 'a t -> 'b option
(** Alias to {!find_map}
(** Alias to {!find_map}.
@deprecated since 1.3 *)
val find_map_i : (int -> 'a -> 'b option) -> 'a t -> 'b option
@ -110,31 +136,33 @@ val find_map_i : (int -> 'a -> 'b option) -> 'a t -> 'b option
@since 1.3 *)
val findi : (int -> 'a -> 'b option) -> 'a t -> 'b option
(** Alias to {!find_map_i}
(** Alias to {!find_map_i}.
@since 0.3.4
@deprecated since 1.3 *)
val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option
(** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
and [p x] holds. Otherwise returns [None]
and [p x] holds. Otherwise returns [None].
@since 0.3.4 *)
val lookup : ?cmp:'a ord -> 'a -> 'a t -> int option
val lookup : cmp:'a ord -> 'a -> 'a t -> int option
(** Lookup the index of some value in a sorted array.
Undefined behavior if the array is not sorted wrt [cmp].
Complexity: [O(log (n))] (dichotomic search).
@return [None] if the key is not present, or
[Some i] ([i] the index of the key) otherwise *)
[Some i] ([i] the index of the key) otherwise. *)
val lookup_exn : ?cmp:'a ord -> 'a -> 'a t -> int
val lookup_exn : cmp:'a ord -> 'a -> 'a t -> int
(** Same as {!lookup}, but
@raise Not_found if the key is not present *)
@raise Not_found if the key is not present. *)
val bsearch : ?cmp:('a -> 'a -> int) -> 'a -> 'a t ->
val bsearch : cmp:('a -> 'a -> int) -> 'a -> 'a t ->
[ `All_lower | `All_bigger | `Just_after of int | `Empty | `At of int ]
(** [bsearch ?cmp x arr] finds the index of the object [x] in the array [arr],
provided [arr] is {b sorted} using [cmp]. If the array is not sorted,
the result is not specified (may raise Invalid_argument).
Complexity: O(log n) where n is the length of the array
Complexity: [O(log n)] where n is the length of the array
(dichotomic search).
@return
@ -142,44 +170,52 @@ val bsearch : ?cmp:('a -> 'a -> int) -> 'a -> 'a t ->
- [`All_lower] if all elements of [arr] are lower than [x]
- [`All_bigger] if all elements of [arr] are bigger than [x]
- [`Just_after i] if [arr.(i) < x < arr.(i+1)]
- [`Empty] if the array is empty
- [`Empty] if the array is empty.
@raise Invalid_argument if the array is found to be unsorted w.r.t [cmp]
@raise Invalid_argument if the array is found to be unsorted w.r.t [cmp].
@since 0.13 *)
val for_all : ('a -> bool) -> 'a t -> bool
(** [for_all p [|a1; ...; an|]] checks if all elements of the array
satisfy the predicate [p]. That is, it returns
[(p a1) && (p a2) && ... && (p an)]. *)
val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
(** Forall on pairs of arrays.
@raise Invalid_argument if they have distinct lengths
allow different types @since 0.20 *)
allow different types.
@since 0.20 *)
val exists : ('a -> bool) -> 'a t -> bool
(** [exists p [|a1; ...; an|]] checks if at least one element of
the array satisfies the predicate [p]. That is, it returns
[(p a1) || (p a2) || ... || (p an)]. *)
val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
(** Exists on pairs of arrays.
@raise Invalid_argument if they have distinct lengths
allow different types @since 0.20 *)
allow different types.
@since 0.20 *)
val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
(** Fold on two arrays stepwise.
@raise Invalid_argument if they have distinct lengths
@raise Invalid_argument if they have distinct lengths.
@since 0.20 *)
val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit
(** Iterate on two arrays stepwise.
@raise Invalid_argument if they have distinct lengths
@raise Invalid_argument if they have distinct lengths.
@since 0.20 *)
val shuffle : 'a t -> unit
(** Shuffle randomly the array, in place *)
(** Shuffle randomly the array, in place. *)
val shuffle_with : Random.State.t -> 'a t -> unit
(** Like shuffle but using a specialized random state *)
(** Like shuffle but using a specialized random state. *)
val random_choose : 'a t -> 'a random_gen
(** Choose an element randomly.
@raise Not_found if the array/slice is empty *)
@raise Not_found if the array/slice is empty. *)
val to_seq : 'a t -> 'a sequence
val to_gen : 'a t -> 'a gen
@ -188,20 +224,25 @@ val to_klist : 'a t -> 'a klist
(** {2 IO} *)
val pp: ?sep:string -> 'a printer -> 'a t printer
(** Print an array of items with printing function *)
(** Print an array of items with printing function. *)
val pp_i: ?sep:string -> (int -> 'a printer) -> 'a t printer
(** Print an array, giving the printing function both index and item *)
(** Print an array, giving the printing function both index and item. *)
val map : ('a -> 'b) -> 'a t -> 'b t
(** [map f a] applies function [f] to all the elements of [a],
and builds an array with the results returned by [f]:
[[| f a.(0); f a.(1); ...; f a.(length a - 1) |]]. *)
val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Map on two arrays stepwise.
@raise Invalid_argument if they have distinct lengths
(** [map2 f a b] applies function [f] to all the elements of [a] and [b],
and builds an array with the results returned by [f]:
[[| f a.(0) b.(0); ...; f a.(length a - 1) b.(length b - 1)|]].
@raise Invalid_argument if they have distinct lengths.
@since 0.20 *)
val rev : 'a t -> 'a t
(** Copy + reverse in place
(** Copy + reverse in place.
@since 0.20 *)
val filter : ('a -> bool) -> 'a t -> 'a t
@ -209,30 +250,30 @@ val filter : ('a -> bool) -> 'a t -> 'a t
the given predicate will be kept. *)
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
(** Map each element into another value, or discard it *)
(** Map each element into another value, or discard it. *)
val flat_map : ('a -> 'b t) -> 'a t -> 'b array
(** Transform each element into an array, then flatten *)
(** Transform each element into an array, then flatten. *)
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
(** Infix version of {!flat_map} *)
(** Infix version of {!flat_map}. *)
val (>>|) : 'a t -> ('a -> 'b) -> 'b t
(** Infix version of {!map}
(** Infix version of {!map}.
@since 0.8 *)
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
(** Infix version of {!map}
(** Infix version of {!map}.
@since 0.8 *)
val except_idx : 'a t -> int -> 'a list
(** Remove given index, obtaining the list of the other elements *)
(** Remove given index, obtaining the list of the other elements. *)
val (--) : int -> int -> int t
(** Range array *)
(** Range array. *)
val (--^) : int -> int -> int t
(** Range array, excluding right bound
(** Range array, excluding right bound.
@since 0.17 *)
val random : 'a random_gen -> 'a t random_gen
@ -254,7 +295,7 @@ end
val sort_generic :
(module MONO_ARRAY with type t = 'arr and type elt = 'elt) ->
?cmp:('elt -> 'elt -> int) -> 'arr -> unit
cmp:('elt -> 'elt -> int) -> 'arr -> unit
(** Sort the array, without allocating (eats stack space though). Performance
might be lower than {!Array.sort}.
@since 0.14 *)

138
src/core/CCArrayLabels.mli
View file

@ -24,35 +24,64 @@ val equal : 'a equal -> 'a t equal
val compare : 'a ord -> 'a t ord
val get : 'a t -> int -> 'a
(** [get a n] returns the element number [n] of array [a].
The first element has number 0.
The last element has number [length a - 1].
You can also write [a.(n)] instead of [get a n].
Raise [Invalid_argument "index out of bounds"]
if [n] is outside the range 0 to [(length a - 1)]. *)
val get_safe : 'a t -> int -> 'a option
(** [get_safe a i] returns [Some a.(i)] if [i] is a valid index
(** [get_safe a i] returns [Some a.(i)] if [i] is a valid index.
@since 0.18 *)
val set : 'a t -> int -> 'a -> unit
(** [set a n x] modifies array [a] in place, replacing
element number [n] with [x].
You can also write [a.(n) <- x] instead of [set a n x].
Raise [Invalid_argument "index out of bounds"]
if [n] is outside the range 0 to [length a - 1]. *)
val length : _ t -> int
(** Return the length (number of elements) of the given array. *)
val fold : f:('a -> 'b -> 'a) -> init:'a -> 'b t -> 'a
(** [fold f x a] computes [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)],
where [n] is the length of the array [a]. *)
val foldi : f:('a -> int -> 'b -> 'a) -> init:'a -> 'b t -> 'a
(** Fold left on array, with index *)
(** Fold left on array, with index. *)
val fold_while : f:('a -> 'b -> 'a * [`Stop | `Continue]) -> init:'a -> 'b t -> 'a
(** Fold left on array until a stop condition via [('a, `Stop)] is
indicated by the accumulator
indicated by the accumulator.
@since 0.8 *)
val iter : f:('a -> unit) -> 'a t -> unit
(** [iter f a] applies function [f] in turn to all
the elements of [a]. It is equivalent to
[f a.(0); f a.(1); ...; f a.(length a - 1); ()]. *)
val iteri : f:(int -> 'a -> unit) -> 'a t -> unit
(** Same as {!Array.iter}, but the
function is applied with the index of the element as first argument,
and the element itself as second argument. *)
val blit : 'a t -> int -> 'a t -> int -> int -> unit
(** [blit from i into j len] copies [len] elements from the first array
to the second. See {!Array.blit}. *)
(** [blit v1 o1 v2 o2 len] copies [len] elements
from array [v1], starting at element number [o1], to array [v2],
starting at element number [o2]. It works correctly even if
[v1] and [v2] are the same array, and the source and
destination chunks overlap.
Raise [Invalid_argument "Array.blit"] if [o1] and [len] do not
designate a valid subarray of [v1], or if [o2] and [len] do not
designate a valid subarray of [v2]. *)
val reverse_in_place : 'a t -> unit
(** Reverse the array in place *)
(** Reverse the array in place. *)
val sorted : f:('a -> 'a -> int) -> 'a t -> 'a array
(** [sorted cmp a] makes a copy of [a] and sorts it with [cmp].
@ -60,26 +89,28 @@ val sorted : f:('a -> 'a -> int) -> 'a t -> 'a array
val sort_indices : f:('a -> 'a -> int) -> 'a t -> int array
(** [sort_indices cmp a] returns a new array [b], with the same length as [a],
such that [b.(i)] is the index of the [i]-th element of [a] in [sort cmp a].
In other words, [map (fun i -> a.(i)) (sort_indices a) = sorted cmp a].
[a] is not modified.
such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a]
appears in [a]. [a] is not modified.
In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a].
[sort_indices] yields the inverse permutation of {!sort_ranking}.
@since 1.0 *)
val sort_ranking : f:('a -> 'a -> int) -> 'a t -> int array
(** [sort_ranking cmp a] returns a new array [b], with the same length as [a],
such that [b.(i)] is the position in [sorted cmp a] of the [i]-th
element of [a].
[a] is not modified.
such that [b.(i)] is the index at which the [i]-the element of [a] appears
in [sorted cmp a]. [a] is not modified.
In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a].
[sort_ranking] yields the inverse permutation of {!sort_indices}.
Without duplicates, we also have
[lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)]
In the absence of duplicate elements in [a], we also have
[lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)].
@since 1.0 *)
val find : f:('a -> 'b option) -> 'a t -> 'b option
(** [find f a] returns [Some y] if there is an element [x] such
that [f x = Some y], else it returns [None] *)
that [f x = Some y], else it returns [None]. *)
val findi : f:(int -> 'a -> 'b option) -> 'a t -> 'b option
(** Like {!find}, but also pass the index to the predicate function.
@ -87,25 +118,27 @@ val findi : f:(int -> 'a -> 'b option) -> 'a t -> 'b option
val find_idx : f:('a -> bool) -> 'a t -> (int * 'a) option
(** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
and [p x] holds. Otherwise returns [None]
and [p x] holds. Otherwise returns [None].
@since 0.3.4 *)
val lookup : ?cmp:'a ord -> key:'a -> 'a t -> int option
val lookup : cmp:'a ord -> key:'a -> 'a t -> int option
(** Lookup the index of some value in a sorted array.
Undefined behavior if the array is not sorted wrt [cmp].
Complexity: [O(log (n))] (dichotomic search).
@return [None] if the key is not present, or
[Some i] ([i] the index of the key) otherwise *)
[Some i] ([i] the index of the key) otherwise. *)
val lookup_exn : ?cmp:'a ord -> key:'a -> 'a t -> int
(** Same as {!lookup_exn}, but
@raise Not_found if the key is not present *)
val lookup_exn : cmp:'a ord -> key:'a -> 'a t -> int
(** Same as {!lookup}, but
@raise Not_found if the key is not present. *)
val bsearch : ?cmp:('a -> 'a -> int) -> key:'a -> 'a t ->
val bsearch : cmp:('a -> 'a -> int) -> key:'a -> 'a t ->
[ `All_lower | `All_bigger | `Just_after of int | `Empty | `At of int ]
(** [bsearch ?cmp key arr] finds the index of the object [key] in the array [arr],
provided [arr] is {b sorted} using [cmp]. If the array is not sorted,
the result is not specified (may raise Invalid_argument).
Complexity: O(log n) where n is the length of the array
Complexity: [O(log n)] where n is the length of the array
(dichotomic search).
@return
@ -113,44 +146,52 @@ val bsearch : ?cmp:('a -> 'a -> int) -> key:'a -> 'a t ->
- [`All_lower] if all elements of [arr] are lower than [key]
- [`All_bigger] if all elements of [arr] are bigger than [key]
- [`Just_after i] if [arr.(i) < key < arr.(i+1)]
- [`Empty] if the array is empty
- [`Empty] if the array is empty.
@raise Invalid_argument if the array is found to be unsorted w.r.t [cmp]
@raise Invalid_argument if the array is found to be unsorted w.r.t [cmp].
@since 0.13 *)
val for_all : f:('a -> bool) -> 'a t -> bool
(** [for_all p [|a1; ...; an|]] checks if all elements of the array
satisfy the predicate [p]. That is, it returns
[(p a1) && (p a2) && ... && (p an)]. *)
val for_all2 : f:('a -> 'b -> bool) -> 'a t -> 'b t -> bool
(** Forall on pairs of arrays.
@raise Invalid_argument if they have distinct lengths
allow different types @since 0.20 *)
allow different types.
@since 0.20 *)
val exists : f:('a -> bool) -> 'a t -> bool
(** [exists p [|a1; ...; an|]] checks if at least one element of
the array satisfies the predicate [p]. That is, it returns
[(p a1) || (p a2) || ... || (p an)]. *)
val exists2 : f:('a -> 'b -> bool) -> 'a t -> 'b t -> bool
(** Exists on pairs of arrays.
@raise Invalid_argument if they have distinct lengths
allow different types @since 0.20 *)
allow different types.
@since 0.20 *)
val fold2 : f:('acc -> 'a -> 'b -> 'acc) -> init:'acc -> 'a t -> 'b t -> 'acc
(** Fold on two arrays stepwise.
@raise Invalid_argument if they have distinct lengths
@raise Invalid_argument if they have distinct lengths.
@since 0.20 *)
val iter2 : f:('a -> 'b -> unit) -> 'a t -> 'b t -> unit
(** Iterate on two arrays stepwise.
@raise Invalid_argument if they have distinct lengths
@raise Invalid_argument if they have distinct lengths.
@since 0.20 *)
val shuffle : 'a t -> unit
(** Shuffle randomly the array, in place *)
(** Shuffle randomly the array, in place. *)
val shuffle_with : Random.State.t -> 'a t -> unit
(** Like shuffle but using a specialized random state *)
(** Like shuffle but using a specialized random state. *)
val random_choose : 'a t -> 'a random_gen
(** Choose an element randomly.
@raise Not_found if the array/slice is empty *)
@raise Not_found if the array/slice is empty. *)
val to_seq : 'a t -> 'a sequence
val to_gen : 'a t -> 'a gen
@ -159,20 +200,25 @@ val to_klist : 'a t -> 'a klist
(** {2 IO} *)
val pp: ?sep:string -> 'a printer -> 'a t printer
(** Print an array of items with printing function *)
(** Print an array of items with printing function. *)
val pp_i: ?sep:string -> (int -> 'a printer) -> 'a t printer
(** Print an array, giving the printing function both index and item *)
(** Print an array, giving the printing function both index and item. *)
val map : f:('a -> 'b) -> 'a t -> 'b t
(** [map f a] applies function [f] to all the elements of [a],
and builds an array with the results returned by [f]:
[[| f a.(0); f a.(1); ...; f a.(length a - 1) |]]. *)
val map2 : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Map on two arrays stepwise.
@raise Invalid_argument if they have distinct lengths
(** [map2 f a b] applies function [f] to all the elements of [a] and [b],
and builds an array with the results returned by [f]:
[[| f a.(0) b.(0); ...; f a.(length a - 1) b.(length b - 1)|]].
@raise Invalid_argument if they have distinct lengths.
@since 0.20 *)
val rev : 'a t -> 'a t
(** Copy + reverse in place
(** Copy + reverse in place.
@since 0.20 *)
val filter : f:('a -> bool) -> 'a t -> 'a t
@ -180,30 +226,30 @@ val filter : f:('a -> bool) -> 'a t -> 'a t
the given predicate will be kept. *)
val filter_map : f:('a -> 'b option) -> 'a t -> 'b t
(** Map each element into another value, or discard it *)
(** Map each element into another value, or discard it. *)
val flat_map : f:('a -> 'b t) -> 'a t -> 'b array
(** Transform each element into an array, then flatten *)
(** Transform each element into an array, then flatten. *)
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
(** Infix version of {!flat_map} *)
(** Infix version of {!flat_map}. *)
val (>>|) : 'a t -> ('a -> 'b) -> 'b t
(** Infix version of {!map}
(** Infix version of {!map}.
@since 0.8 *)
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
(** Infix version of {!map}
(** Infix version of {!map}.
@since 0.8 *)
val except_idx : 'a t -> int -> 'a list
(** Remove given index, obtaining the list of the other elements *)
(** Remove given index, obtaining the list of the other elements. *)
val (--) : int -> int -> int t
(** Range array *)
(** Range array. *)
val (--^) : int -> int -> int t
(** Range array, excluding right bound
(** Range array, excluding right bound.
@since 0.17 *)
val random : 'a random_gen -> 'a t random_gen
@ -225,7 +271,7 @@ end
val sort_generic :
(module MONO_ARRAY with type t = 'arr and type elt = 'elt) ->
?cmp:('elt -> 'elt -> int) -> 'arr -> unit
cmp:('elt -> 'elt -> int) -> 'arr -> unit
(** Sort the array, without allocating (eats stack space though). Performance
might be lower than {!Array.sort}.
@since 0.14 *)

12
src/core/CCArray_slice.ml
View file

@ -85,6 +85,7 @@ let rec _compare cmp a1 i1 j1 a2 i2 j2 =
let equal eq a b =
length a = length b && _equal eq a.arr a.i a.j b.arr b.i b.j
let compare_int (a : int) b = Pervasives.compare a b
let compare cmp a b =
_compare cmp a.arr a.i a.j b.arr b.i b.j
@ -292,9 +293,8 @@ let sorted cmp a = _sorted cmp a.arr a.i a.j
let sort_ranking cmp a =
let idx = _sort_indices cmp a.arr a.i a.j in
let cmp_int : int -> int -> int = Pervasives.compare in
let sort_indices cmp a = _sort_indices cmp a 0 (Array.length a) in
sort_indices cmp_int idx
sort_indices compare_int idx
(*$= & ~cmp:(=) ~printer:Q.Print.(array int)
[||] \
@ -345,18 +345,18 @@ let find_idx p a =
(Some (1,"c")) (find_idx ((=) "c") (make [| "a"; "b"; "c" |] 1 2))
*)
let lookup_exn ?(cmp=Pervasives.compare) k a =
let lookup_exn ~cmp k a =
_lookup_exn ~cmp k a.arr a.i (a.j-1) - a.i
let lookup ?(cmp=Pervasives.compare) k a =
let lookup ~cmp k a =
try Some (_lookup_exn ~cmp k a.arr a.i (a.j-1) - a.i)
with Not_found -> None
(*$=
(Some 1) (lookup "c" (make [| "a"; "b"; "c" |] 1 2))
(Some 1) (lookup ~cmp:CCString.compare "c" (make [| "a"; "b"; "c" |] 1 2))
*)
let bsearch ?(cmp=Pervasives.compare) k a =
let bsearch ~cmp k a =
match bsearch_ ~cmp k a.arr a.i (a.j - 1) with
| `At m -> `At (m - a.i)
| `Just_after m -> `Just_after (m - a.i)

110
src/core/CCArray_slice.mli
View file

@ -12,7 +12,7 @@ type 'a random_gen = Random.State.t -> 'a
type 'a printer = Format.formatter -> 'a -> unit
type 'a t
(** Array slice, containing elements of type ['a] *)
(** Array slice, containing elements of type ['a]. *)
val empty : 'a t
@ -21,64 +21,93 @@ val equal : 'a equal -> 'a t equal
val compare : 'a ord -> 'a t ord
val get : 'a t -> int -> 'a
(** [get a n] returns the element number [n] of array [a].
The first element has number 0.
The last element has number [length a - 1].
You can also write [a.(n)] instead of [get a n].
Raise [Invalid_argument "index out of bounds"]
if [n] is outside the range 0 to [(length a - 1)]. *)
val get_safe : 'a t -> int -> 'a option
(** [get_safe a i] returns [Some a.(i)] if [i] is a valid index
(** [get_safe a i] returns [Some a.(i)] if [i] is a valid index.
@since 0.18 *)
val make : 'a array -> int -> len:int -> 'a t
(** Create a slice from given offset and length..
@raise Invalid_argument if the slice isn't valid *)
(** Create a slice from given offset and length.
@raise Invalid_argument if the slice isn't valid. *)
val of_slice : ('a array * int * int) -> 'a t
(** Make a sub-array from a triple [(arr, i, len)] where [arr] is the array,
[i] the offset in [arr], and [len] the number of elements of the slice.
@raise Invalid_argument if the slice isn't valid (See {!make}) *)
@raise Invalid_argument if the slice isn't valid (See {!make}). *)
val to_slice : 'a t -> ('a array * int * int)
(** Convert into a triple [(arr, i, len)] where [len] is the length of
the subarray of [arr] starting at offset [i] *)
the sub-array of [arr] starting at offset [i]. *)
val to_list : 'a t -> 'a list
(** Convert directly to a list
(** Convert directly to a list.
@since 1.0 *)
val full : 'a array -> 'a t
(** Slice that covers the full array *)
(** Slice that covers the full array. *)
val underlying : 'a t -> 'a array
(** Underlying array (shared). Modifying this array will modify the slice *)
(** Underlying array (shared). Modifying this array will modify the slice. *)
val copy : 'a t -> 'a array
(** Copy into a new array *)
(** Copy into a new array. *)
val sub : 'a t -> int -> int -> 'a t
(** Sub-slice *)
(** Sub-slice. *)
val set : 'a t -> int -> 'a -> unit
(** [set a n x] modifies array [a] in place, replacing
element number [n] with [x].
You can also write [a.(n) <- x] instead of [set a n x].
Raise [Invalid_argument "index out of bounds"]
if [n] is outside the range 0 to [length a - 1]. *)
val length : _ t -> int
(** Return the length (number of elements) of the given array. *)
val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
(** [fold f x a] computes [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)],
where [n] is the length of the array [a]. *)
val foldi : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a
(** Fold left on array, with index *)
(** Fold left on array, with index. *)
val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a
(** Fold left on array until a stop condition via [('a, `Stop)] is
indicated by the accumulator
indicated by the accumulator.
@since 0.8 *)
val iter : ('a -> unit) -> 'a t -> unit
(** [iter f a] applies function [f] in turn to all
the elements of [a]. It is equivalent to
[f a.(0); f a.(1); ...; f a.(length a - 1); ()]. *)
val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** Same as {!Array.iter}, but the
function is applied with the index of the element as first argument,
and the element itself as second argument. *)
val blit : 'a t -> int -> 'a t -> int -> int -> unit
(** [blit from i into j len] copies [len] elements from the first array
to the second. See {!Array.blit}. *)
(** [blit v1 o1 v2 o2 len] copies [len] elements
from array [v1], starting at element number [o1], to array [v2],
starting at element number [o2]. It works correctly even if
[v1] and [v2] are the same array, and the source and
destination chunks overlap.
Raise [Invalid_argument "Array.blit"] if [o1] and [len] do not
designate a valid subarray of [v1], or if [o2] and [len] do not
designate a valid subarray of [v2]. *)
val reverse_in_place : 'a t -> unit
(** Reverse the array in place *)
(** Reverse the array in place. *)
val sorted : ('a -> 'a -> int) -> 'a t -> 'a array
(** [sorted cmp a] makes a copy of [a] and sorts it with [cmp].
@ -86,12 +115,11 @@ val sorted : ('a -> 'a -> int) -> 'a t -> 'a array
val sort_indices : ('a -> 'a -> int) -> 'a t -> int array
(** [sort_indices cmp a] returns a new array [b], with the same length as [a],
such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a]
such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a]
appears in [a]. [a] is not modified.
In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a].
In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a].
[sort_indices] yields the inverse permutation of {!sort_ranking}.
@since 1.0 *)
val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array
@ -99,16 +127,16 @@ val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array
such that [b.(i)] is the index at which the [i]-the element of [a] appears
in [sorted cmp a]. [a] is not modified.
In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a].
In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a].
[sort_ranking] yields the inverse permutation of {!sort_indices}.
In the absence of duplicate elements in [a], we also have
[lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)]
[lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)].
@since 1.0 *)
val find : ('a -> 'b option) -> 'a t -> 'b option
(** [find f a] returns [Some y] if there is an element [x] such
that [f x = Some y], else it returns [None] *)
that [f x = Some y], else it returns [None]. *)
val findi : (int -> 'a -> 'b option) -> 'a t -> 'b option
(** Like {!find}, but also pass the index to the predicate function.
@ -116,19 +144,19 @@ val findi : (int -> 'a -> 'b option) -> 'a t -> 'b option
val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option
(** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
and [p x] holds. Otherwise returns [None]
and [p x] holds. Otherwise returns [None].
@since 0.3.4 *)
val lookup : ?cmp:'a ord -> 'a -> 'a t -> int option
val lookup : cmp:'a ord -> 'a -> 'a t -> int option
(** Lookup the index of some value in a sorted array.
@return [None] if the key is not present, or
[Some i] ([i] the index of the key) otherwise *)
[Some i] ([i] the index of the key) otherwise. *)
val lookup_exn : ?cmp:'a ord -> 'a -> 'a t -> int
val lookup_exn : cmp:'a ord -> 'a -> 'a t -> int
(** Same as {!lookup}, but
@raise Not_found if the key is not present *)
@raise Not_found if the key is not present. *)
val bsearch : ?cmp:('a -> 'a -> int) -> 'a -> 'a t ->
val bsearch : cmp:('a -> 'a -> int) -> 'a -> 'a t ->
[ `All_lower | `All_bigger | `Just_after of int | `Empty | `At of int ]
(** [bsearch ?cmp x arr] finds the index of the object [x] in the array [arr],
provided [arr] is {b sorted} using [cmp]. If the array is not sorted,
@ -148,38 +176,46 @@ val bsearch : ?cmp:('a -> 'a -> int) -> 'a -> 'a t ->
@since 0.13 *)
val for_all : ('a -> bool) -> 'a t -> bool
(** [for_all p [|a1; ...; an|]] checks if all elements of the array
satisfy the predicate [p]. That is, it returns
[(p a1) && (p a2) && ... && (p an)]. *)
val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
(** Forall on pairs of arrays.
@raise Invalid_argument if they have distinct lengths
allow different types @since 0.20 *)
allow different types.
@since 0.20 *)
val exists : ('a -> bool) -> 'a t -> bool
(** [exists p [|a1; ...; an|]] checks if at least one element of
the array satisfies the predicate [p]. That is, it returns
[(p a1) || (p a2) || ... || (p an)]. *)
val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
(** Exists on pairs of arrays.
@raise Invalid_argument if they have distinct lengths
allow different types @since 0.20 *)
allow different types.
@since 0.20 *)
val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
(** Fold on two arrays stepwise.
@raise Invalid_argument if they have distinct lengths
@raise Invalid_argument if they have distinct lengths.
@since 0.20 *)
val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit
(** Iterate on two arrays stepwise.
@raise Invalid_argument if they have distinct lengths
@raise Invalid_argument if they have distinct lengths.
@since 0.20 *)
val shuffle : 'a t -> unit
(** Shuffle randomly the array, in place *)
(** Shuffle randomly the array, in place. *)
val shuffle_with : Random.State.t -> 'a t -> unit
(** Like shuffle but using a specialized random state *)
(** Like shuffle but using a specialized random state. *)
val random_choose : 'a t -> 'a random_gen
(** Choose an element randomly.
@raise Not_found if the array/slice is empty *)
@raise Not_found if the array/slice is empty. *)
val to_seq : 'a t -> 'a sequence
val to_gen : 'a t -> 'a gen
@ -188,7 +224,7 @@ val to_klist : 'a t -> 'a klist
(** {2 IO} *)
val pp: ?sep:string -> 'a printer -> 'a t printer
(** Print an array of items with printing function *)
(** Print an array of items with printing function. *)
val pp_i: ?sep:string -> (int -> 'a printer) -> 'a t printer
(** Print an array, giving the printing function both index and item *)
(** Print an array, giving the printing function both index and item. *)

2
src/core/CCBool.ml
View file

@ -3,7 +3,7 @@
type t = bool
let equal (a:bool) b = a=b
let equal (a:bool) b = Pervasives.(=) a b
let compare (a:bool) b = Pervasives.compare a b

16
src/core/CCChar.ml
View file

@ -6,7 +6,7 @@
include Char
let equal (a:char) b = a=b
let equal (a:char) b = Pervasives.(=) a b
let pp = Buffer.add_char
let print = Format.pp_print_char
@ -15,12 +15,10 @@ let of_int_exn = Char.chr
let of_int c = try Some (of_int_exn c) with _ -> None
let to_int = Char.code
let lowercase_ascii c =
if c >= 'A' && c <= 'Z'
then Char.unsafe_chr (Char. code c + 32)
else c
let lowercase_ascii = function
| 'A'..'Z' as c -> Char.unsafe_chr (Char.code c + 32)
| c -> c
let uppercase_ascii c =
if c >= 'a' && c <= 'z'
then Char.unsafe_chr (Char.code c - 32)
else c
let uppercase_ascii = function
| 'a'..'z' as c -> Char.unsafe_chr (Char.code c - 32)
| c -> c

22
src/core/CCChar.mli
View file

@ -7,27 +7,37 @@
include module type of Char
val equal : t -> t -> bool
(** The equal function for chars. *)
val compare : t -> t -> int
(** The comparison function for characters, with the same specification as
{!Pervasives.compare}. Along with the type [t], this function [compare]
allows the module [Char] to be passed as argument to the functors
{!Set.Make} and {!Map.Make}. *)
val lowercase_ascii : t -> t
(** See {!Char}
(** Convert the given character to its equivalent lowercase character,
using the US-ASCII character set.
@since 0.20 *)
val uppercase_ascii : t -> t
(** See {!Char}
(** Convert the given character to its equivalent uppercase character,
using the US-ASCII character set.
@since 0.20 *)
val of_int_exn : int -> t
(** Alias to {!Char.chr}
@raise Invalid_argument if the int is not within [0,...,255]
(** Alias to {!Char.chr}.
Return the character with the given ASCII code.
@raise Invalid_argument if the int is not within [0,...,255].
@since 1.0 *)
val of_int : int -> t option
(** Safe version of {!of_int}
(** Safe version of {!of_int_exn}.
@since 1.0 *)
val to_int : t -> int
(** Alias to {!Char.code}
(** Alias to {!Char.code}.
Return the ASCII code of the argument.
@since 1.0 *)
val pp : Buffer.t -> t -> unit

9
src/core/CCEqual.ml
View file

@ -5,12 +5,13 @@
type 'a t = 'a -> 'a -> bool
let poly = (=)
let poly = Pervasives.(=)
let physical = Pervasives.(==)
let int : int t = (=)
let string : string t = (=)
let bool : bool t = (=)
let float : float t = (=)
let string : string t = Pervasives.(=)
let bool : bool t = Pervasives.(=)
let float : float t = Pervasives.(=)
let unit () () = true
let rec list f l1 l2 = match l1, l2 with

4
src/core/CCEqual.mli
View file

@ -11,6 +11,10 @@ type 'a t = 'a -> 'a -> bool
val poly : 'a t
(** Standard polymorphic equality *)
val physical : 'a t
(** Standard physical equality
@since NEXT_RELEASE *)
val int : int t
val string : string t
val bool : bool t

20
src/core/CCFloat.ml
View file

@ -9,6 +9,16 @@ type fpclass = Pervasives.fpclass =
| FP_infinite
| FP_nan
module Infix = struct
let (=) = Pervasives.(=)
let (<>) = Pervasives.(<>)
let (<) = Pervasives.(<)
let (>) = Pervasives.(>)
let (<=) = Pervasives.(<=)
let (>=) = Pervasives.(>=)
end
include Infix
let nan = Pervasives.nan
let infinity = Pervasives.infinity
@ -84,13 +94,3 @@ let random_range i j st = i +. random (j-.i) st
let equal_precision ~epsilon a b = abs_float (a-.b) < epsilon
let classify = Pervasives.classify_float
module Infix = struct
let (=) = Pervasives.(=)
let (<>) = Pervasives.(<>)
let (<) = Pervasives.(<)
let (>) = Pervasives.(>)
let (<=) = Pervasives.(<=)
let (>=) = Pervasives.(>=)
end
include Infix

9
src/core/CCFormat.mli
View file

@ -7,11 +7,10 @@
type 'a sequence = ('a -> unit) -> unit
include module type of Format
with type formatter = Format.formatter
and type formatter_out_functions = Format.formatter_out_functions
and type formatter_tag_functions = Format.formatter_tag_functions
(* include Format, and alias all its types.
see https://discuss.ocaml.org/t/extend-existing-module/1389/4
*)
include module type of struct include Format end
type t = Format.formatter
type 'a printer = t -> 'a -> unit

11
src/core/CCHashtbl.ml
View file

@ -124,7 +124,7 @@ module Poly = struct
()
*)
let print pp_k pp_v fmt m =
let pp pp_k pp_v fmt m =
Format.fprintf fmt "@[<hov2>tbl {@,";
let first = ref true in
Hashtbl.iter
@ -232,9 +232,10 @@ module type S = sig
to [tbl] and [v] is returned.
@since 1.0 *)
val print : key printer -> 'a printer -> 'a t printer
(** Printer for tables
@since 0.13 *)
val pp : key printer -> 'a printer -> 'a t printer
(** Printer for table
@since 0.13
Renamed from [print] @since NEXT_RELEASE *)
end
(*$inject
@ -344,7 +345,7 @@ module Make(X : Hashtbl.HashedType)
List.iter (fun (k,v) -> add tbl k v) l;
tbl
let print pp_k pp_v fmt m =
let pp pp_k pp_v fmt m =
Format.fprintf fmt "@[<hov2>tbl {@,";
let first = ref true in
iter

10
src/core/CCHashtbl.mli
View file

@ -102,9 +102,10 @@ module Poly : sig
to [tbl] and [v] is returned.
@since 1.0 *)
val print : 'a printer -> 'b printer -> ('a, 'b) Hashtbl.t printer
val pp : 'a printer -> 'b printer -> ('a, 'b) Hashtbl.t printer
(** Printer for table
@since 0.13 *)
@since 0.13
Renamed from [print] @since NEXT_RELEASE *)
end
include module type of Poly
@ -201,9 +202,10 @@ module type S = sig
to [tbl] and [v] is returned.
@since 1.0 *)
val print : key printer -> 'a printer -> 'a t printer
val pp : key printer -> 'a printer -> 'a t printer
(** Printer for tables
@since 0.13 *)
@since 0.13
Renamed from {!print} @since NEXT_RELEASE *)
end
module Make(X : Hashtbl.HashedType) :

18
src/core/CCInt.ml
View file

@ -5,7 +5,7 @@ type t = int
let equal (a:int) b = a=b
let compare (a:int) b = Pervasives.compare a b
let compare a b = compare a b
let hash i = i land max_int
@ -75,9 +75,11 @@ let floor_div a n =
(fun (n, m) -> floor_div n (-m) = int_of_float @@ floor (float n /. float (-m)))
*)
let bool_neq (a : bool) b = Pervasives.(<>) a b
let rem a n =
let y = a mod n in
if (y < 0) <> (n < 0) && y <> 0 then
if bool_neq (y < 0) (n < 0) && y <> 0 then
y + n
else
y
@ -245,12 +247,12 @@ let range' i j yield =
module Infix = struct
let (=) = Pervasives.(=)
let (<>) = Pervasives.(<>)
let (<) = Pervasives.(<)
let (>) = Pervasives.(>)
let (<=) = Pervasives.(<=)
let (>=) = Pervasives.(>=)
let (=) = (=)
let (<>) = (<>)
let (<) = (<)
let (>) = (>)
let (<=) = (<=)
let (>=) = (>=)
let (--) = range
let (--^) = range'
end

2
src/core/CCInt64.ml
View file

@ -28,7 +28,7 @@ let (lsr) = shift_right_logical
let (asr) = shift_right
let equal (x:t) y = x=y
let equal (x:t) y = Pervasives.(=) x y
let hash x = Pervasives.abs (to_int x)

94
src/core/CCInt64.mli
View file

@ -9,79 +9,159 @@
type t = int64
val (+) : t -> t -> t
(** Addition. *)
val (-) : t -> t -> t
(** Subtraction. *)
val (~-) : t -> t
(** Unary negation. *)
val ( * ) : t -> t -> t
(** Multiplication. *)
val (/) : t -> t -> t
(** Integer division. Raise [Division_by_zero] if the second
argument is zero. This division rounds the real quotient of
its arguments towards zero, as specified for {!Pervasives.(/)}. *)
val (mod) : t -> t -> t
(** Integer remainder.
If [y = 0], [x mod y] raises [Division_by_zero]. *)
val abs : t -> t
(** Return the absolute value of its argument. *)
val max_int : t
(** The greatest representable 64-bit integer, 2{^63} - 1. *)
val min_int : t
(** The smallest representable 64-bit integer, -2{^63}. *)
val (land) : t -> t -> t
(** Bitwise logical and. *)
val (lor) : t -> t -> t
(** Bitwise logical or. *)
val (lxor) : t -> t -> t
(** Bitwise logical exclusive or. *)
val lnot : t -> t
(** Bitwise logical negation. *)
val (lsl) : t -> int -> t
(** [ x lsl y] shifts [x] to the left by [y] bits.
The result is unspecified if [y < 0] or [y >= 64]. *)
val (lsr) : t -> int -> t
(** [x lsr y] shifts [x] to the right by [y] bits.
This is a logical shift: zeroes are inserted in the vacated bits
regardless of the sign of [x].
The result is unspecified if [y < 0] or [y >= 64]. *)
val (asr) : t -> int -> t
(** [x asr y] shifts [x] to the right by [y] bits.
This is an arithmetic shift: the sign bit of [x] is replicated
and inserted in the vacated bits.
The result is unspecified if [y < 0] or [y >= 64]. *)
val equal : t -> t -> bool
(** The equal function for int64s.
Same as {!Pervasives.(=) x y)}. *)
val compare : t -> t -> int
(** The comparison function for 64-bit integers, with the same specification as
{!Pervasives.compare}. Along with the type [t], this function [compare]
allows the module [CCInt64] to be passed as argument to the functors
{!Set.Make} and {!Map.Make}. *)
val hash : t -> int
(** Same as {!Pervasives.abs (to_int x)}. *)
(** {2 Conversion} *)
val to_int : t -> int
(** Convert the given 64-bit integer (type [int64]) to an
integer (type [int]). On 64-bit platforms, the 64-bit integer
is taken modulo 2{^63}, i.e. the high-order bit is lost
during the conversion. On 32-bit platforms, the 64-bit integer
is taken modulo 2{^31}, i.e. the top 33 bits are lost
during the conversion. *)
val of_int : int -> t option
(** Safe version of {!of_int_exn}. *)
val of_int_exn : int -> t
(** Alias to {!Int64.of_int}
@raise Failure in case of failure *)
(** Alias to {!Int64.of_int}.
Convert the given integer (type [int]) to a 64-bit integer
(type [int64]).
@raise Failure in case of failure. *)
val to_int32 : t -> int32
(** Convert the given 64-bit integer (type [int64]) to a
32-bit integer (type [int32]). The 64-bit integer
is taken modulo 2{^32}, i.e. the top 32 bits are lost
during the conversion. *)
val of_int32 : int32 -> t option
(** Safe version of {!of_int32_exn}. *)
val of_int32_exn : int32 -> t
(** Alias to {!Int64.of_int32}
@raise Failure in case of failure *)
Convert the given 32-bit integer (type [int32])
to a 64-bit integer (type [int64]).
@raise Failure in case of failure. *)
val to_nativeint : t -> nativeint
(** Convert the given 64-bit integer (type [int64]) to a
native integer. On 32-bit platforms, the 64-bit integer
is taken modulo 2{^32}. On 64-bit platforms,
the conversion is exact. *)
val of_nativeint : nativeint -> t option
(** Safe version of {!of_nativeint_exn}. *)
val of_nativeint_exn : nativeint -> t
(** Alias to {!Int64.of_nativeint}
@raise Failure in case of failure *)
(** Alias to {!Int64.of_nativeint}.
Convert the given native integer (type [nativeint])
to a 64-bit integer (type [int64]).
@raise Failure in case of failure. *)
val to_float : t -> float
(** Convert the given 64-bit integer to a floating-point number. *)
val of_float : float -> t option
(** Safe version of {!of_float_exn}. *)
val of_float_exn : float -> t
(** Alias to {!Int64.of_float}
@raise Failure in case of failure *)
(** Alias to {!Int64.of_float}.
Convert the given floating-point number to a 64-bit integer,
discarding the fractional part (truncate towards 0).
The result of the conversion is undefined if, after truncation,
the number is outside the range \[{!CCInt64.min_int}, {!CCInt64.max_int}\].
@raise Failure in case of failure. *)
val to_string : t -> string
(** Return the string representation of its argument, in decimal. *)
val of_string : string -> t option
(** Safe version of {!of_string_exn}. *)
val of_string_exn : string -> t
(** Alias to {!Int64.of_string}.
Convert the given string to a 64-bit integer.
The string is read in decimal (by default, or if the string
begins with [0u]) or in hexadecimal, octal or binary if the
string begins with [0x], [0o] or [0b] respectively.
The [0u] prefix reads the input as an unsigned integer in the range
[[0, 2*CCInt64.max_int+1]]. If the input exceeds {!CCInt64.max_int}
it is converted to the signed integer
[CCInt64.min_int + input - CCInt64.max_int - 1].
The [_] (underscore) character can appear anywhere in the string
and is ignored.
Raise [Failure "Int64.of_string"] if the given string is not
a valid representation of an integer, or if the integer represented
exceeds the range of integers representable in type [int64]. *)

164
src/core/CCList.ml
View file

@ -1,7 +1,7 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 complements to list} *)
(** {1 Complements to list} *)
(*$inject
let lsort l = List.sort Pervasives.compare l
@ -557,7 +557,7 @@ let map_product_l f l =
cmp_lii_unord (cartesian_product l) (map_product_l CCFun.id l))
*)
let sorted_merge ?(cmp=Pervasives.compare) l1 l2 =
let sorted_merge ~cmp l1 l2 =
let rec recurse cmp acc l1 l2 = match l1,l2 with
| [], _ -> List.rev_append acc l2
| _, [] -> List.rev_append acc l1
@ -570,17 +570,17 @@ let sorted_merge ?(cmp=Pervasives.compare) l1 l2 =
recurse cmp [] l1 l2
(*$T
List.sort Pervasives.compare ([(( * )2); ((+)1)] <*> [10;100]) \
= [11; 20; 101; 200]
sorted_merge [1;1;2] [1;2;3] = [1;1;1;2;2;3]
equal CCInt.equal (List.sort CCInt.compare ([(( * )2); ((+)1)] <*> [10;100])) \
[11; 20; 101; 200]
equal CCInt.equal (sorted_merge ~cmp:CCInt.compare [1;1;2] [1;2;3]) [1;1;1;2;2;3]
*)
(*$Q
Q.(pair (list int) (list int)) (fun (l1,l2) -> \
List.length (sorted_merge l1 l2) = List.length l1 + List.length l2)
List.length (sorted_merge ~cmp:CCInt.compare l1 l2) = List.length l1 + List.length l2)
*)
let sort_uniq (type elt) ?(cmp=Pervasives.compare) l =
let sort_uniq (type elt) ~cmp l =
let module S = Set.Make(struct
type t = elt
let compare = cmp
@ -589,12 +589,12 @@ let sort_uniq (type elt) ?(cmp=Pervasives.compare) l =
S.elements set
(*$T
sort_uniq [1;2;5;3;6;1;4;2;3] = [1;2;3;4;5;6]
sort_uniq [] = []
sort_uniq [10;10;10;10;1;10] = [1;10]
sort_uniq ~cmp:CCInt.compare [1;2;5;3;6;1;4;2;3] = [1;2;3;4;5;6]
sort_uniq ~cmp:CCInt.compare [] = []
sort_uniq ~cmp:CCInt.compare [10;10;10;10;1;10] = [1;10]
*)
let is_sorted ?(cmp=Pervasives.compare) l =
let is_sorted ~cmp l =
let rec aux cmp = function
| [] | [_] -> true
| x :: ((y :: _) as tail) -> cmp x y <= 0 && aux cmp tail
@ -603,10 +603,10 @@ let is_sorted ?(cmp=Pervasives.compare) l =
(*$Q
Q.(list small_int) (fun l -> \
is_sorted (List.sort Pervasives.compare l))
is_sorted ~cmp:CCInt.compare (List.sort Pervasives.compare l))
*)
let sorted_insert ?(cmp=Pervasives.compare) ?(uniq=false) x l =
let sorted_insert ~cmp ?(uniq=false) x l =
let rec aux cmp uniq x left l = match l with
| [] -> List.rev_append left [x]
| y :: tail ->
@ -622,20 +622,20 @@ let sorted_insert ?(cmp=Pervasives.compare) ?(uniq=false) x l =
(*$Q
Q.(pair small_int (list small_int)) (fun (x,l) -> \
let l = List.sort Pervasives.compare l in \
is_sorted (sorted_insert ~uniq:true x l))
is_sorted ~cmp:CCInt.compare (sorted_insert ~cmp:CCInt.compare ~uniq:true x l))
Q.(pair small_int (list small_int)) (fun (x,l) -> \
let l = List.sort Pervasives.compare l in \
is_sorted (sorted_insert ~uniq:false x l))
is_sorted ~cmp:CCInt.compare (sorted_insert ~cmp:CCInt.compare ~uniq:false x l))
Q.(pair small_int (list small_int)) (fun (x,l) -> \
let l = List.sort Pervasives.compare l in \
let l' = sorted_insert ~uniq:false x l in \
let l' = sorted_insert ~cmp:CCInt.compare ~uniq:false x l in \
List.length l' = List.length l + 1)
Q.(pair small_int (list small_int)) (fun (x,l) -> \
let l = List.sort Pervasives.compare l in \
List.mem x (sorted_insert x l))
List.mem x (sorted_insert ~cmp:CCInt.compare x l))
*)
let uniq_succ ?(eq=(=)) l =
let uniq_succ ~eq l =
let rec f acc l = match l with
| [] -> List.rev acc
| [x] -> List.rev (x::acc)
@ -645,10 +645,10 @@ let uniq_succ ?(eq=(=)) l =
f [] l
(*$T
uniq_succ [1;1;2;3;1;6;6;4;6;1] = [1;2;3;1;6;4;6;1]
uniq_succ ~eq:CCInt.equal [1;1;2;3;1;6;6;4;6;1] = [1;2;3;1;6;4;6;1]
*)
let group_succ ?(eq=(=)) l =
let group_succ ~eq l =
let rec f ~eq acc cur l = match cur, l with
| [], [] -> List.rev acc
| _::_, [] -> List.rev (List.rev cur :: acc)
@ -659,15 +659,15 @@ let group_succ ?(eq=(=)) l =
f ~eq [] [] l
(*$T
group_succ [1;2;3;1;1;2;4] = [[1]; [2]; [3]; [1;1]; [2]; [4]]
group_succ [] = []
group_succ [1;1;1] = [[1;1;1]]
group_succ [1;2;2;2] = [[1]; [2;2;2]]
group_succ ~eq:CCInt.equal [1;2;3;1;1;2;4] = [[1]; [2]; [3]; [1;1]; [2]; [4]]
group_succ ~eq:CCInt.equal [] = []
group_succ ~eq:CCInt.equal [1;1;1] = [[1;1;1]]
group_succ ~eq:CCInt.equal [1;2;2;2] = [[1]; [2;2;2]]
group_succ ~eq:(fun (x,_)(y,_)-> x=y) [1, 1; 1, 2; 1, 3; 2, 0] \
= [[1, 1; 1, 2; 1, 3]; [2, 0]]
*)
let sorted_merge_uniq ?(cmp=Pervasives.compare) l1 l2 =
let sorted_merge_uniq ~cmp l1 l2 =
let push ~cmp acc x = match acc with
| [] -> [x]
| y :: _ when cmp x y > 0 -> x :: acc
@ -687,21 +687,21 @@ let sorted_merge_uniq ?(cmp=Pervasives.compare) l1 l2 =
recurse ~cmp [] l1 l2
(*$T
sorted_merge_uniq [1; 1; 2; 3; 5; 8] [1; 2; 3; 4; 6; 8; 9; 9] = [1;2;3;4;5;6;8;9]
sorted_merge_uniq ~cmp:CCInt.compare [1; 1; 2; 3; 5; 8] [1; 2; 3; 4; 6; 8; 9; 9] = [1;2;3;4;5;6;8;9]
*)
(*$Q
Q.(list int) (fun l -> \
let l = List.sort Pervasives.compare l in \
sorted_merge_uniq l [] = uniq_succ l)
sorted_merge_uniq ~cmp:CCInt.compare l [] = uniq_succ ~eq:CCInt.equal l)
Q.(list int) (fun l -> \
let l = List.sort Pervasives.compare l in \
sorted_merge_uniq [] l = uniq_succ l)
sorted_merge_uniq ~cmp:CCInt.compare [] l = uniq_succ ~eq:CCInt.equal l)
Q.(pair (list int) (list int)) (fun (l1, l2) -> \
let l1 = List.sort Pervasives.compare l1 \
and l2 = List.sort Pervasives.compare l2 in \
let l3 = sorted_merge_uniq l1 l2 in \
uniq_succ l3 = l3)
let l3 = sorted_merge_uniq ~cmp:CCInt.compare l1 l2 in \
uniq_succ ~eq:CCInt.equal l3 = l3)
*)
let take n l =
@ -766,7 +766,7 @@ let sublists_of_len ?(last=fun _ -> None) ?offset n l =
(* add sub-lists of [l] to [acc] *)
let rec aux acc l =
let group = take n l in
if group=[] then acc (* this was the last group, we are done *)
if is_empty group then acc (* this was the last group, we are done *)
else if List.length group < n (* last group, with missing elements *)
then match last group with
| None -> acc
@ -900,7 +900,7 @@ let find_idx p l = find_mapi (fun i x -> if p x then Some (i, x) else None) l
find_map (fun x -> if x=3 then Some "a" else None) [1;2;4;5] = None
*)
let remove ?(eq=(=)) ~x l =
let remove ~eq ~x l =
let rec remove' eq x acc l = match l with
| [] -> List.rev acc
| y :: tail when eq x y -> remove' eq x acc tail
@ -909,8 +909,8 @@ let remove ?(eq=(=)) ~x l =
remove' eq x [] l
(*$T
remove ~x:1 [2;1;3;3;2;1] = [2;3;3;2]
remove ~x:10 [1;2;3] = [1;2;3]
remove ~eq:CCInt.equal ~x:1 [2;1;3;3;2;1] = [2;3;3;2]
remove ~eq:CCInt.equal ~x:10 [1;2;3] = [1;2;3]
*)
let filter_map f l =
@ -972,16 +972,16 @@ let all_ok l =
(Error "e2") (all_ok [Ok 1; Error "e2"; Error "e3"; Ok 4])
*)
let mem ?(eq=(=)) x l =
let mem ~eq x l =
let rec search eq x l = match l with
| [] -> false
| y::l' -> eq x y || search eq x l'
in search eq x l
let add_nodup ?(eq=(=)) x l =
let add_nodup ~eq x l =
if mem ~eq x l then l else x::l
let remove_one ?(eq=(=)) x l =
let remove_one ~eq x l =
let rec remove_one ~eq x acc l = match l with
| [] -> assert false
| y :: tl when eq x y -> List.rev_append acc tl
@ -991,19 +991,19 @@ let remove_one ?(eq=(=)) x l =
(*$Q
Q.(pair int (list int)) (fun (x,l) -> \
remove_one x (add_nodup x l) = l)
remove_one ~eq:CCInt.equal x (add_nodup ~eq:CCInt.equal x l) = l)
Q.(pair int (list int)) (fun (x,l) -> \
mem x l || List.length (add_nodup x l) = List.length l + 1)
mem ~eq:CCInt.equal x l || List.length (add_nodup ~eq:CCInt.equal x l) = List.length l + 1)
Q.(pair int (list int)) (fun (x,l) -> \
not (mem x l) || List.length (remove_one x l) = List.length l - 1)
not (mem ~eq:CCInt.equal x l) || List.length (remove_one ~eq:CCInt.equal x l) = List.length l - 1)
*)
let subset ?(eq=(=)) l1 l2 =
let subset ~eq l1 l2 =
List.for_all
(fun t -> mem ~eq t l2)
l1
let uniq ?(eq=(=)) l =
let uniq ~eq l =
let rec uniq eq acc l = match l with
| [] -> List.rev acc
| x::xs when List.exists (eq x) xs -> uniq eq acc xs
@ -1011,15 +1011,15 @@ let uniq ?(eq=(=)) l =
in uniq eq [] l
(*$T
uniq [1;1;2;2;3;4;4;2;4;1;5] |> List.sort Pervasives.compare = [1;2;3;4;5]
uniq ~eq:CCInt.equal [1;1;2;2;3;4;4;2;4;1;5] |> List.sort Pervasives.compare = [1;2;3;4;5]
*)
(*$Q
Q.(small_list small_int) (fun l -> \
sort_uniq l = (uniq l |> sort Pervasives.compare))
*)
sort_uniq ~cmp:CCInt.compare l = (uniq ~eq:CCInt.equal l |> sort Pervasives.compare))
*)
let union ?(eq=(=)) l1 l2 =
let union ~eq l1 l2 =
let rec union eq acc l1 l2 = match l1 with
| [] -> List.rev_append acc l2
| x::xs when mem ~eq x l2 -> union eq acc xs l2
@ -1027,10 +1027,10 @@ let union ?(eq=(=)) l1 l2 =
in union eq [] l1 l2
(*$T
union [1;2;4] [2;3;4;5] = [1;2;3;4;5]
union ~eq:CCInt.equal [1;2;4] [2;3;4;5] = [1;2;3;4;5]
*)
let inter ?(eq=(=)) l1 l2 =
let inter ~eq l1 l2 =
let rec inter eq acc l1 l2 = match l1 with
| [] -> List.rev acc
| x::xs when mem ~eq x l2 -> inter eq (x::acc) xs l2
@ -1038,7 +1038,7 @@ let inter ?(eq=(=)) l1 l2 =
in inter eq [] l1 l2
(*$T
inter [1;2;4] [2;3;4;5] = [2;4]
inter ~eq:CCInt.equal [1;2;4] [2;3;4;5] = [2;4]
*)
let mapi f l =
@ -1059,6 +1059,16 @@ let iteri f l =
| x::l' -> f i x; aux f (i+1) l'
in aux f 0 l
let iteri2 f l1 l2 =
let rec aux f i l1 l2 = match l1, l2 with
| [], [] -> ()
| [], _
| _, [] -> invalid_arg "iteri2"
| x1::l1', x2::l2' ->
f i x1 x2;
aux f (i+1) l1' l2'
in aux f 0 l1 l2
let foldi f acc l =
let rec foldi f acc i l = match l with
| [] -> acc
@ -1068,6 +1078,17 @@ let foldi f acc l =
in
foldi f acc 0 l
let foldi2 f acc l1 l2 =
let rec foldi f acc i l1 l2 = match l1, l2 with
| [], [] -> acc
| [], _
| _, [] -> invalid_arg "foldi2"
| x1::l1', x2::l2' ->
let acc = f acc i x1 x2 in
foldi f acc (i+1) l1' l2'
in
foldi f acc 0 l1 l2
let rec get_at_idx_rec i l = match l with
| [] -> raise Not_found
| x::_ when i=0 -> x
@ -1236,17 +1257,17 @@ module Assoc = struct
| (y,z)::l' ->
if eq x y then z else search_exn eq l' x
let get_exn ?(eq=(=)) x l = search_exn eq l x
let get_exn ~eq x l = search_exn eq l x
let get ?(eq=(=)) x l =
let get ~eq x l =
try Some (search_exn eq l x)
with Not_found -> None
(*$T
Assoc.get 1 [1, "1"; 2, "2"] = Some "1"
Assoc.get 2 [1, "1"; 2, "2"] = Some "2"
Assoc.get 3 [1, "1"; 2, "2"] = None
Assoc.get 42 [] = None
Assoc.get ~eq:CCInt.equal 1 [1, "1"; 2, "2"] = Some "1"
Assoc.get ~eq:CCInt.equal 2 [1, "1"; 2, "2"] = Some "2"
Assoc.get ~eq:CCInt.equal 3 [1, "1"; 2, "2"] = None
Assoc.get ~eq:CCInt.equal 42 [] = None
*)
(* search for a binding for [x] in [l], and calls [f x (Some v) rest]
@ -1259,27 +1280,27 @@ module Assoc = struct
then f x (Some y') (List.rev_append acc l')
else search_set eq ((x',y')::acc) l' x ~f
let set ?(eq=(=)) x y l =
let set ~eq x y l =
search_set eq [] l x
~f:(fun x _ l -> (x,y)::l)
(*$T
Assoc.set 2 "two" [1,"1"; 2, "2"] |> List.sort Pervasives.compare \
Assoc.set ~eq:CCInt.equal 2 "two" [1,"1"; 2, "2"] |> List.sort Pervasives.compare \
= [1, "1"; 2, "two"]
Assoc.set 3 "3" [1,"1"; 2, "2"] |> List.sort Pervasives.compare \
Assoc.set ~eq:CCInt.equal 3 "3" [1,"1"; 2, "2"] |> List.sort Pervasives.compare \
= [1, "1"; 2, "2"; 3, "3"]
*)
let mem ?(eq=(=)) x l =
let mem ~eq x l =
try ignore (search_exn eq l x); true
with Not_found -> false
(*$T
Assoc.mem 1 [1,"1"; 2,"2"; 3, "3"]
not (Assoc.mem 4 [1,"1"; 2,"2"; 3, "3"])
Assoc.mem ~eq:CCInt.equal 1 [1,"1"; 2,"2"; 3, "3"]
not (Assoc.mem ~eq:CCInt.equal 4 [1,"1"; 2,"2"; 3, "3"])
*)
let update ?(eq=(=)) ~f x l =
let update ~eq ~f x l =
search_set eq [] l x
~f:(fun x opt_y rest ->
match f opt_y with
@ -1287,17 +1308,17 @@ module Assoc = struct
| Some y' -> (x,y') :: rest)
(*$=
[1,"1"; 2,"22"] \
(Assoc.update 2 [1,"1"; 2,"2"] \
(Assoc.update ~eq:CCInt.equal 2 [1,"1"; 2,"2"] \
~f:(function Some "2" -> Some "22" | _ -> assert false) |> lsort)
[1,"1"; 3,"3"] \
(Assoc.update 2 [1,"1"; 2,"2"; 3,"3"] \
(Assoc.update ~eq:CCInt.equal 2 [1,"1"; 2,"2"; 3,"3"] \
~f:(function Some "2" -> None | _ -> assert false) |> lsort)
[1,"1"; 2,"2"; 3,"3"] \
(Assoc.update 3 [1,"1"; 2,"2"] \
(Assoc.update ~eq:CCInt.equal 3 [1,"1"; 2,"2"] \
~f:(function None -> Some "3" | _ -> assert false) |> lsort)
*)
let remove ?(eq=(=)) x l =
let remove ~eq x l =
search_set eq [] l x
~f:(fun _ opt_y rest -> match opt_y with
| None -> l (* keep as is *)
@ -1305,14 +1326,19 @@ module Assoc = struct
(*$=
[1,"1"] \
(Assoc.remove 2 [1,"1"; 2,"2"] |> lsort)
(Assoc.remove ~eq:CCInt.equal 2 [1,"1"; 2,"2"] |> lsort)
[1,"1"; 3,"3"] \
(Assoc.remove 2 [1,"1"; 2,"2"; 3,"3"] |> lsort)
(Assoc.remove ~eq:CCInt.equal 2 [1,"1"; 2,"2"; 3,"3"] |> lsort)
[1,"1"; 2,"2"] \
(Assoc.remove 3 [1,"1"; 2,"2"] |> lsort)
(Assoc.remove ~eq:CCInt.equal 3 [1,"1"; 2,"2"] |> lsort)
*)
end
let assoc = Assoc.get_exn
let assoc_opt = Assoc.get
let mem_assoc = Assoc.mem
let remove_assoc = Assoc.remove
(** {2 References on Lists} *)
module Ref = struct

283
src/core/CCList.mli
View file

@ -1,7 +1,7 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 complements to list} *)
(** {1 Complements to list} *)
type 'a sequence = ('a -> unit) -> unit
type 'a gen = unit -> 'a option
@ -16,39 +16,47 @@ type 'a t = 'a list
val empty : 'a t
val is_empty : _ t -> bool
(** [is_empty l] returns [true] iff [l = []]
(** [is_empty l] returns [true] iff [l = []].
@since 0.11 *)
val map : ('a -> 'b) -> 'a t -> 'b t
(** Safe version of map *)
(** Safe version of {!List.map}. *)
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
(** Infix version of [map] with reversed arguments
(** Infix version of [map] with reversed arguments.
@since 0.5 *)
val cons : 'a -> 'a t -> 'a t
(** [cons x l] is [x::l]
(** [cons x l] is [x::l].
@since 0.12 *)
val append : 'a t -> 'a t -> 'a t
(** Safe version of append *)
(** Safe version of {!List.append}.
Concatenate two lists. *)
val cons_maybe : 'a option -> 'a t -> 'a t
(** [cons_maybe (Some x) l] is [x :: l]
[cons_maybe None l] is [l]
(** [cons_maybe (Some x) l] is [x :: l].
[cons_maybe None l] is [l].
@since 0.13 *)
val (@) : 'a t -> 'a t -> 'a t
(** Same as [append].
Concatenate two lists. *)
val filter : ('a -> bool) -> 'a t -> 'a t
(** Safe version of {!List.filter} *)
(** Safe version of {!List.filter}.
[filter p l] returns all the elements of the list [l]
that satisfy the predicate [p]. The order of the elements
in the input list is preserved. *)
val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b
(** Safe version of [fold_right] *)
(** Safe version of [fold_right].
[fold_right f [a1; ...; an] b] is
[f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. *)
val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a
(** Fold until a stop condition via [('a, `Stop)] is
indicated by the accumulator
indicated by the accumulator.
@since 0.8 *)
val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a list -> 'acc * 'b list
@ -57,35 +65,39 @@ val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a list -> 'acc * 'b list
@since 0.14 *)
val scan_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a list -> 'acc list
(** [scan_left f acc l] returns the list [[acc; f acc x0; f (f acc x0) x1; …]]
where [x0], [x1], etc. are the elements of [l]
(** [scan_left f acc l] returns the list [[acc; f acc x0; f (f acc x0) x1; ...]]
where [x0], [x1], etc. are the elements of [l].
@since 1.2 *)
val fold_map2 : ('acc -> 'a -> 'b -> 'acc * 'c) -> 'acc -> 'a list -> 'b list -> 'acc * 'c list
(** [fold_map2] is to [fold_map] what [List.map2] is to [List.map].
@raise Invalid_argument if the lists do not have the same length
@raise Invalid_argument if the lists do not have the same length.
@since 0.16 *)
val fold_filter_map : ('acc -> 'a -> 'acc * 'b option) -> 'acc -> 'a list -> 'acc * 'b list
(** [fold_filter_map f acc l] is a [fold_left]-like function, but also
generates a list of output in a way similar to {!filter_map}
generates a list of output in a way similar to {!filter_map}.
@since 0.17 *)
val fold_flat_map : ('acc -> 'a -> 'acc * 'b list) -> 'acc -> 'a list -> 'acc * 'b list
(** [fold_flat_map f acc l] is a [fold_left]-like function, but it also maps the
list to a list of lists that is then [flatten]'d..
list to a list of lists that is then [flatten]'d.
@since 0.14 *)
val count : ('a -> bool) -> 'a list -> int
(** [count f l] counts how much element of [l] comply with the function [f].
(** [count f l] counts how much elements of [l] comply with the function [f].
@since 1.5 *)
val init : int -> (int -> 'a) -> 'a t
(** Similar to {!Array.init}
(** [init len f] is [f 0; f 1; ...; f (len-1)].
@raise Invalid_argument if len < 0.
@since 0.6 *)
val combine : 'a list -> 'b list -> ('a * 'b) list
(** Similar to {!List.combine} but tail-recursive.
Transform a pair of lists into a list of pairs:
[combine [a1; ...; an] [b1; ...; bn]] is
[[(a1,b1); ...; (an,bn)]].
@raise Invalid_argument if the lists have distinct lengths.
@since 1.2 *)
@ -97,16 +109,20 @@ val combine_gen : 'a list -> 'b list -> ('a * 'b) gen
@since 1.2 *)
val split : ('a * 'b) t -> 'a t * 'b t
(** A tail-recursive version of {!List.split}. *)
(** A tail-recursive version of {!List.split}.
Transform a list of pairs into a pair of lists:
[split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])]. *)
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
val compare_lengths : 'a t -> 'b t -> int
(** equivalent to [compare (length l1) (length l2)] but more efficient.
(** Equivalent to [compare (length l1) (length l2)] but more efficient.
Compare the lengths of two lists.
@since 1.5 *)
val compare_length_with : 'a t -> int -> int
(** equivalent to [compare (length l) x] but more efficient.
(** Equivalent to [compare (length l) x] but more efficient.
Compare the length of a list to an integer.
@since 1.5 *)
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
@ -115,33 +131,33 @@ val flat_map : ('a -> 'b t) -> 'a t -> 'b t
(** Map and flatten at the same time (safe). Evaluation order is not guaranteed. *)
val flatten : 'a t t -> 'a t
(** Safe flatten *)
(** Safe flatten. Concatenate a list of lists. *)
val product : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Cartesian product of the two lists, with the given combinator *)
(** Cartesian product of the two lists, with the given combinator. *)
val fold_product : ('c -> 'a -> 'b -> 'c) -> 'c -> 'a t -> 'b t -> 'c
(** Fold on the cartesian product *)
(** Fold on the cartesian product. *)
val cartesian_product : 'a t t -> 'a t t
(** Produce the cartesian product of this list of lists,
by returning all the ways of picking one element per sublist.
{b NOTE} the order of the returned list is unspecified.
For example:
{[
# cartesian_product [[1;2];[3];[4;5;6]] |> sort =
[[1;3;4];[1;3;5];[1;3;6];[2;3;4];[2;3;5];[2;3;6]];;
# cartesian_product [[1;2];[];[4;5;6]] = [];;
# cartesian_product [[1;2];[3];[4];[5];[6]] |> sort =
[[1;3;4;5;6];[2;3;4;5;6]];;
]}
{[
# cartesian_product [[1;2];[3];[4;5;6]] |> sort =
[[1;3;4];[1;3;5];[1;3;6];[2;3;4];[2;3;5];[2;3;6]];;
# cartesian_product [[1;2];[];[4;5;6]] = [];;
# cartesian_product [[1;2];[3];[4];[5];[6]] |> sort =
[[1;3;4;5;6];[2;3;4;5;6]];;
]}
invariant: [cartesian_product l = map_product id l].
@since 1.2 *)
val map_product_l : ('a -> 'b list) -> 'a list -> 'b list list
(** [map_product_l f l] maps each element of [l] to a list of
objects of type ['b] using [f].
We obtain [[l1;l2;…;ln]] where [length l=n] and [li : 'b list].
We obtain [[l1;l2;...;ln]] where [length l=n] and [li : 'b list].
Then, it returns all the ways of picking exactly one element per [li].
@since 1.2 *)
@ -152,9 +168,9 @@ val diagonal : 'a t -> ('a * 'a) t
val partition_map : ('a -> [<`Left of 'b | `Right of 'c | `Drop]) ->
'a list -> 'b list * 'c list
(** [partition_map f l] maps [f] on [l] and gather results in lists:
- if [f x = `Left y], adds [y] to the first list
- if [f x = `Right z], adds [z] to the second list
- if [f x = `Drop], ignores [x]
- if [f x = `Left y], adds [y] to the first list.
- if [f x = `Right z], adds [z] to the second list.
- if [f x = `Drop], ignores [x].
@since 0.11 *)
val sublists_of_len :
@ -165,14 +181,14 @@ val sublists_of_len :
'a list list
(** [sublists_of_len n l] returns sub-lists of [l] that have length [n].
By default, these sub-lists are non overlapping:
[sublists_of_len 2 [1;2;3;4;5;6]] returns [[1;2]; [3;4]; [5;6]]
[sublists_of_len 2 [1;2;3;4;5;6]] returns [[1;2]; [3;4]; [5;6]].
Examples:
- [sublists_of_len 2 [1;2;3;4;5;6] = [[1;2]; [3;4]; [5;6]]]
- [sublists_of_len 2 ~offset:3 [1;2;3;4;5;6] = [1;2];[4;5]]
- [sublists_of_len 3 ~last:CCOpt.return [1;2;3;4] = [1;2;3];[4]]
- [sublists_of_len 2 [1;2;3;4;5] = [[1;2]; [3;4]]]
- [sublists_of_len 2 [1;2;3;4;5;6] = [[1;2]; [3;4]; [5;6]]].
- [sublists_of_len 2 ~offset:3 [1;2;3;4;5;6] = [1;2];[4;5]].
- [sublists_of_len 3 ~last:CCOpt.return [1;2;3;4] = [1;2;3];[4]].
- [sublists_of_len 2 [1;2;3;4;5] = [[1;2]; [3;4]]].
@param offset the number of elements skipped between two consecutive
sub-lists. By default it is [n]. If [offset < n], the sub-lists
@ -182,33 +198,38 @@ val sublists_of_len :
[g'] is appended; otherwise [g] is dropped.
If [last = CCOpt.return], it will simply keep the last group.
By default, [last = fun _ -> None], i.e. the last group is dropped if shorter than [n].
@raise Invalid_argument if [offset <= 0] or [n <= 0]
@raise Invalid_argument if [offset <= 0] or [n <= 0].
@since 1.0 *)
val pure : 'a -> 'a t
(** [pure] = [return]. *)
val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
(** [funs <*> l] = [product (fun f x -> f x) funs l]. *)
val (<$>) : ('a -> 'b) -> 'a t -> 'b t
(** [(<$>)] = [map]. *)
val return : 'a -> 'a t
(** [return x] = [x]. *)
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
(** [l >>= f] = [flat_map f l]. *)
val take : int -> 'a t -> 'a t
(** Take the [n] first elements, drop the rest *)
(** Take the [n] first elements, drop the rest. *)
val drop : int -> 'a t -> 'a t
(** Drop the [n] first elements, keep the rest *)
(** Drop the [n] first elements, keep the rest. *)
val hd_tl : 'a t -> 'a * 'a t
(** [hd_tl (x :: l)] returns [hd, l].
@raise Failure if the list is empty
@raise Failure if the list is empty.
@since 0.16 *)
val take_drop : int -> 'a t -> 'a t * 'a t
(** [take_drop n l] returns [l1, l2] such that [l1 @ l2 = l] and
[length l1 = min (length l) n] *)
[length l1 = min (length l) n]. *)
val take_while : ('a -> bool) -> 'a t -> 'a t
(** @since 0.13 *)
@ -217,12 +238,12 @@ val drop_while : ('a -> bool) -> 'a t -> 'a t
(** @since 0.13 *)
val take_drop_while : ('a -> bool) -> 'a t -> 'a t * 'a t
(** [take_drop_while p l = take_while p l, drop_while p l]
(** [take_drop_while p l = take_while p l, drop_while p l].
@since 1.2 *)
val last : int -> 'a t -> 'a t
(** [last n l] takes the last [n] elements of [l] (or less if
[l] doesn't have that many elements *)
[l] doesn't have that many elements. *)
val head_opt : 'a t -> 'a option
(** First element.
@ -234,22 +255,22 @@ val last_opt : 'a t -> 'a option
val find_pred : ('a -> bool) -> 'a t -> 'a option
(** [find_pred p l] finds the first element of [l] that satisfies [p],
or returns [None] if no element satisfies [p]
or returns [None] if no element satisfies [p].
@since 0.11 *)
val find_opt : ('a -> bool) -> 'a t -> 'a option
(** Safe version of {!find}
(** Safe version of {!find}.
@since 1.5 *)
val find_pred_exn : ('a -> bool) -> 'a t -> 'a
(** Unsafe version of {!find_pred}
@raise Not_found if no such element is found
(** Unsafe version of {!find_pred}.
@raise Not_found if no such element is found.
@since 0.11 *)
val find_map : ('a -> 'b option) -> 'a t -> 'b option
(** [find_map f l] traverses [l], applying [f] to each element. If for
some element [x], [f x = Some y], then [Some y] is returned. Otherwise
the call returns [None]
the call returns [None].
@since 0.11 *)
val find_mapi : (int -> 'a -> 'b option) -> 'a t -> 'b option
@ -258,24 +279,23 @@ val find_mapi : (int -> 'a -> 'b option) -> 'a t -> 'b option
val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option
(** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
and [p x] holds. Otherwise returns [None] *)
and [p x] holds. Otherwise returns [None]. *)
val remove : ?eq:('a -> 'a -> bool) -> x:'a -> 'a t -> 'a t
val remove : eq:('a -> 'a -> bool) -> x:'a -> 'a t -> 'a t
(** [remove ~x l] removes every instance of [x] from [l]. Tailrec.
@param eq equality function
@param eq equality function.
@since 0.11 *)
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
(** Map and remove elements at the same time *)
(** Map and remove elements at the same time. *)
val keep_some : 'a option t -> 'a t
(** [filter_some l] retains only elements of the form [Some x].
Same as [filter_map CCFun.id]
Same as [filter_map CCFun.id].
@since 1.3 *)
val keep_ok : ('a, _) Result.result t -> 'a t
(** [filter_some l] retains only elements of the form [Some x].
Same as [filter_map CCFun.id]
(** [keep_ok l] retains only elements of the form [Ok x].
@since 1.3 *)
val all_some : 'a option t -> 'a t option
@ -288,23 +308,23 @@ val all_ok : ('a, 'err) Result.result t -> ('a t, 'err) Result.result
or [Error e] otherwise (with the first error met).
@since 1.3 *)
val sorted_merge : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
(** Merges elements from both sorted list *)
val sorted_merge : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
(** Merges elements from both sorted list. *)
val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list
(** Sort the list and remove duplicate elements *)
val sort_uniq : cmp:('a -> 'a -> int) -> 'a list -> 'a list
(** Sort the list and remove duplicate elements. *)
val sorted_merge_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
val sorted_merge_uniq : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
(** [sorted_merge_uniq l1 l2] merges the sorted lists [l1] and [l2] and
removes duplicates
removes duplicates.
@since 0.10 *)
val is_sorted : ?cmp:('a -> 'a -> int) -> 'a list -> bool
(** [is_sorted l] returns [true] iff [l] is sorted (according to given order)
@param cmp the comparison function (default [Pervasives.compare])
val is_sorted : cmp:('a -> 'a -> int) -> 'a list -> bool
(** [is_sorted l] returns [true] iff [l] is sorted (according to given order).
@param cmp the comparison function (default [Pervasives.compare]).
@since 0.17 *)
val sorted_insert : ?cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a list
val sorted_insert : cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a list
(** [sorted_insert x l] inserts [x] into [l] such that, if [l] was sorted,
then [sorted_insert x l] is sorted too.
@param uniq if true and [x] is already in sorted position in [l], then
@ -314,29 +334,44 @@ val sorted_insert : ?cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a
(*$Q
Q.(pair small_int (list small_int)) (fun (x,l) -> \
let l = List.sort Pervasives.compare l in \
is_sorted (sorted_insert x l))
is_sorted ~cmp:CCInt.compare (sorted_insert ~cmp:CCInt.compare x l))
*)
val uniq_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list
val uniq_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list
(** [uniq_succ l] removes duplicate elements that occur one next to the other.
Examples:
[uniq_succ [1;2;1] = [1;2;1]]
[uniq_succ [1;1;2] = [1;2]]
[uniq_succ [1;2;1] = [1;2;1]].
[uniq_succ [1;1;2] = [1;2]].
@since 0.10 *)
val group_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list list
val group_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list list
(** [group_succ ~eq l] groups together consecutive elements that are equal
according to [eq]
according to [eq].
@since 0.11 *)
(** {2 Indices} *)
val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
(** Same as {!map}, but the function is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument. *)
val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** Same as {!iter}, but the function is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument. *)
val iteri2 : (int -> 'a -> 'b -> unit) -> 'a t -> 'b t -> unit
(** @raise Invalid_argument when lists do not have the same length.
@since NEXT_RELEASE *)
val foldi : ('b -> int -> 'a -> 'b) -> 'b -> 'a t -> 'b
(** Fold on list, with index *)
(** Fold on list, with index. *)
val foldi2 : ('c -> int -> 'a -> 'b -> 'c) -> 'c -> 'a t -> 'b t -> 'c
(** Fold on two lists, with index.
@raise Invalid_argument when lists do not have the same length.
@since NEXT_RELEASE *)
val get_at_idx : int -> 'a t -> 'a option
(** Get by index in the list.
@ -350,7 +385,7 @@ val nth_opt : 'a t -> int -> 'a option
val get_at_idx_exn : int -> 'a t -> 'a
(** Get the i-th element, or
@raise Not_found if the index is invalid
@raise Not_found if the index is invalid.
If the index is negative, it will get element starting from the end
of the list. *)
@ -375,32 +410,32 @@ val remove_at_idx : int -> 'a t -> 'a t
(** {2 Set Operators}
Those operations maintain the invariant that the list does not
contain duplicates (if it already satisfies it) *)
contain duplicates (if it already satisfies it). *)
val add_nodup : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t
val add_nodup : eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t
(** [add_nodup x set] adds [x] to [set] if it was not already present. Linear time.
@since 0.11 *)
val remove_one : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t
val remove_one : eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t
(** [remove_one x set] removes one occurrence of [x] from [set]. Linear time.
@since 0.11 *)
val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool
(** Membership to the list. Linear time *)
val mem : eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool
(** Membership to the list. Linear time. *)
val subset : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** Test for inclusion *)
val subset : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** Test for inclusion. *)
val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t
val uniq : eq:('a -> 'a -> bool) -> 'a t -> 'a t
(** Remove duplicates w.r.t the equality predicate.
Complexity is quadratic in the length of the list, but the order
of elements is preserved. If you wish for a faster de-duplication
but do not care about the order, use {!sort_uniq}*)
but do not care about the order, use {!sort_uniq}. *)
val union : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
val union : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
(** List union. Complexity is product of length of inputs. *)
val inter : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
val inter : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
(** List intersection. Complexity is product of length of inputs. *)
(** {2 Other Constructors} *)
@ -409,69 +444,81 @@ val range_by : step:int -> int -> int -> int t
(** [range_by ~step i j] iterates on integers from [i] to [j] included,
where the difference between successive elements is [step].
use a negative [step] for a decreasing list.
@raise Invalid_argument if [step=0]
@raise Invalid_argument if [step=0].
@since 0.18 *)
val range : int -> int -> int t
(** [range i j] iterates on integers from [i] to [j] included . It works
both for decreasing and increasing ranges *)
(** [range i j] iterates on integers from [i] to [j] included. It works
both for decreasing and increasing ranges. *)
val range' : int -> int -> int t
(** Same as {!range} but the second bound is excluded.
For instance [range' 0 5 = [0;1;2;3;4]] *)
For instance [range' 0 5 = [0;1;2;3;4]]. *)
val (--) : int -> int -> int t
(** Infix alias for [range] *)
(** Infix alias for [range]. *)
val (--^) : int -> int -> int t
(** Infix alias for [range']
(** Infix alias for [range'].
@since 0.17 *)
val replicate : int -> 'a -> 'a t
(** Replicate the given element [n] times *)
(** Replicate the given element [n] times. *)
val repeat : int -> 'a t -> 'a t
(** Concatenate the list with itself [n] times *)
(** Concatenate the list with itself [n] times. *)
(** {2 Association Lists} *)
module Assoc : sig
type ('a, 'b) t = ('a*'b) list
val get : ?eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b option
(** Find the element *)
val get : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b option
(** Find the element. *)
val get_exn : ?eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b
(** Same as [get], but unsafe
@raise Not_found if the element is not present *)
val get_exn : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b
(** Same as [get], but unsafe.
@raise Not_found if the element is not present. *)
val set : ?eq:('a->'a->bool) -> 'a -> 'b -> ('a,'b) t -> ('a,'b) t
(** Add the binding into the list (erase it if already present) *)
val set : eq:('a->'a->bool) -> 'a -> 'b -> ('a,'b) t -> ('a,'b) t
(** Add the binding into the list (erase it if already present). *)
val mem : ?eq:('a->'a->bool) -> 'a -> ('a,_) t -> bool
(** [mem x l] returns [true] iff [x] is a key in [l]
val mem : eq:('a->'a->bool) -> 'a -> ('a,_) t -> bool
(** [mem x l] returns [true] iff [x] is a key in [l].
@since 0.16 *)
val update :
?eq:('a->'a->bool) -> f:('b option -> 'b option) -> 'a -> ('a,'b) t -> ('a,'b) t
eq:('a->'a->bool) -> f:('b option -> 'b option) -> 'a -> ('a,'b) t -> ('a,'b) t
(** [update k ~f l] updates [l] on the key [k], by calling [f (get l k)]
and removing [k] if it returns [None], mapping [k] to [v'] if it
returns [Some v']
returns [Some v'].
@since 0.16 *)
val remove : ?eq:('a->'a->bool) -> 'a -> ('a,'b) t -> ('a,'b) t
val remove : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> ('a,'b) t
(** [remove x l] removes the first occurrence of [k] from [l].
@since 0.17 *)
end
val assoc_opt : 'a -> ('a * 'b) t -> 'b option
(** Safe version of {!assoc}
val assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b
(** Same as [Assoc.get_exn].
@since NEXT_RELEASE *)
val assoc_opt : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b option
(** Same as [Assoc.get].
@since 1.5 *)
val assq_opt : 'a -> ('a * 'b) t -> 'b option
(** Safe version of {!assq}
(** Safe version of {!assq}.
@since 1.5 *)
val mem_assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * _) t -> bool
(** Same as [Assoc.mem].
@since NEXT_RELEASE *)
val remove_assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> ('a * 'b) t
(** Same as [Assoc.remove].
@since NEXT_RELEASE *)
(** {2 References on Lists}
@since 0.3.3 *)
@ -484,20 +531,20 @@ module Ref : sig
val pop_exn : 'a t -> 'a
(** Unsafe version of {!pop}.
@raise Failure if the list is empty *)
@raise Failure if the list is empty. *)
val create : unit -> 'a t
(** Create a new list reference *)
(** Create a new list reference. *)
val clear : _ t -> unit
(** Remove all elements *)
(** Remove all elements. *)
val lift : ('a list -> 'b) -> 'a t -> 'b
(** Apply a list function to the content *)
(** Apply a list function to the content. *)
val push_list : 'a t -> 'a list -> unit
(** Add elements of the list at the beginning of the list ref. Elements
at the end of the list will be at the beginning of the list ref *)
at the end of the list will be at the beginning of the list ref. *)
end
(** {2 Monadic Operations} *)
@ -528,7 +575,7 @@ val random_len : int -> 'a random_gen -> 'a t random_gen
val random_choose : 'a t -> 'a random_gen
(** Randomly choose an element in the list.
@raise Not_found if the list is empty *)
@raise Not_found if the list is empty. *)
val random_sequence : 'a random_gen t -> 'a t random_gen
@ -543,7 +590,7 @@ val of_klist : 'a klist -> 'a t
(** {2 Infix Operators}
It is convenient to {!open CCList.Infix} to access the infix operators
without cluttering the scope too much.
without cluttering the scope too much.
@since 0.16 *)

230
src/core/CCListLabels.mli
View file

@ -1,7 +1,7 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 complements to list} *)
(** {1 Complements to list} *)
include module type of ListLabels
@ -10,39 +10,42 @@ type 'a t = 'a list
val empty : 'a t
val is_empty : _ t -> bool
(** [is_empty l] returns [true] iff [l = []]
(** [is_empty l] returns [true] iff [l = []].
@since 0.11 *)
val map : f:('a -> 'b) -> 'a t -> 'b t
(** Safe version of map *)
(** Safe version of {!List.map}. *)
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
(** Infix version of [map] with reversed arguments
(** Infix version of [map] with reversed arguments.
@since 0.5 *)
val cons : 'a -> 'a t -> 'a t
(** [cons x l] is [x::l]
(** [cons x l] is [x::l].
@since 0.12 *)
val append : 'a t -> 'a t -> 'a t
(** Safe version of append *)
(** Safe version of {!List.append}.
Concatenate two lists. *)
val cons_maybe : 'a option -> 'a t -> 'a t
(** [cons_maybe (Some x) l] is [x :: l]
[cons_maybe None l] is [l]
(** [cons_maybe (Some x) l] is [x :: l].
[cons_maybe None l] is [l].
@since 0.13 *)
val (@) : 'a t -> 'a t -> 'a t
(** Same as [append].
Concatenate two lists. *)
val filter : f:('a -> bool) -> 'a t -> 'a t
(** Safe version of {!List.filter} *)
(** Safe version of {!List.filter}. *)
val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b
(** Safe version of [fold_right] *)
(** Safe version of [fold_right]. *)
val fold_while : f:('a -> 'b -> 'a * [`Stop | `Continue]) -> init:'a -> 'b t -> 'a
(** Fold until a stop condition via [('a, `Stop)] is
indicated by the accumulator
indicated by the accumulator.
@since 0.8 *)
val fold_map : f:('acc -> 'a -> 'acc * 'b) -> init:'acc -> 'a list -> 'acc * 'b list
@ -52,21 +55,22 @@ val fold_map : f:('acc -> 'a -> 'acc * 'b) -> init:'acc -> 'a list -> 'acc * 'b
val fold_map2 : f:('acc -> 'a -> 'b -> 'acc * 'c) -> init:'acc -> 'a list -> 'b list -> 'acc * 'c list
(** [fold_map2] is to [fold_map] what [List.map2] is to [List.map].
@raise Invalid_argument if the lists do not have the same length
@raise Invalid_argument if the lists do not have the same length.
@since 0.16 *)
val fold_filter_map : f:('acc -> 'a -> 'acc * 'b option) -> init:'acc -> 'a list -> 'acc * 'b list
(** [fold_filter_map f acc l] is a [fold_left]-like function, but also
generates a list of output in a way similar to {!filter_map}
generates a list of output in a way similar to {!filter_map}.
@since 0.17 *)
val fold_flat_map : f:('acc -> 'a -> 'acc * 'b list) -> init:'acc -> 'a list -> 'acc * 'b list
(** [fold_flat_map f acc l] is a [fold_left]-like function, but it also maps the
list to a list of lists that is then [flatten]'d..
list to a list of lists that is then [flatten]'d.
@since 0.14 *)
val init : int -> f:(int -> 'a) -> 'a t
(** Similar to {!Array.init}
(** [init len f] is [f 0; f 1; ...; f (len-1)].
@raise Invalid_argument if len < 0.
@since 0.6 *)
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
@ -77,13 +81,13 @@ val flat_map : f:('a -> 'b t) -> 'a t -> 'b t
(** Map and flatten at the same time (safe). Evaluation order is not guaranteed. *)
val flatten : 'a t t -> 'a t
(** Safe flatten *)
(** Safe flatten. Concatenate a list of lists. *)
val product : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Cartesian product of the two lists, with the given combinator *)
(** Cartesian product of the two lists, with the given combinator. *)
val fold_product : f:('c -> 'a -> 'b -> 'c) -> init:'c -> 'a t -> 'b t -> 'c
(** Fold on the cartesian product *)
(** Fold on the cartesian product. *)
val diagonal : 'a t -> ('a * 'a) t
(** All pairs of distinct positions of the list. [list_diagonal l] will
@ -92,9 +96,9 @@ val diagonal : 'a t -> ('a * 'a) t
val partition_map : f:('a -> [<`Left of 'b | `Right of 'c | `Drop]) ->
'a list -> 'b list * 'c list
(** [partition_map f l] maps [f] on [l] and gather results in lists:
- if [f x = `Left y], adds [y] to the first list
- if [f x = `Right z], adds [z] to the second list
- if [f x = `Drop], ignores [x]
- if [f x = `Left y], adds [y] to the first list.
- if [f x = `Right z], adds [z] to the second list.
- if [f x = `Drop], ignores [x].
@since 0.11 *)
val sublists_of_len :
@ -112,29 +116,34 @@ val sublists_of_len :
@since 1.5 *)
val pure : 'a -> 'a t
(** [pure] = [return]. *)
val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
(** [funs <*> l] = [product fun f x -> f x) funs l]. *)
val (<$>) : ('a -> 'b) -> 'a t -> 'b t
(** [(<$>)] = [map]. *)
val return : 'a -> 'a t
(** [return x] = [x]. *)
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
(** [l >>= f] = [flat_map f l]. *)
val take : int -> 'a t -> 'a t
(** Take the [n] first elements, drop the rest *)
(** Take the [n] first elements, drop the rest. *)
val drop : int -> 'a t -> 'a t
(** Drop the [n] first elements, keep the rest *)
(** Drop the [n] first elements, keep the rest. *)
val hd_tl : 'a t -> 'a * 'a t
(** [hd_tl (x :: l)] returns [hd, l].
@raise Failure if the list is empty
@raise Failure if the list is empty.
@since 0.16 *)
val take_drop : int -> 'a t -> 'a t * 'a t
(** [take_drop n l] returns [l1, l2] such that [l1 @ l2 = l] and
[length l1 = min (length l) n] *)
[length l1 = min (length l) n]. *)
val take_while : f:('a -> bool) -> 'a t -> 'a t
(** @since 0.13 *)
@ -144,7 +153,7 @@ val drop_while : f:('a -> bool) -> 'a t -> 'a t
val last : int -> 'a t -> 'a t
(** [last n l] takes the last [n] elements of [l] (or less if
[l] doesn't have that many elements *)
[l] doesn't have that many elements. *)
val head_opt : 'a t -> 'a option
(** First element.
@ -156,18 +165,18 @@ val last_opt : 'a t -> 'a option
val find_pred : f:('a -> bool) -> 'a t -> 'a option
(** [find_pred p l] finds the first element of [l] that satisfies [p],
or returns [None] if no element satisfies [p]
or returns [None] if no element satisfies [p].
@since 0.11 *)
val find_pred_exn : f:('a -> bool) -> 'a t -> 'a
(** Unsafe version of {!find_pred}
@raise Not_found if no such element is found
(** Unsafe version of {!find_pred}.
@raise Not_found if no such element is found.
@since 0.11 *)
val find_map : f:('a -> 'b option) -> 'a t -> 'b option
(** [find_map f l] traverses [l], applying [f] to each element. If for
some element [x], [f x = Some y], then [Some y] is returned. Otherwise
the call returns [None]
the call returns [None].
@since 0.11 *)
val find_mapi : f:(int -> 'a -> 'b option) -> 'a t -> 'b option
@ -176,33 +185,33 @@ val find_mapi : f:(int -> 'a -> 'b option) -> 'a t -> 'b option
val find_idx : f:('a -> bool) -> 'a t -> (int * 'a) option
(** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
and [p x] holds. Otherwise returns [None] *)
and [p x] holds. Otherwise returns [None]. *)
val remove : ?eq:('a -> 'a -> bool) -> key:'a -> 'a t -> 'a t
val remove : eq:('a -> 'a -> bool) -> key:'a -> 'a t -> 'a t
(** [remove ~key l] removes every instance of [key] from [l]. Tailrec.
@param eq equality function
@param eq equality function.
@since 0.11 *)
val filter_map : f:('a -> 'b option) -> 'a t -> 'b t
(** Map and remove elements at the same time *)
(** Map and remove elements at the same time. *)
val sorted_merge : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
(** Merges elements from both sorted list *)
val sorted_merge : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
(** Merges elements from both sorted list. *)
val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list
(** Sort the list and remove duplicate elements *)
val sort_uniq : cmp:('a -> 'a -> int) -> 'a list -> 'a list
(** Sort the list and remove duplicate elements. *)
val sorted_merge_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
val sorted_merge_uniq : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
(** [sorted_merge_uniq l1 l2] merges the sorted lists [l1] and [l2] and
removes duplicates
removes duplicates.
@since 0.10 *)
val is_sorted : ?cmp:('a -> 'a -> int) -> 'a list -> bool
(** [is_sorted l] returns [true] iff [l] is sorted (according to given order)
@param cmp the comparison function (default [Pervasives.compare])
val is_sorted : cmp:('a -> 'a -> int) -> 'a list -> bool
(** [is_sorted l] returns [true] iff [l] is sorted (according to given order).
@param cmp the comparison function (default [Pervasives.compare]).
@since 0.17 *)
val sorted_insert : ?cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a list
val sorted_insert : cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a list
(** [sorted_insert x l] inserts [x] into [l] such that, if [l] was sorted,
then [sorted_insert x l] is sorted too.
@param uniq if true and [x] is already in sorted position in [l], then
@ -215,74 +224,91 @@ val sorted_insert : ?cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a
is_sorted (sorted_insert x l))
*)
val uniq_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list
val uniq_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list
(** [uniq_succ l] removes duplicate elements that occur one next to the other.
Examples:
[uniq_succ [1;2;1] = [1;2;1]]
[uniq_succ [1;1;2] = [1;2]]
[uniq_succ [1;2;1] = [1;2;1]].
[uniq_succ [1;1;2] = [1;2]].
@since 0.10 *)
val group_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list list
val group_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list list
(** [group_succ ~eq l] groups together consecutive elements that are equal
according to [eq]
according to [eq].
@since 0.11 *)
(** {2 Indices} *)
val mapi : f:(int -> 'a -> 'b) -> 'a t -> 'b t
(** Same as {!map}, but the function is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument. *)
val iteri : f:(int -> 'a -> unit) -> 'a t -> unit
(** Same as {!iter}, but the function is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument. *)
val foldi : f:('b -> int -> 'a -> 'b) -> init:'b -> 'a t -> 'b
(** Fold on list, with index *)
(** Fold on list, with index. *)
val get_at_idx : int -> 'a t -> 'a option
(** Get by index in the list.
If the index is negative, it will get element starting from the end
of the list. *)
val get_at_idx_exn : int -> 'a t -> 'a
(** Get the i-th element, or
@raise Not_found if the index is invalid *)
@raise Not_found if the index is invalid.
If the index is negative, it will get element starting from the end
of the list. *)
val set_at_idx : int -> 'a -> 'a t -> 'a t
(** Set i-th element (removes the old one), or does nothing if
index is too high *)
index is too high.
If the index is negative, it will set element starting from the end
of the list. *)
val insert_at_idx : int -> 'a -> 'a t -> 'a t
(** Insert at i-th position, between the two existing elements. If the
index is too high, append at the end of the list *)
index is too high, append at the end of the list.
If the index is negative, it will insert element starting from the end
of the list. *)
val remove_at_idx : int -> 'a t -> 'a t
(** Remove element at given index. Does nothing if the index is
too high. *)
too high.
If the index is negative, it will remove element starting from the end
of the list. *)
(** {2 Set Operators}
Those operations maintain the invariant that the list does not
contain duplicates (if it already satisfies it) *)
contain duplicates (if it already satisfies it). *)
val add_nodup : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t
val add_nodup : eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t
(** [add_nodup x set] adds [x] to [set] if it was not already present. Linear time.
@since 0.11 *)
val remove_one : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t
val remove_one : eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t
(** [remove_one x set] removes one occurrence of [x] from [set]. Linear time.
@since 0.11 *)
val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool
(** Membership to the list. Linear time *)
val mem : eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool
(** Membership to the list. Linear time. *)
val subset : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** Test for inclusion *)
val subset : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** Test for inclusion. *)
val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t
val uniq : eq:('a -> 'a -> bool) -> 'a t -> 'a t
(** Remove duplicates w.r.t the equality predicate.
Complexity is quadratic in the length of the list, but the order
of elements is preserved. If you wish for a faster de-duplication
but do not care about the order, use {!sort_uniq}*)
but do not care about the order, use {!sort_uniq}. *)
val union : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
val union : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
(** List union. Complexity is product of length of inputs. *)
val inter : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
val inter : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
(** List intersection. Complexity is product of length of inputs. *)
(** {2 Other Constructors} *)
@ -291,61 +317,81 @@ val range_by : step:int -> int -> int -> int t
(** [range_by ~step i j] iterates on integers from [i] to [j] included,
where the difference between successive elements is [step].
use a negative [step] for a decreasing list.
@raise Invalid_argument if [step=0]
@raise Invalid_argument if [step=0].
@since 0.18 *)
val range : int -> int -> int t
(** [range i j] iterates on integers from [i] to [j] included . It works
both for decreasing and increasing ranges *)
(** [range i j] iterates on integers from [i] to [j] included. It works
both for decreasing and increasing ranges. *)
val range' : int -> int -> int t
(** Same as {!range} but the second bound is excluded.
For instance [range' 0 5 = [0;1;2;3;4]] *)
For instance [range' 0 5 = [0;1;2;3;4]]. *)
val (--) : int -> int -> int t
(** Infix alias for [range] *)
(** Infix alias for [range]. *)
val (--^) : int -> int -> int t
(** Infix alias for [range']
(** Infix alias for [range'].
@since 0.17 *)
val replicate : int -> 'a -> 'a t
(** Replicate the given element [n] times *)
(** Replicate the given element [n] times. *)
val repeat : int -> 'a t -> 'a t
(** Concatenate the list with itself [n] times *)
(** Concatenate the list with itself [n] times. *)
(** {2 Association Lists} *)
module Assoc : sig
type ('a, 'b) t = ('a*'b) list
val get : ?eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b option
(** Find the element *)
val get : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b option
(** Find the element. *)
val get_exn : ?eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b
(** Same as [get], but unsafe
@raise Not_found if the element is not present *)
val get_exn : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b
(** Same as [get], but unsafe.
@raise Not_found if the element is not present. *)
val set : ?eq:('a->'a->bool) -> 'a -> 'b -> ('a,'b) t -> ('a,'b) t
(** Add the binding into the list (erase it if already present) *)
val set : eq:('a->'a->bool) -> 'a -> 'b -> ('a,'b) t -> ('a,'b) t
(** Add the binding into the list (erase it if already present). *)
val mem : ?eq:('a->'a->bool) -> 'a -> ('a,_) t -> bool
(** [mem x l] returns [true] iff [x] is a key in [l]
val mem : eq:('a->'a->bool) -> 'a -> ('a,_) t -> bool
(** [mem x l] returns [true] iff [x] is a key in [l].
@since 0.16 *)
val update :
?eq:('a->'a->bool) -> f:('b option -> 'b option) -> 'a -> ('a,'b) t -> ('a,'b) t
eq:('a->'a->bool) -> f:('b option -> 'b option) -> 'a -> ('a,'b) t -> ('a,'b) t
(** [update k ~f l] updates [l] on the key [k], by calling [f (get l k)]
and removing [k] if it returns [None], mapping [k] to [v'] if it
returns [Some v']
returns [Some v'].
@since 0.16 *)
val remove : ?eq:('a->'a->bool) -> 'a -> ('a,'b) t -> ('a,'b) t
val remove : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> ('a,'b) t
(** [remove x l] removes the first occurrence of [k] from [l].
@since 0.17 *)
end
val assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b
(** Same as [Assoc.get_exn].
@since NEXT_RELEASE *)
val assoc_opt : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b option
(** Same as [Assoc.get].
@since NEXT_RELEASE *)
val assq_opt : 'a -> ('a * 'b) t -> 'b option
(** Safe version of {!assq}.
@since NEXT_RELEASE *)
val mem_assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * _) t -> bool
(** Same as [Assoc.mem].
@since NEXT_RELEASE *)
val remove_assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> ('a * 'b) t
(** Same as [Assoc.remove].
@since NEXT_RELEASE *)
(** {2 References on Lists}
@since 0.3.3 *)
@ -358,20 +404,20 @@ module Ref : sig
val pop_exn : 'a t -> 'a
(** Unsafe version of {!pop}.
@raise Failure if the list is empty *)
@raise Failure if the list is empty. *)
val create : unit -> 'a t
(** Create a new list reference *)
(** Create a new list reference. *)
val clear : _ t -> unit
(** Remove all elements *)
(** Remove all elements. *)
val lift : ('a list -> 'b) -> 'a t -> 'b
(** Apply a list function to the content *)
(** Apply a list function to the content. *)
val push_list : 'a t -> 'a list -> unit
(** Add elements of the list at the beginning of the list ref. Elements
at the end of the list will be at the beginning of the list ref *)
at the end of the list will be at the beginning of the list ref. *)
end
(** {2 Monadic Operations} *)
@ -408,7 +454,7 @@ val random_len : int -> 'a random_gen -> 'a t random_gen
val random_choose : 'a t -> 'a random_gen
(** Randomly choose an element in the list.
@raise Not_found if the list is empty *)
@raise Not_found if the list is empty. *)
val random_sequence : 'a random_gen t -> 'a t random_gen
@ -423,7 +469,7 @@ val of_klist : 'a klist -> 'a t
(** {2 Infix Operators}
It is convenient to {!open CCList.Infix} to access the infix operators
without cluttering the scope too much.
without cluttering the scope too much.
@since 0.16 *)

22
src/core/CCMap.mli
View file

@ -16,11 +16,11 @@ module type S = sig
include Map.S
val get : key -> 'a t -> 'a option
(** Safe version of {!find} *)
(** Safe version of {!find}. *)
val get_or : key -> 'a t -> default:'a -> 'a
(** [get_or k m ~default] returns the value associated to [k] if present,
and returns [default] otherwise (if [k] doesn't belong in [m])
and returns [default] otherwise (if [k] doesn't belong in [m]).
@since 0.16 *)
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
@ -30,19 +30,19 @@ module type S = sig
[add k v' m] is returned. *)
val choose_opt : 'a t -> (key * 'a) option
(** Safe version of {!choose}
(** Safe version of {!choose}.
@since 1.5 *)
val min_binding_opt : 'a t -> (key * 'a) option
(** Safe version of {!min_binding}
(** Safe version of {!min_binding}.
@since 1.5 *)
val max_binding_opt : 'a t -> (key * 'a) option
(** Safe version of {!max_binding}
(** Safe version of {!max_binding}.
@since 1.5 *)
val find_opt : key -> 'a t -> 'a option
(** Safe version of {!find}
(** Safe version of {!find}.
@since 1.5 *)
val find_first : (key -> bool) -> 'a t -> key * 'a
@ -51,7 +51,7 @@ module type S = sig
@since 1.5 *)
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
(** Safe version of {!find_first}
(** Safe version of {!find_first}.
@since 1.5 *)
val merge_safe :
@ -62,11 +62,11 @@ module type S = sig
val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
(** Union of both maps, using the function to combine bindings
that belong to both inputs
that belong to both inputs.
@since 1.4 *)
val of_seq : (key * 'a) sequence -> 'a t
(** Same as {!of_list} *)
(** Same as {!of_list}. *)
val add_seq : 'a t -> (key * 'a) sequence -> 'a t
(** @since 0.14 *)
@ -83,11 +83,11 @@ module type S = sig
(** @since 0.14 *)
val keys : _ t -> key sequence
(** Iterate on keys only
(** Iterate on keys only.
@since 0.15 *)
val values : 'a t -> 'a sequence
(** Iterate on values only
(** Iterate on values only.
@since 0.15 *)
val to_list : 'a t -> (key * 'a) list

54
src/core/CCParse.ml
View file

@ -43,6 +43,9 @@ type state = {
exception ParseError of parse_branch * (unit -> string)
let char_equal (a : char) b = Pervasives.(=) a b
let string_equal (a : string) b = Pervasives.(=) a b
let rec string_of_branch l =
let pp_s () = function
| None -> ""
@ -83,11 +86,11 @@ let fail_ ~err st msg =
let next st ~ok ~err =
if st.i = String.length st.str
then fail_ st ~err (const_ "unexpected end of input")
then fail_ ~err st (const_ "unexpected end of input")
else (
let c = st.str.[st.i] in
st.i <- st.i + 1;
if c='\n'
if char_equal c '\n'
then (st.lnum <- st.lnum + 1; st.cnum <- 1)
else st.cnum <- st.cnum + 1;
ok c
@ -107,24 +110,24 @@ type 'a t = state -> ok:('a -> unit) -> err:(exn -> unit) -> unit
let return : 'a -> 'a t = fun x _st ~ok ~err:_ -> ok x
let pure = return
let (>|=) : 'a t -> ('a -> 'b) -> 'b t
= fun p f st ~ok ~err -> p st ~err ~ok:(fun x -> ok (f x))
= fun p f st ~ok ~err -> p st ~ok:(fun x -> ok (f x)) ~err
let (>>=) : 'a t -> ('a -> 'b t) -> 'b t
= fun p f st ~ok ~err -> p st ~err ~ok:(fun x -> f x st ~err ~ok)
= fun p f st ~ok ~err -> p st ~ok:(fun x -> f x st ~ok ~err) ~err
let (<*>) : ('a -> 'b) t -> 'a t -> 'b t
= fun f x st ~ok ~err ->
f st ~err ~ok:(fun f' -> x st ~err ~ok:(fun x' -> ok (f' x')))
f st ~ok:(fun f' -> x st ~ok:(fun x' -> ok (f' x')) ~err) ~err
let (<* ) : 'a t -> _ t -> 'a t
= fun x y st ~ok ~err ->
x st ~err ~ok:(fun res -> y st ~err ~ok:(fun _ -> ok res))
x st ~ok:(fun res -> y st ~ok:(fun _ -> ok res) ~err) ~err
let ( *>) : _ t -> 'a t -> 'a t
= fun x y st ~ok ~err ->
x st ~err ~ok:(fun _ -> y st ~err ~ok)
x st ~ok:(fun _ -> y st ~ok ~err) ~err
let map f x = x >|= f
let map2 f x y = pure f <*> x <*> y
let map3 f x y z = pure f <*> x <*> y <*> z
let junk_ st = next st ~err:(fun _ -> assert false) ~ok:ignore
let junk_ st = next st ~ok:ignore ~err:(fun _ -> assert false)
let eoi st ~ok ~err =
if is_done st
@ -145,15 +148,15 @@ let nop _ ~ok ~err:_ = ok()
let char c =
let msg = Printf.sprintf "expected '%c'" c in
fun st ~ok ~err ->
next st ~err
~ok:(fun c' -> if c=c' then ok c else fail_ ~err st (const_ msg))
next st
~ok:(fun c' -> if char_equal c c' then ok c else fail_ ~err st (const_ msg)) ~err
let char_if p st ~ok ~err =
next st ~err
next st
~ok:(fun c ->
if p c then ok c
else fail_ ~err st (fun () -> Printf.sprintf "unexpected char '%c'" c)
)
) ~err
let chars_if p st ~ok ~err:_ =
let i = st.i in
@ -162,11 +165,12 @@ let chars_if p st ~ok ~err:_ =
ok (String.sub st.str i !len)
let chars1_if p st ~ok ~err =
chars_if p st ~err
chars_if p st
~ok:(fun s ->
if s = ""
if string_equal s ""
then fail_ ~err st (const_ "unexpected sequence of chars")
else ok s)
~err
let rec skip_chars p st ~ok ~err =
if not (is_done st) && p (cur st) then (
@ -188,10 +192,11 @@ let space = char_if is_space
let white = char_if is_white
let endline st ~ok ~err =
next st ~err
next st
~ok:(function
| '\n' as c -> ok c
| _ -> fail_ ~err st (const_ "expected end-of-line"))
~err
let skip_space = skip_chars is_space
let skip_white = skip_chars is_white
@ -229,32 +234,33 @@ let string s st ~ok ~err =
let rec check i =
if i = String.length s then ok s
else
next st ~err
next st
~ok:(fun c ->
if c = s.[i]
if char_equal c s.[i]
then check (i+1)
else fail_ ~err st (fun () -> Printf.sprintf "expected \"%s\"" s))
~err
in
check 0
let rec many_rec : 'a t -> 'a list -> 'a list t = fun p acc st ~ok ~err ->
if is_done st then ok(List.rev acc)
else
p st ~err
p st
~ok:(fun x ->
let i = pos st in
many_rec p (x :: acc) st ~ok
~err:(fun _ ->
backtrack st i;
ok(List.rev acc))
)
) ~err
let many : 'a t -> 'a list t
= fun p st ~ok ~err -> many_rec p [] st ~ok ~err
let many1 : 'a t -> 'a list t =
fun p st ~ok ~err ->
p st ~err ~ok:(fun x -> many_rec p [x] st ~err ~ok)
p st ~ok:(fun x -> many_rec p [x] st ~ok ~err) ~err
let rec skip p st ~ok ~err =
let i = pos st in
@ -303,12 +309,12 @@ let memo (type a) (p:a t):a t =
with Not_found ->
(* parse, and save *)
p st
~err:(fun e ->
MemoTbl.H.replace tbl (i,id) (fun () -> r := Some (MemoTbl.Fail e));
err e)
~ok:(fun x ->
MemoTbl.H.replace tbl (i,id) (fun () -> r := Some (MemoTbl.Ok x));
ok x)
~err:(fun e ->
MemoTbl.H.replace tbl (i,id) (fun () -> r := Some (MemoTbl.Fail e));
err e)
let fix_memo f =
let rec p =
@ -386,7 +392,7 @@ module U = struct
skip_white <* string stop
let int =
chars1_if (fun c -> is_num c || c='-')
chars1_if (fun c -> is_num c || char_equal c '-')
>>= fun s ->
try return (int_of_string s)
with Failure _ -> fail "expected an int"

11
src/core/CCRandom.ml
View file

@ -77,7 +77,7 @@ let replicate n g st =
in aux [] n
(* Sample without replacement using rejection sampling. *)
let sample_without_replacement (type elt) ?(compare=compare) k (rng:elt t) st=
let sample_without_replacement (type elt) ~compare k (rng:elt t) st=
let module S = Set.Make(struct type t=elt let compare = compare end) in
let rec aux s k =
if k <= 0 then
@ -117,10 +117,10 @@ let _diff_list ~last l =
∑_k y_k = ∑_k (x_{k+1} - x_k ) = x_{len} - x_0 = i. *)
let split_list i ~len st =
if len <= 1 then invalid_arg "Random.split_list";
if i >= len then
let xs = sample_without_replacement (len-1) (int_range 1 (i-1)) st in
_diff_list ( 0::xs ) ~last:i
else
if i >= len then (
let xs = sample_without_replacement ~compare (len-1) (int_range 1 (i-1)) st in
_diff_list ~last:i (0::xs)
) else
None
(*$Q
@ -221,6 +221,7 @@ let uniformity_test ?(size_hint=10) k rng st =
let confidence = 4. in
let std = confidence *. (sqrt (kf *. variance)) in
let predicate _key n acc =
let (<) (a : float) b = Pervasives.(<) a b in
acc && abs_float (average -. float_of_int n) < std in
Hashtbl.fold predicate histogram true

50
src/core/CCRandom.mli
View file

@ -8,19 +8,21 @@ include module type of Random
type state = Random.State.t
type 'a t = state -> 'a
(** Random generator for values of type ['a] *)
(** Random generator for values of type ['a]. *)
type 'a random_gen = 'a t
val return : 'a -> 'a t
(** [return x] is the generator that always returns [x].
Example: [let random_int = return 4 (* fair dice roll *)] *)
Example: [let random_int = return 4 (* fair dice roll *)]. *)
val flat_map : ('a -> 'b t) -> 'a t -> 'b t
(** [flat_map f g st] = [f (g st) st]. *)
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
val map : ('a -> 'b) -> 'a t -> 'b t
(** [map f g st] = [f (g st)]. *)
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
@ -43,41 +45,41 @@ val choose : 'a t list -> 'a option t
val choose_exn : 'a t list -> 'a t
(** Same as {!choose} but without option.
@raise Invalid_argument if the list is empty *)
@raise Invalid_argument if the list is empty. *)
val choose_array : 'a t array -> 'a option t
val choose_return : 'a list -> 'a t
(** Choose among the list
(** Choose among the list.
@raise Invalid_argument if the list is empty *)
val replicate : int -> 'a t -> 'a list t
(** [replicate n g] makes a list of [n] elements which are all generated
randomly using [g] *)
randomly using [g]. *)
val sample_without_replacement:
?compare:('a -> 'a -> int) -> int -> 'a t -> 'a list t
compare:('a -> 'a -> int) -> int -> 'a t -> 'a list t
(** [sample_without_replacement n g] makes a list of [n] elements which are all
generated randomly using [g] with the added constraint that none of the generated
random values are equal
@raise Invalid_argument if [n <= 0]
random values are equal.
@raise Invalid_argument if [n <= 0].
@since 0.15 *)
val list_seq : 'a t list -> 'a list t
(** Build random lists from lists of random generators
(** Build random lists from lists of random generators.
@since 0.4 *)
exception Pick_from_empty
(** @since 0.16 *)
val pick_list : 'a list -> 'a t
(** Pick an element at random from the list
@raise Pick_from_empty if the list is empty
(** Pick an element at random from the list.
@raise Pick_from_empty if the list is empty.
@since 0.16 *)
val pick_array : 'a array -> 'a t
(** Pick an element at random from the array
@raise Pick_from_empty if the array is empty
(** Pick an element at random from the array.
@raise Pick_from_empty if the array is empty.
@since 0.16 *)
val small_int : int t
@ -85,14 +87,14 @@ val small_int : int t
val int : int -> int t
val int_range : int -> int -> int t
(** Inclusive range *)
(** Inclusive range. *)
val small_float : float t
(** A reasonably small float.
@since 0.6.1 *)
val float : float -> float t
(** Random float within the given range
(** Random float within the given range.
@since 0.6.1 *)
val float_range : float -> float -> float t
@ -101,25 +103,25 @@ val float_range : float -> float -> float t
val split : int -> (int * int) option t
(** Split a positive value [n] into [n1,n2] where [n = n1 + n2].
@return [None] if the value is too small *)
@return [None] if the value is too small. *)
val split_list : int -> len:int -> int list option t
(** Split a value [n] into a list of values whose sum is [n]
and whose length is [length]. The list is never empty and does not
contain [0].
@raise Invalid_argument if [len <= 1]
@return [None] if the value is too small *)
@raise Invalid_argument if [len <= 1].
@return [None] if the value is too small. *)
val retry : ?max:int -> 'a option t -> 'a option t
(** [retry g] calls [g] until it returns some value, or until the maximum
number of retries was reached. If [g] fails,
then it counts for one iteration, and the generator retries.
@param max: maximum number of retries. Default [10] *)
@param max: maximum number of retries. Default [10]. *)
val try_successively : 'a option t list -> 'a option t
(** [try_successively l] tries each generator of [l], one after the other.
If some generator succeeds its result is returned, else the
next generator is tried *)
next generator is tried. *)
val (<?>) : 'a option t -> 'a option t -> 'a option t
(** [a <?> b] is a choice operator. It first tries [a], and returns its
@ -133,9 +135,9 @@ val fix :
(** Recursion combinators, for building recursive values.
The integer generator is used to provide fuel. The [sub_] generators
should use their arguments only once!
@param sub1 cases that recurse on one value
@param sub2 cases that use the recursive gen twice
@param subn cases that use a list of recursive cases *)
@param sub1 cases that recurse on one value.
@param sub2 cases that use the recursive gen twice.
@param subn cases that use a list of recursive cases. *)
(** {6 Applicative} *)
@ -146,7 +148,7 @@ val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
(** {6 Run a generator} *)
val run : ?st:state -> 'a t -> 'a
(** Using a random state (possibly the one in argument) run a generator *)
(** Using a random state (possibly the one in argument) run a generator. *)
(**/**)

4
src/core/CCResult.ml
View file

@ -109,12 +109,12 @@ let (>|=) e f = map f e
let (>>=) e f = flat_map f e
let equal ?(err=Pervasives.(=)) eq a b = match a, b with
let equal ~err eq a b = match a, b with
| Ok x, Ok y -> eq x y
| Error s, Error s' -> err s s'
| _ -> false
let compare ?(err=Pervasives.compare) cmp a b = match a, b with
let compare ~err cmp a b = match a, b with
| Ok x, Ok y -> cmp x y
| Ok _, _ -> 1
| _, Ok _ -> -1

4
src/core/CCResult.mli
View file

@ -96,9 +96,9 @@ val (>|=) : ('a, 'err) t -> ('a -> 'b) -> ('b, 'err) t
val (>>=) : ('a, 'err) t -> ('a -> ('b, 'err) t) -> ('b, 'err) t
val equal : ?err:'err equal -> 'a equal -> ('a, 'err) t equal
val equal : err:'err equal -> 'a equal -> ('a, 'err) t equal
val compare : ?err:'err ord -> 'a ord -> ('a, 'err) t ord
val compare : err:'err ord -> 'a ord -> ('a, 'err) t ord
val fold : ok:('a -> 'b) -> error:('err -> 'b) -> ('a, 'err) t -> 'b
(** [fold ~ok ~error e] opens [e] and, if [e = Ok x], returns

16
src/core/CCSet.mli
View file

@ -15,35 +15,35 @@ module type S = sig
include Set.S
val min_elt_opt : t -> elt option
(** Safe version of {!min_elt}
(** Safe version of {!min_elt}.
@since 1.5 *)
val max_elt_opt : t -> elt option
(** Safe version of {!max_elt}
(** Safe version of {!max_elt}.
@since 1.5 *)
val choose_opt : t -> elt option
(** Safe version of {!choose}
(** Safe version of {!choose}.
@since 1.5 *)
val find_opt : elt -> t -> elt option
(** Safe version of {!find}
(** Safe version of {!find}.
@since 1.5 *)
val find_first : (elt -> bool) -> t -> elt
(** Find minimum element satisfying predicate
(** Find minimum element satisfying predicate.
@since 1.5 *)
val find_first_opt : (elt -> bool) -> t -> elt option
(** Safe version of {!find_first}
(** Safe version of {!find_first}.
@since 1.5 *)
val find_last : (elt -> bool) -> t -> elt
(** Find maximum element satisfying predicate
(** Find maximum element satisfying predicate.
@since 1.5 *)
val find_last_opt : (elt -> bool) -> t -> elt option
(** Safe version of {!find_last}
(** Safe version of {!find_last}.
@since 1.5 *)
val of_seq : elt sequence -> t

52
src/core/CCString.ml
View file

@ -52,12 +52,13 @@ module type S = sig
val to_klist : t -> char klist
val to_list : t -> char list
val pp : Buffer.t -> t -> unit
val print : Format.formatter -> t -> unit
val pp_buf : Buffer.t -> t -> unit
val pp : Format.formatter -> t -> unit
end
let equal (a:string) b = a=b
let equal (a:string) b = Pervasives.(=) a b
let compare_int (a : int) b = Pervasives.compare a b
let compare = String.compare
let hash s = Hashtbl.hash s
@ -78,7 +79,7 @@ let _is_sub ~sub i s j ~len =
let rec check k =
if k = len
then true
else sub.[i+k] = s.[j+k] && check (k+1)
else CCChar.equal sub.[i+k] s.[j+k] && check (k+1)
in
j+len <= String.length s && check 0
@ -126,7 +127,7 @@ module Find = struct
let j = ref 0 in
while !i < len do
match !j with
| _ when get str (!i-1) = get str !j ->
| _ when CCChar.equal (get str (!i-1)) (get str !j) ->
(* substring starting at !j continues matching current char *)
incr j;
failure.(!i) <- !j;
@ -158,7 +159,7 @@ module Find = struct
while !j < pat_len && !i + !j < len do
let c = String.get s (!i + !j) in
let expected = String.get pattern.str !j in
if c = expected
if CCChar.equal c expected
then (
(* char matches *)
incr j;
@ -193,7 +194,7 @@ module Find = struct
while !j < pat_len && !i + !j < len do
let c = String.get s (len - !i - !j - 1) in
let expected = String.get pattern.str (String.length pattern.str - !j - 1) in
if c = expected
if CCChar.equal c expected
then (
(* char matches *)
incr j;
@ -256,14 +257,14 @@ end
let find ?(start=0) ~sub =
let pattern = Find.compile sub in
fun s -> Find.find ~pattern s ~start
fun s -> Find.find ~start ~pattern s
let find_all ?(start=0) ~sub =
let pattern = Find.compile sub in
fun s ->
let i = ref start in
fun () ->
let res = Find.find ~pattern s ~start:!i in
let res = Find.find ~start:!i ~pattern s in
if res = ~-1 then None
else (
i := res + 1; (* possible overlap *)
@ -281,7 +282,7 @@ let mem ?start ~sub s = find ?start ~sub s >= 0
let rfind ~sub =
let pattern = Find.rcompile sub in
fun s -> Find.rfind ~pattern s ~start:(String.length s-1)
fun s -> Find.rfind ~start:(String.length s-1) ~pattern s
(* Replace substring [s.[pos]....s.[pos+len-1]] by [by] in [s] *)
let replace_at_ ~pos ~len ~by s =
@ -292,10 +293,10 @@ let replace_at_ ~pos ~len ~by s =
Buffer.contents b
let replace ?(which=`All) ~sub ~by s =
if sub="" then invalid_arg "CCString.replace";
if is_empty sub then invalid_arg "CCString.replace";
match which with
| `Left ->
let i = find ~sub s ~start:0 in
let i = find ~start:0 ~sub s in
if i>=0 then replace_at_ ~pos:i ~len:(String.length sub) ~by s else s
| `Right ->
let i = rfind ~sub s in
@ -306,7 +307,7 @@ let replace ?(which=`All) ~sub ~by s =
let b = Buffer.create (String.length s) in
let start = ref 0 in
while !start < String.length s do
let i = Find.find ~pattern s ~start:!start in
let i = Find.find ~start:!start ~pattern s in
if i>=0 then (
(* between last and cur occurrences *)
Buffer.add_substring b s !start (i- !start);
@ -338,7 +339,7 @@ module Split = struct
| SplitAt prev -> _split_search ~by s prev
and _split_search ~by s prev =
let j = Find.find ~pattern:by s ~start:prev in
let j = Find.find ~start:prev ~pattern:by s in
if j < 0
then Some (SplitStop, prev, String.length s - prev)
else Some (SplitAt (j+Find.pattern_length by), prev, j-prev)
@ -442,7 +443,7 @@ let compare_versions a b =
| Some _, None -> 1
| None, Some _ -> -1
| Some x, Some y ->
let c = Pervasives.compare x y in
let c = compare_int x y in
if c<>0 then c else cmp_rec a b
in
cmp_rec (Split.gen_cpy ~by:"." a) (Split.gen_cpy ~by:"." b)
@ -480,7 +481,7 @@ let compare_natural a b =
| NC_int _, NC_char _ -> 1
| NC_char _, NC_int _ -> -1
| NC_int x, NC_int y ->
let c = Pervasives.compare x y in
let c = compare_int x y in
if c<>0 then c else cmp_rec a b
in
cmp_rec (chunks a) (chunks b)
@ -490,7 +491,7 @@ let edit_distance s1 s2 =
then length s2
else if length s2 = 0
then length s1
else if s1 = s2
else if equal s1 s2
then 0
else begin
(* distance vectors (v0=previous, v1=current) *)
@ -774,25 +775,20 @@ let exists2 p s1 s2 =
try iter2 (fun c1 c2 -> if p c1 c2 then raise MyExit) s1 s2; false
with MyExit -> true
(** {2 Ascii functions} *)
(** {2 Ascii functions} *)
let equal_caseless s1 s2: bool =
let char_lower c =
if c >= 'A' && c <= 'Z'
then Char.unsafe_chr (Char. code c + 32)
else c
in
String.length s1 = String.length s2 &&
for_all2
(fun c1 c2 -> char_lower c1 = char_lower c2)
(fun c1 c2 -> CCChar.equal (CCChar.lowercase_ascii c1) (CCChar.lowercase_ascii c2))
s1 s2
let pp buf s =
let pp_buf buf s =
Buffer.add_char buf '"';
Buffer.add_string buf s;
Buffer.add_char buf '"'
let print fmt s =
let pp fmt s =
Format.fprintf fmt "\"%s\"" s
module Sub = struct
@ -834,11 +830,11 @@ module Sub = struct
let to_klist (s,i,len) = _to_klist s i len
let to_list (s,i,len) = _to_list s [] i len
let pp buf (s,i,len) =
let pp_buf buf (s,i,len) =
Buffer.add_char buf '"';
Buffer.add_substring buf s i len;
Buffer.add_char buf '"'
let print fmt s =
let pp fmt s =
Format.fprintf fmt "\"%s\"" (copy s)
end

169
src/core/CCString.mli
View file

@ -20,14 +20,14 @@ module type S = sig
val blit : t -> int -> Bytes.t -> int -> int -> unit
(** Similar to {!String.blit}.
Compatible with the [-safe-string] option.
@raise Invalid_argument if indices are not valid *)
@raise Invalid_argument if indices are not valid. *)
(*
val blit_immut : t -> int -> t -> int -> int -> string
(** Immutable version of {!blit}, returning a new string.
[blit a i b j len] is the same as [b], but in which
the range [j, ..., j+len] is replaced by [a.[i], ..., a.[i + len]].
@raise Invalid_argument if indices are not valid *)
@raise Invalid_argument if indices are not valid. *)
*)
val fold : ('a -> char -> 'a) -> 'a -> t -> 'a
@ -41,9 +41,14 @@ module type S = sig
val to_klist : t -> char klist
val to_list : t -> char list
val pp : Buffer.t -> t -> unit
val print : Format.formatter -> t -> unit
(** Print the string within quotes *)
val pp_buf : Buffer.t -> t -> unit
(** Renamed from [pp].
@since NEXT_RELEASE *)
val pp : Format.formatter -> t -> unit
(** Print the string within quotes.
Renamed from [print].
@since NEXT_RELEASE *)
end
(** {2 Strings} *)
@ -69,7 +74,7 @@ val init : int -> (int -> char) -> string
*)
val rev : string -> string
(** [rev s] returns the reverse of [s]
(** [rev s] returns the reverse of [s].
@since 0.17 *)
(*$Q
@ -86,8 +91,8 @@ val rev : string -> string
val pad : ?side:[`Left|`Right] -> ?c:char -> int -> string -> string
(** [pad n str] ensures that [str] is at least [n] bytes long,
and pads it on the [side] with [c] if it's not the case.
@param side determines where padding occurs (default: [`Left])
@param c the char used to pad (default: ' ')
@param side determines where padding occurs (default: [`Left]).
@param c the char used to pad (default: ' ').
@since 0.17 *)
(*$= & ~printer:Q.Print.string
@ -100,7 +105,7 @@ val pad : ?side:[`Left|`Right] -> ?c:char -> int -> string -> string
*)
val of_char : char -> string
(** [of_char 'a' = "a"]
(** [of_char 'a' = "a"].
@since 0.19 *)
val of_gen : char gen -> string
@ -135,13 +140,13 @@ val find : ?start:int -> sub:string -> string -> int
val find_all : ?start:int -> sub:string -> string -> int gen
(** [find_all ~sub s] finds all occurrences of [sub] in [s], even overlapping
instances.
@param start starting position in [s]
@param start starting position in [s].
@since 0.17 *)
val find_all_l : ?start:int -> sub:string -> string -> int list
(** [find_all ~sub s] finds all occurrences of [sub] in [s] and returns
them in a list
@param start starting position in [s]
them in a list.
@param start starting position in [s].
@since 0.17 *)
(*$= & ~printer:Q.Print.(list int)
@ -152,7 +157,7 @@ val find_all_l : ?start:int -> sub:string -> string -> int list
*)
val mem : ?start:int -> sub:string -> string -> bool
(** [mem ~sub s] is true iff [sub] is a substring of [s]
(** [mem ~sub s] is true iff [sub] is a substring of [s].
@since 0.12 *)
(*$T
@ -162,7 +167,7 @@ val mem : ?start:int -> sub:string -> string -> bool
val rfind : sub:string -> string -> int
(** Find [sub] in string from the right, returns its first index or [-1].
Should only be used with very small [sub]
Should only be used with very small [sub].
@since 0.12 *)
(*$= & ~printer:string_of_int
@ -180,14 +185,14 @@ val rfind : sub:string -> string -> int
*)
val replace : ?which:[`Left|`Right|`All] -> sub:string -> by:string -> string -> string
(** [replace ~sub ~by s] replaces some occurrences of [sub] by [by] in [s]
(** [replace ~sub ~by s] replaces some occurrences of [sub] by [by] in [s].
@param which decides whether the occurrences to replace are:
{ul
{- [`Left] first occurrence from the left (beginning)}
{- [`Right] first occurrence from the right (end)}
{- [`All] all occurrences (default)}
}
@raise Invalid_argument if [sub = ""]
@raise Invalid_argument if [sub = ""].
@since 0.14 *)
(*$= & ~printer:CCFun.id
@ -203,13 +208,13 @@ val replace : ?which:[`Left|`Right|`All] -> sub:string -> by:string -> string ->
val is_sub : sub:string -> int -> string -> int -> len:int -> bool
(** [is_sub ~sub i s j ~len] returns [true] iff the substring of
[sub] starting at position [i] and of length [len] is a substring
of [s] starting at position [j] *)
of [s] starting at position [j]. *)
val repeat : string -> int -> string
(** The same string, repeated n times *)
(** The same string, repeated n times. *)
val prefix : pre:string -> string -> bool
(** [prefix ~pre s] returns [true] iff [pre] is a prefix of [s] *)
(** [prefix ~pre s] returns [true] iff [pre] is a prefix of [s]. *)
(*$T
prefix ~pre:"aab" "aabcd"
@ -222,7 +227,7 @@ val prefix : pre:string -> string -> bool
*)
val suffix : suf:string -> string -> bool
(** [suffix ~suf s] returns [true] iff [suf] is a suffix of [s]
(** [suffix ~suf s] returns [true] iff [suf] is a suffix of [s].
@since 0.7 *)
(*$T
@ -234,8 +239,8 @@ val suffix : suf:string -> string -> bool
*)
val chop_prefix : pre:string -> string -> string option
(** [chop_pref ~pre s] removes [pre] from [s] if [pre] really is a prefix
of [s], returns [None] otherwise
(** [chop_prefix ~pre s] removes [pre] from [s] if [pre] really is a prefix
of [s], returns [None] otherwise.
@since 0.17 *)
(*$= & ~printer:Q.Print.(option string)
@ -246,7 +251,7 @@ val chop_prefix : pre:string -> string -> string option
val chop_suffix : suf:string -> string -> string option
(** [chop_suffix ~suf s] removes [suf] from [s] if [suf] really is a suffix
of [s], returns [None] otherwise
of [s], returns [None] otherwise.
@since 0.17 *)
(*$= & ~printer:Q.Print.(option string)
@ -256,15 +261,15 @@ val chop_suffix : suf:string -> string -> string option
*)
val take : int -> string -> string
(** [take n s] keeps only the [n] first chars of [s]
(** [take n s] keeps only the [n] first chars of [s].
@since 0.17 *)
val drop : int -> string -> string
(** [drop n s] removes the [n] first chars of [s]
(** [drop n s] removes the [n] first chars of [s].
@since 0.17 *)
val take_drop : int -> string -> string * string
(** [take_drop n s = take n s, drop n s]
(** [take_drop n s = take n s, drop n s].
@since 0.17 *)
(*$=
@ -274,11 +279,11 @@ val take_drop : int -> string -> string * string
*)
val lines : string -> string list
(** [lines s] returns a list of the lines of [s] (splits along '\n')
(** [lines s] returns a list of the lines of [s] (splits along '\n').
@since 0.10 *)
val lines_gen : string -> string gen
(** [lines_gen s] returns a generator of the lines of [s] (splits along '\n')
(** [lines_gen s] returns a generator of the lines of [s] (splits along '\n').
@since 0.10 *)
(*$= & ~printer:Q.Print.(list @@ Printf.sprintf "%S")
@ -294,11 +299,11 @@ val concat_gen : sep:string -> string gen -> string
@since 0.10 *)
val unlines : string list -> string
(** [unlines l] concatenates all strings of [l], separated with '\n'
(** [unlines l] concatenates all strings of [l], separated with '\n'.
@since 0.10 *)
val unlines_gen : string gen -> string
(** [unlines_gen g] concatenates all strings of [g], separated with '\n'
(** [unlines_gen g] concatenates all strings of [g], separated with '\n'.
@since 0.10 *)
(*$= & ~printer:CCFun.id
@ -320,7 +325,7 @@ val unlines_gen : string gen -> string
val set : string -> int -> char -> string
(** [set s i c] creates a new string which is a copy of [s], except
for index [i], which becomes [c].
@raise Invalid_argument if [i] is an invalid index
@raise Invalid_argument if [i] is an invalid index.
@since 0.12 *)
(*$T
@ -330,19 +335,19 @@ val set : string -> int -> char -> string
*)
val iter : (char -> unit) -> string -> unit
(** Alias to {!String.iter}
(** Alias to {!String.iter}.
@since 0.12 *)
val iteri : (int -> char -> unit) -> string -> unit
(** Iter on chars with their index
(** Iter on chars with their index.
@since 0.12 *)
val map : (char -> char) -> string -> string
(** Map chars
(** Map chars.
@since 0.12 *)
val mapi : (int -> char -> char) -> string -> string
(** Map chars with their index
(** Map chars with their index.
@since 0.12 *)
val filter_map : (char -> char option) -> string -> string
@ -365,8 +370,8 @@ val filter : (char -> bool) -> string -> string
*)
val flat_map : ?sep:string -> (char -> string) -> string -> string
(** Map each chars to a string, then concatenates them all
@param sep optional separator between each generated string
(** Map each chars to a string, then concatenates them all.
@param sep optional separator between each generated string.
@since 0.12 *)
val for_all : (char -> bool) -> string -> bool
@ -380,11 +385,11 @@ val exists : (char -> bool) -> string -> bool
include S with type t := string
val ltrim : t -> t
(** trim space on the left (see {!String.trim} for more details)
(** Trim space on the left (see {!String.trim} for more details).
@since 1.2 *)
val rtrim : t -> t
(** trim space on the right (see {!String.trim} for more details)
(** Trim space on the right (see {!String.trim} for more details).
@since 1.2 *)
(*$= & ~printer:id
@ -408,39 +413,39 @@ val rtrim : t -> t
(** {2 Operations on 2 strings} *)
val map2 : (char -> char -> char) -> string -> string -> string
(** Map pairs of chars
@raise Invalid_argument if the strings have not the same length
(** Map pairs of chars.
@raise Invalid_argument if the strings have not the same length.
@since 0.12 *)
val iter2: (char -> char -> unit) -> string -> string -> unit
(** Iterate on pairs of chars
@raise Invalid_argument if the strings have not the same length
(** Iterate on pairs of chars.
@raise Invalid_argument if the strings have not the same length.
@since 0.12 *)
val iteri2: (int -> char -> char -> unit) -> string -> string -> unit
(** Iterate on pairs of chars with their index
@raise Invalid_argument if the strings have not the same length
(** Iterate on pairs of chars with their index.
@raise Invalid_argument if the strings have not the same length.
@since 0.12 *)
val fold2: ('a -> char -> char -> 'a) -> 'a -> string -> string -> 'a
(** Fold on pairs of chars
@raise Invalid_argument if the strings have not the same length
(** Fold on pairs of chars.
@raise Invalid_argument if the strings have not the same length.
@since 0.12 *)
val for_all2 : (char -> char -> bool) -> string -> string -> bool
(** All pairs of chars respect the predicate?
@raise Invalid_argument if the strings have not the same length
@raise Invalid_argument if the strings have not the same length.
@since 0.12 *)
val exists2 : (char -> char -> bool) -> string -> string -> bool
(** Exists a pair of chars?
@raise Invalid_argument if the strings have not the same length
@raise Invalid_argument if the strings have not the same length.
@since 0.12 *)
(** {2 Ascii functions}
Those functions are deprecated in {!String} since 4.03, so we provide
a stable alias for them even in older versions *)
a stable alias for them even in older versions. *)
val capitalize_ascii : string -> string
(** See {!String}. @since 0.18 *)
@ -472,7 +477,7 @@ val equal_caseless : string -> string -> bool
(** {2 Finding}
A relatively efficient algorithm for finding sub-strings
A relatively efficient algorithm for finding sub-strings.
@since 1.0 *)
module Find : sig
@ -483,14 +488,14 @@ module Find : sig
val rcompile : string -> [ `Reverse ] pattern
val find : ?start:int -> pattern:[`Direct] pattern -> string -> int
(** Search for [pattern] in the string, left-to-right
@return the offset of the first match, -1 otherwise
@param start offset in string at which we start *)
(** Search for [pattern] in the string, left-to-right.
@return the offset of the first match, -1 otherwise.
@param start offset in string at which we start. *)
val rfind : ?start:int -> pattern:[`Reverse] pattern -> string -> int
(** Search for [pattern] in the string, right-to-left
@return the offset of the start of the first match from the right, -1 otherwise
@param start right-offset in string at which we start *)
(** Search for [pattern] in the string, right-to-left.
@return the offset of the start of the first match from the right, -1 otherwise.
@param start right-offset in string at which we start. *)
end
(** {2 Splitting} *)
@ -498,10 +503,10 @@ end
module Split : sig
(** Specification of what to do with empty blocks, as in [split ~by:"-" "-a-b-"].
- [{first=false; last=false}] will return [""; "a"; "b"; ""]
- [{first=true; last=false}] will return ["a"; "b" ""]
- [{first=false; last=true}] will return [""; "a"; "b"]
- [{first=true; last=true}] will return ["a"; "b"]
- [{first=false; last=false}] will return [""; "a"; "b"; ""].
- [{first=true; last=false}] will return ["a"; "b" ""].
- [{first=false; last=true}] will return [""; "a"; "b"].
- [{first=true; last=true}] will return ["a"; "b"].
The default value of all remaining functions is [Drop_none].
@since 1.5
@ -512,17 +517,17 @@ module Split : sig
}
val no_drop : drop_if_empty
(** Do not drop any group, even empty and on borders
(** Do not drop any group, even empty and on borders.
@since 1.5 *)
val list_ : ?drop:drop_if_empty -> by:string -> string -> (string*int*int) list
(** Eplit the given string along the given separator [by]. Should only
(** Split the given string along the given separator [by]. Should only
be used with very small separators, otherwise
use {!Containers_string.KMP}.
@return a list of slices [(s,index,length)] that are
separated by [by]. {!String.sub} can then be used to actually extract
a string from the slice.
@raise Failure if [by = ""] *)
@raise Failure if [by = ""]. *)
val gen : ?drop:drop_if_empty -> by:string -> string -> (string*int*int) gen
@ -533,7 +538,7 @@ module Split : sig
(** {6 Copying functions}
Those split functions actually copy the substrings, which can be
more convenient but less efficient in general *)
more convenient but less efficient in general. *)
val list_cpy : ?drop:drop_if_empty -> by:string -> string -> string list
@ -551,12 +556,12 @@ module Split : sig
val left : by:string -> string -> (string * string) option
(** Split on the first occurrence of [by] from the leftmost part of
the string
the string.
@since 0.12 *)
val left_exn : by:string -> string -> string * string
(** Split on the first occurrence of [by] from the leftmost part of the string
@raise Not_found if [by] is not part of the string
(** Split on the first occurrence of [by] from the leftmost part of the string.
@raise Not_found if [by] is not part of the string.
@since 0.16 *)
(*$T
@ -569,12 +574,12 @@ module Split : sig
val right : by:string -> string -> (string * string) option
(** Split on the first occurrence of [by] from the rightmost part of
the string
the string.
@since 0.12 *)
val right_exn : by:string -> string -> string * string
(** Split on the first occurrence of [by] from the rightmost part of the string
@raise Not_found if [by] is not part of the string
(** Split on the first occurrence of [by] from the rightmost part of the string.
@raise Not_found if [by] is not part of the string.
@since 0.16 *)
(*$T
@ -586,7 +591,7 @@ module Split : sig
end
val split_on_char : char -> string -> string list
(** Split the string along the given char
(** Split the string along the given char.
@since 1.2 *)
(*$= & ~printer:Q.Print.(list string)
@ -601,7 +606,7 @@ val split_on_char : char -> string -> string list
*)
val split : by:string -> string -> string list
(** Alias to {!Split.list_cpy}
(** Alias to {!Split.list_cpy}.
@since 1.2 *)
(** {2 Utils} *)
@ -652,7 +657,7 @@ val compare_natural : string -> string -> int
val edit_distance : string -> string -> int
(** Edition distance between two strings. This satisfies the classical
distance axioms: it is always positive, symmetric, and satisfies
the formula [distance a b + distance b c >= distance a c] *)
the formula [distance a b + distance b c >= distance a c]. *)
(*$Q
Q.(string_of_size Gen.(0 -- 30)) (fun s -> \
@ -663,7 +668,7 @@ val edit_distance : string -> string -> int
a string s' that is accepted by a.
--> generate triples (s, i, c) where c is a char, s a non empty string
and i a valid index in s
and i a valid index in s.
*)
(*$QR
@ -687,24 +692,24 @@ val edit_distance : string -> string -> int
module Sub : sig
type t = string * int * int
(** A string, an offset, and the length of the slice *)
(** A string, an offset, and the length of the slice. *)
val make : string -> int -> len:int -> t
val full : string -> t
(** Full string *)
(** Full string. *)
val copy : t -> string
(** Make a copy of the substring *)
(** Make a copy of the substring. *)
val underlying : t -> string
val sub : t -> int -> int -> t
(** Sub-slice *)
(** Sub-slice. *)
val get : t -> int -> char
(** [get s i] gets the [i]-th element, or fails
@raise Invalid_argument if the index is not within [0... length -1]
(** [get s i] gets the [i]-th element, or fails.
@raise Invalid_argument if the index is not within [0 ... length - 1].
@since 1.2 *)
include S with type t := t
@ -718,7 +723,7 @@ module Sub : sig
(*$T
let sub = Sub.make " abc " 1 ~len:3 in \
"\"abc\"" = (CCFormat.to_string Sub.print sub)
"\"abc\"" = (CCFormat.to_string Sub.pp sub)
*)
(*$= & ~printer:(String.make 1)

4
src/core/CCVector.ml
View file

@ -297,7 +297,7 @@ let compare cmp v1 v2 =
let n = min v1.size v2.size in
let rec check i =
if i = n
then Pervasives.compare v1.size v2.size
then compare v1.size v2.size
else
let c = cmp (get v1 i) (get v2 i) in
if c = 0 then check (i+1) else c
@ -513,7 +513,7 @@ let for_all p v =
else p v.vec.(i) && check (i+1)
in check 0
let member ?(eq=(=)) x v =
let member ~eq x v =
exists (eq x) v
let find_exn p v =

2
src/core/CCVector.mli
View file

@ -118,7 +118,7 @@ val shrink : ('a, rw) t -> int -> unit
(** Shrink to the given size (remove elements above this size).
Does nothing if the parameter is bigger than the current size. *)
val member : ?eq:('a -> 'a -> bool) -> 'a -> ('a, _) t -> bool
val member : eq:('a -> 'a -> bool) -> 'a -> ('a, _) t -> bool
(** Is the element a member of the vector? *)
val sort : ('a -> 'a -> int) -> ('a, _) t -> ('a, 'mut) t

3
src/core/containers.ml
View file

@ -42,3 +42,6 @@ module Result = CCResult
module Set = CCSet
module String = CCString
module Vector = CCVector
module Monomorphic = CCMonomorphic
include Monomorphic

9
src/core/jbuild Normal file
View file

@ -0,0 +1,9 @@
(library
((name containers)
(public_name containers)
(wrapped false)
(flags (:standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -nolabels -open CCMonomorphic))
(ocamlopt_flags (:standard (:include ../flambda.flags)))
(libraries (bytes result containers.monomorphic))
))

12
src/data/CCBV.ml
View file

@ -257,17 +257,21 @@ let iter bv f =
[30; 100; 255; 256;10_000]
*)
(*$inject
let seq_zip s k = s (fun x y -> k(x,y))
*)
(*$= & ~printer:Q.Print.(list (pair int bool))
[] (iter (create ~size:0 false) |> Sequence.zip |> Sequence.to_list)
[] (iter (create ~size:0 false) |> seq_zip |> Sequence.to_list)
[0, false; 1, true; 2, false] \
(iter (let bv = create ~size:3 false in set bv 1; bv) |> Sequence.zip |> Sequence.to_list)
(iter (let bv = create ~size:3 false in set bv 1; bv) |> seq_zip |> Sequence.to_list)
*)
(*$Q
Q.(small_int) (fun n -> \
assert (n >= 0); \
let bv = create ~size:n true in \
let l = iter bv |> Sequence.zip |> Sequence.to_list in \
let l = iter bv |> seq_zip |> Sequence.to_list in \
List.length l = n && List.for_all (fun (_,b) -> b) l)
*)
@ -549,7 +553,7 @@ let of_seq seq =
|> CCList.of_seq |> List.sort CCOrd.compare = CCList.range 0 10
*)
let print out bv =
let pp out bv =
Format.pp_print_string out "bv {";
iter bv
(fun _i b ->

42
src/data/CCBV.mli
View file

@ -16,13 +16,13 @@ type t
(** A resizable bitvector *)
val empty : unit -> t
(** Empty bitvector *)
(** Empty bitvector. *)
val create : size:int -> bool -> t
(** Create a bitvector of given size, with given default value *)
(** Create a bitvector of given size, with given default value. *)
val copy : t -> t
(** Copy of bitvector *)
(** Copy of bitvector. *)
val cardinal : t -> int
(** Number of bits set to one, seen as a set of bits. *)
@ -51,7 +51,7 @@ val set : t -> int -> unit
(** Set i-th bit, extending the bitvector if needed. *)
val get : t -> int -> bool
(** Is the i-th bit true? Returns false if the index is too high*)
(** Is the i-th bit true? Returns false if the index is too high. *)
val reset : t -> int -> unit
(** Set i-th bit to 0, extending the bitvector if needed. *)
@ -60,20 +60,20 @@ val flip : t -> int -> unit
(** Flip i-th bit, extending the bitvector if needed. *)
val clear : t -> unit
(** Set every bit to 0 *)
(** Set every bit to 0. *)
val iter : t -> (int -> bool -> unit) -> unit
(** Iterate on all bits *)
(** Iterate on all bits. *)
val iter_true : t -> (int -> unit) -> unit
(** Iterate on bits set to 1 *)
(** Iterate on bits set to 1. *)
val to_list : t -> int list
(** List of indexes that are true *)
(** List of indexes that are true. *)
val to_sorted_list : t -> int list
(** Same as {!to_list}, but also guarantees the list is sorted in
increasing order *)
increasing order. *)
val of_list : int list -> t
(** From a list of true bits.
@ -87,12 +87,12 @@ val first : t -> int option
val first_exn : t -> int
(** First set bit, or
@raise Not_found if all bits are 0
@raise Not_found if all bits are 0.
@since 1.2 *)
val filter : t -> (int -> bool) -> unit
(** [filter bv p] only keeps the true bits of [bv] whose [index]
satisfies [p index] *)
satisfies [p index]. *)
val negate_self : t -> unit
(** [negate_self t] flips all of the bits in [t].
@ -103,28 +103,26 @@ val negate : t -> t
(** [negate t] returns a copy of [t] with all of the bits flipped. *)
val union_into : into:t -> t -> unit
(** [union ~into bv] sets [into] to the union of itself and [bv].
(** [union_into ~into bv] sets [into] to the union of itself and [bv].
Also updates the length of [into] to be at least [length bv]. *)
val inter_into : into:t -> t -> unit
(** [inter ~into bv] sets [into] to the intersection of itself and [bv]
(** [inter_into ~into bv] sets [into] to the intersection of itself and [bv].
Also updates the length of [into] to be at most [length bv]. *)
val union : t -> t -> t
(** [union bv1 bv2] returns the union of the two sets *)
(** [union bv1 bv2] returns the union of the two sets. *)
val inter : t -> t -> t
(** [inter bv1 bv2] returns the intersection of the two sets *)
(** [inter bv1 bv2] returns the intersection of the two sets. *)
val diff_into : into:t -> t -> unit
(** [diff ~into t] Modify [into] with only the bits set but not in [t].
(** [diff_into ~into t] modifies [into] with only the bits set but not in [t].
@since 1.2 *)
val diff : t -> t -> t
(** [diff t1 t2] Return those bits found [t1] but not in [t2].
(** [diff t1 t2] returns those bits found in [t1] but not in [t2].
@since 1.2 *)
@ -135,13 +133,13 @@ val select : t -> 'a array -> 'a list
selected. *)
val selecti : t -> 'a array -> ('a * int) list
(** Same as {!select}, but selected elements are paired with their index *)
(** Same as {!select}, but selected elements are paired with their indexes. *)
type 'a sequence = ('a -> unit) -> unit
val to_seq : t -> int sequence
val of_seq : int sequence -> t
val print : Format.formatter -> t -> unit
(** Print the bitvector as a string of bits
val pp : Format.formatter -> t -> unit
(** Print the bitvector as a string of bits.
@since 0.13 *)

18
src/data/CCBitField.mli
View file

@ -25,13 +25,13 @@
*)
exception TooManyFields
(** Raised when too many fields are packed into one bitfield *)
(** Raised when too many fields are packed into one bitfield. *)
exception Frozen
(** Raised when a frozen bitfield is modified *)
(** Raised when a frozen bitfield is modified. *)
val max_width : int
(** System-dependent maximum width for a bitfield, typically 30 or 62 *)
(** System-dependent maximum width for a bitfield, typically 30 or 62. *)
(** {2 Bitfield Signature} *)
module type S = sig
@ -40,25 +40,25 @@ module type S = sig
should create a new, incompatible type *)
val empty : t
(** Empty bitfields (all bits 0) *)
(** Empty bitfields (all bits 0). *)
type field
val get : field -> t -> bool
(** Get the value of this field *)
(** Get the value of this field. *)
val set : field -> bool -> t -> t
(** Set the value of this field *)
(** Set the value of this field. *)
val mk_field : unit -> field
(** Make a new field *)
(** Make a new field. *)
val freeze : unit -> unit
(** Prevent new fields from being added. From now on, creating
a field will raise Frozen *)
a field will raise Frozen. *)
val total_width : unit -> int
(** Current width of the bitfield *)
(** Current width of the bitfield. *)
end
(** Create a new bitfield type *)

25
src/data/CCCache.ml
View file

@ -6,7 +6,6 @@
type 'a equal = 'a -> 'a -> bool
type 'a hash = 'a -> int
let default_eq_ = Pervasives.(=)
let default_hash_ = Hashtbl.hash
(** {2 Value interface} *)
@ -57,7 +56,7 @@ let with_cache_rec ?(cb=default_callback_) c f =
f'
(*$R
let c = unbounded 256 in
let c = unbounded ~eq:CCInt.equal 256 in
let fib = with_cache_rec c
(fun self n -> match n with
| 1 | 2 -> 1
@ -124,7 +123,7 @@ module Linear = struct
!r
end
let linear ?(eq=default_eq_) size =
let linear ~eq size =
let size = max size 1 in
let arr = Linear.make eq size in
{ get=(fun x -> Linear.get arr x);
@ -161,9 +160,13 @@ module Replacing = struct
| Pair _
| Empty -> raise Not_found
let is_empty = function
| Empty -> true
| Pair _ -> false
let set c x y =
let i = c.hash x mod Array.length c.arr in
if c.arr.(i) = Empty then c.c_size <- c.c_size + 1;
if is_empty c.arr.(i) then c.c_size <- c.c_size + 1;
c.arr.(i) <- Pair (x,y)
let iter c f =
@ -172,7 +175,7 @@ module Replacing = struct
let size c () = c.c_size
end
let replacing ?(eq=default_eq_) ?(hash=default_hash_) size =
let replacing ~eq ?(hash=default_hash_) size =
let c = Replacing.make eq hash size in
{ get=(fun x -> Replacing.get c x);
set=(fun x y -> Replacing.set c x y);
@ -219,7 +222,7 @@ module LRU(X:HASH) = struct
(* take first from queue *)
let take_ c =
match c.first with
| Some n when n.next == n ->
| Some n when Pervasives.(==) n.next n ->
(* last element *)
c.first <- None;
n
@ -238,7 +241,7 @@ module LRU(X:HASH) = struct
n.next <- n;
n.prev <- n;
c.first <- Some n
| Some n1 when n1==n -> ()
| Some n1 when Pervasives.(==) n1 n -> ()
| Some n1 ->
n.prev <- n1.prev;
n.next <- n1;
@ -294,7 +297,7 @@ module LRU(X:HASH) = struct
H.iter (fun x node -> f x node.value) c.table
end
let lru (type a) ?(eq=default_eq_) ?(hash=default_hash_) size =
let lru (type a) ~eq ?(hash=default_hash_) size =
let module L = LRU(struct
type t = a
let equal = eq
@ -318,7 +321,7 @@ let lru (type a) ?(eq=default_eq_) ?(hash=default_hash_) size =
(*$T
let f = (let r = ref 0 in fun _ -> incr r; !r) in \
let c = lru 2 in \
let c = lru ~eq:CCInt.equal 2 in \
let res1 = with_cache c f 1 in \
let res2 = with_cache c f 2 in \
let res3 = with_cache c f 3 in \
@ -328,7 +331,7 @@ let lru (type a) ?(eq=default_eq_) ?(hash=default_hash_) size =
(*$R
let f = (let r = ref 0 in fun _ -> incr r; !r) in
let c = lru 2 in
let c = lru ~eq:CCEqual.unit 2 in
let x = with_cache c f () in
assert_equal 1 x;
assert_equal 1 (size c);
@ -356,7 +359,7 @@ module UNBOUNDED(X:HASH) = struct
let iter c f = H.iter f c
end
let unbounded (type a) ?(eq=default_eq_) ?(hash=default_hash_) size =
let unbounded (type a) ~eq ?(hash=default_hash_) size =
let module C = UNBOUNDED(struct
type t = a
let equal = eq

20
src/data/CCCache.mli
View file

@ -29,7 +29,7 @@ type 'a hash = 'a -> int
type ('a, 'b) t
val clear : (_,_) t -> unit
(** Clear the content of the cache *)
(** Clear the content of the cache. *)
type ('a, 'b) callback = in_cache:bool -> 'a -> 'b -> unit
(** Type of the callback that is called once a cached value is found
@ -44,7 +44,7 @@ val with_cache : ?cb:('a, 'b) callback -> ('a, 'b) t -> ('a -> 'b) -> 'a -> 'b
cache [c]. It always returns the same value as
[f x], if [f x] returns, or raise the same exception.
However, [f] may not be called if [x] is in the cache.
@param cb called after the value is generated or retrieved *)
@param cb called after the value is generated or retrieved. *)
val with_cache_rec : ?cb:('a, 'b) callback -> ('a,'b) t -> (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b
(** [with_cache_rec c f] is a function that first, applies [f] to
@ -61,7 +61,7 @@ val with_cache_rec : ?cb:('a, 'b) callback -> ('a,'b) t -> (('a -> 'b) -> 'a ->
fib 70;;
]}
@param cb called after the value is generated or retrieved
@param cb called after the value is generated or retrieved.
*)
val size : (_,_) t -> int
@ -72,20 +72,20 @@ val iter : ('a,'b) t -> ('a -> 'b -> unit) -> unit
(** Iterate on cached values. Should yield [size cache] pairs. *)
val add : ('a, 'b) t -> 'a -> 'b -> bool
(** Manually add a cached value. Returns [true] if the value has succesfully
(** Manually add a cached value. Returns [true] if the value has successfully
been added, and [false] if the value was already bound.
@since 1.5 *)
val dummy : ('a,'b) t
(** Dummy cache, never stores any value *)
(** Dummy cache, never stores any value. *)
val linear : ?eq:'a equal -> int -> ('a, 'b) t
val linear : eq:'a equal -> int -> ('a, 'b) t
(** Linear cache with the given size. It stores key/value pairs in
an array and does linear search at every call, so it should only be used
with small size.
@param eq optional equality predicate for keys *)
@param eq optional equality predicate for keys. *)
val replacing : ?eq:'a equal -> ?hash:'a hash ->
val replacing : eq:'a equal -> ?hash:'a hash ->
int -> ('a,'b) t
(** Replacing cache of the given size. Equality and hash functions can be
parametrized. It's a hash table that handles collisions by replacing
@ -93,12 +93,12 @@ val replacing : ?eq:'a equal -> ?hash:'a hash ->
entry with the same hash (modulo size) is added).
Never grows wider than the given size. *)
val lru : ?eq:'a equal -> ?hash:'a hash ->
val lru : eq:'a equal -> ?hash:'a hash ->
int -> ('a,'b) t
(** LRU cache of the given size ("Least Recently Used": keys that have not been
used recently are deleted first). Never grows wider than the given size. *)
val unbounded : ?eq:'a equal -> ?hash:'a hash ->
val unbounded : eq:'a equal -> ?hash:'a hash ->
int -> ('a,'b) t
(** Unbounded cache, backed by a Hash table. Will grow forever
unless {!clear} is called manually. *)

23
src/data/CCDeque.ml
View file

@ -74,9 +74,11 @@ let is_zero_ n = match n.cell with
| Two _
| Three _ -> false
let bool_eq (a : bool) b = Pervasives.(=) a b
let is_empty d =
let res = d.size = 0 in
assert (res = is_zero_ d.cur);
assert (bool_eq res (is_zero_ d.cur));
res
let push_front d x =
@ -161,7 +163,7 @@ let take_back_node_ n = match n.cell with
let take_back d =
if is_empty d then raise Empty
else if d.cur == d.cur.prev
else if Pervasives.(==) d.cur d.cur.prev
then (
(* only one cell *)
decr_size_ d;
@ -194,7 +196,7 @@ let take_front_node_ n = match n.cell with
let take_front d =
if is_empty d then raise Empty
else if d.cur.prev == d.cur
else if Pervasives.(==) d.cur.prev d.cur
then (
(* only one cell *)
decr_size_ d;
@ -253,7 +255,7 @@ let fold f acc d =
| Two (x,y) -> f (f acc x) y
| Three (x,y,z) -> f (f (f acc x) y) z
in
if n.next == first then acc else aux ~first f acc n.next
if Pervasives.(==) n.next first then acc else aux ~first f acc n.next
in
aux ~first:d.cur f acc d.cur
@ -335,7 +337,7 @@ let to_gen q =
let cell = ref q.cur.cell in
let cur = ref q.cur in
let rec next () = match !cell with
| Zero when (!cur).next == first -> None
| Zero when Pervasives.(==) (!cur).next first -> None
| Zero ->
(* go to next node *)
let n = !cur in
@ -367,7 +369,7 @@ let copy d =
let q = of_list [1;2;3;4] in
assert_equal 4 (length q);
let q' = copy q in
let cmp = equal ?eq:None in
let cmp = equal ~eq:CCInt.equal in
assert_equal 4 (length q');
assert_equal ~cmp q q';
push_front q 0;
@ -377,7 +379,7 @@ let copy d =
assert_equal ~cmp q q'
*)
let equal ?(eq=(=)) a b =
let equal ~eq a b =
let rec aux eq a b = match a() , b() with
| None, None -> true
| None, Some _
@ -385,7 +387,7 @@ let equal ?(eq=(=)) a b =
| Some x, Some y -> eq x y && aux eq a b
in aux eq (to_gen a) (to_gen b)
let compare ?(cmp=Pervasives.compare) a b =
let compare ~cmp a b =
let rec aux cmp a b = match a() , b() with
| None, None -> 0
| None, Some _ -> -1
@ -397,13 +399,13 @@ let compare ?(cmp=Pervasives.compare) a b =
(*$Q
Q.(pair (list int) (list int)) (fun (l1,l2) -> \
CCOrd.equiv (compare (of_list l1) (of_list l2)) \
CCOrd.equiv (compare ~cmp:Pervasives.compare (of_list l1) (of_list l2)) \
(CCList.compare Pervasives.compare l1 l2))
*)
type 'a printer = Format.formatter -> 'a -> unit
let print pp_x out d =
let pp pp_x out d =
let first = ref true in
Format.fprintf out "@[<hov2>deque {";
iter
@ -412,4 +414,3 @@ let print pp_x out d =
pp_x out x
) d;
Format.fprintf out "}@]"

62
src/data/CCDeque.mli
View file

@ -4,7 +4,7 @@
(** {1 Imperative deque}
This structure provides fast access to its front and back elements,
with O(1) operations*)
with O(1) operations *)
type 'a t
(** Contains 'a elements, queue in both ways *)
@ -12,64 +12,64 @@ type 'a t
exception Empty
val create : unit -> 'a t
(** New deque *)
(** New deque. *)
val clear : _ t -> unit
(** Remove all elements
(** Remove all elements.
@since 0.13 *)
val is_empty : 'a t -> bool
(** Is the deque empty? *)
val equal : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val equal : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** [equal a b] checks whether [a] and [b] contain the same sequence of
elements.
@param eq comparison function for elements
@param eq comparison function for elements.
@since 0.13 *)
val compare : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
val compare : cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
(** [compare a b] compares lexicographically [a] and [b]
@param cmp comparison function for elements
@param cmp comparison function for elements.
@since 0.13 *)
val length : 'a t -> int
(** Number of elements
used to be linear time, now constant time *)
(** Number of elements.
Used to be linear time, now constant time. *)
val push_front : 'a t -> 'a -> unit
(** Push value at the front *)
(** Push value at the front. *)
val push_back : 'a t -> 'a -> unit
(** Push value at the back *)
(** Push value at the back. *)
val peek_front : 'a t -> 'a
(** First value, or @raise Empty if empty *)
(** First value, or @raise Empty if empty. *)
val peek_back : 'a t -> 'a
(** Last value, or @raise Empty if empty *)
(** Last value, or @raise Empty if empty. *)
val take_back : 'a t -> 'a
(** Take last value, or @raise Empty if empty *)
(** Take last value, or @raise Empty if empty. *)
val take_front : 'a t -> 'a
(** Take first value, or @raise Empty if empty *)
(** Take first value, or @raise Empty if empty. *)
val append_front : into:'a t -> 'a t -> unit
(** [append_front ~into q] adds all elements of [q] at the front
of [into]
O(length q) in time
of [into].
[O(length q)] in time.
@since 0.13 *)
val append_back : into:'a t -> 'a t -> unit
(** [append_back ~into q] adds all elements of [q] at the back of [into].
O(length q) in time
[O(length q)] in time.
@since 0.13 *)
val iter : ('a -> unit) -> 'a t -> unit
(** Iterate on elements *)
(** Iterate on elements. *)
val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
(** Fold on elements
(** Fold on elements.
@since 0.13 *)
(** {2 Conversions} *)
@ -80,36 +80,36 @@ type 'a sequence = ('a -> unit) -> unit
val of_seq : 'a sequence -> 'a t
(** Create a deque from the sequence.
@since 0.13 optional argument [deque] disappears, use
{!add_seq_back} instead *)
{!add_seq_back} instead. *)
val to_seq : 'a t -> 'a sequence
(** iterate on the elements *)
(** Iterate on the elements. *)
val of_gen : 'a gen -> 'a t
(** [of_gen g] makes a deque containing the elements of [g]
(** [of_gen g] makes a deque containing the elements of [g].
@since 0.13 *)
val to_gen : 'a t -> 'a gen
(** Iterates on elements of the deque
(** Iterate on elements of the deque.
@since 0.13 *)
val add_seq_front : 'a t -> 'a sequence -> unit
(** [add_seq_front q seq] adds elements of [seq] into the front of [q],
in reverse order.
O(n) in time, where [n] is the number of elements to add.
[O(n)] in time, where [n] is the number of elements to add.
@since 0.13 *)
val add_seq_back : 'a t -> 'a sequence -> unit
(** [add_seq_back q seq] adds elements of [seq] into the back of [q],
in order.
O(n) in time, where [n] is the number of elements to add.
[O(n)] in time, where [n] is the number of elements to add.
@since 0.13 *)
val copy : 'a t -> 'a t
(** Fresh copy, O(n) in time *)
(** Fresh copy, [O(n)] in time. *)
val of_list : 'a list -> 'a t
(** Conversion from list, in order
(** Conversion from list, in order.
@since 0.13 *)
val to_list : 'a t -> 'a list
@ -117,13 +117,13 @@ val to_list : 'a t -> 'a list
@since 0.13 *)
val to_rev_list : 'a t -> 'a list
(** Efficient conversion to list, in reverse order
(** Efficient conversion to list, in reverse order.
@since 0.13 *)
(** {2 print} *)
type 'a printer = Format.formatter -> 'a -> unit
val print : 'a printer -> 'a t printer
(** Print the elements
val pp : 'a printer -> 'a t printer
(** Print the elements.
@since 0.13 *)

8
src/data/CCFQueue.ml
View file

@ -34,10 +34,14 @@ let empty = Shallow Zero
exception Empty
let is_not_zero = function
| Zero -> false
| One _ | Two _ | Three _ -> true
let _single x = Shallow (One x)
let _double x y = Shallow (Two (x,y))
let _deep n hd middle tl =
assert (hd<>Zero && tl<>Zero);
assert (is_not_zero hd && is_not_zero tl);
Deep (n, hd, middle, tl)
let is_empty = function
@ -511,7 +515,7 @@ let (--^) a b =
0 --^ 0 |> to_list = []
*)
let print pp_x out d =
let pp pp_x out d =
let first = ref true in
Format.fprintf out "@[<hov2>queue {";
iter

46
src/data/CCFQueue.mli
View file

@ -24,67 +24,67 @@ val doubleton : 'a -> 'a -> 'a t
exception Empty
val cons : 'a -> 'a t -> 'a t
(** Push element at the front of the queue *)
(** Push element at the front of the queue. *)
val snoc : 'a t -> 'a -> 'a t
(** Push element at the end of the queue *)
(** Push element at the end of the queue. *)
val take_front : 'a t -> ('a * 'a t) option
(** Get and remove the first element *)
(** Get and remove the first element. *)
val take_front_exn : 'a t -> ('a * 'a t)
(** Same as {!take_front}, but fails on empty queues.
@raise Empty if the queue is empty *)
@raise Empty if the queue is empty. *)
val take_front_l : int -> 'a t -> 'a list * 'a t
(** [take_front_l n q] takes at most [n] elements from the front
of [q], and returns them wrapped in a list
@raise Invalid_argument if n<0 *)
of [q], and returns them wrapped in a list.
@raise Invalid_argument if n<0. *)
val take_front_while : ('a -> bool) -> 'a t -> 'a list * 'a t
val take_back : 'a t -> ('a t * 'a) option
(** Take last element *)
(** Take last element. *)
val take_back_exn : 'a t -> ('a t * 'a)
(** Same as {!take_back}, but fails on empty queues.
@raise Empty if the queue is empty *)
@raise Empty if the queue is empty. *)
val take_back_l : int -> 'a t -> 'a t * 'a list
(** [take_back_l n q] removes and returns the last [n] elements of [q]. The
elements are in the order of the queue, that is, the head of the returned
list is the first element to appear via {!take_front}.
[take_back_l 2 (of_list [1;2;3;4]) = of_list [1;2], [3;4]]
@raise Invalid_argument if n<0 *)
[take_back_l 2 (of_list [1;2;3;4]) = of_list [1;2], [3;4]].
@raise Invalid_argument if n<0. *)
val take_back_while : ('a -> bool) -> 'a t -> 'a t * 'a list
(** {2 Individual extraction} *)
val first : 'a t -> 'a option
(** First element of the queue *)
(** First element of the queue. *)
val last : 'a t -> 'a option
(** Last element of the queue *)
(** Last element of the queue. *)
val first_exn : 'a t -> 'a
(** Same as {!first} but
@raise Empty if the queue is empty *)
@raise Empty if the queue is empty. *)
val last_exn : 'a t -> 'a
val nth : int -> 'a t -> 'a option
(** Return the [i]-th element of the queue in logarithmic time *)
(** Return the [i]-th element of the queue in logarithmic time. *)
val nth_exn : int -> 'a t -> 'a
(** Unsafe version of {!nth}
@raise Not_found if the index is wrong *)
(** Unsafe version of {!nth}.
@raise Not_found if the index is wrong. *)
val tail : 'a t -> 'a t
(** Queue deprived of its first element. Does nothing on empty queues *)
(** Queue deprived of its first element. Does nothing on empty queues. *)
val init : 'a t -> 'a t
(** Queue deprived of its last element. Does nothing on empty queues *)
(** Queue deprived of its last element. Does nothing on empty queues. *)
(** {2 Global Operations} *)
@ -94,17 +94,17 @@ val append : 'a t -> 'a t -> 'a t
Linear in the size of the second queue. *)
val rev : 'a t -> 'a t
(** Reverse the queue, O(n) complexity
(** Reverse the queue, [O(n)] complexity.
@since 0.10 *)
val map : ('a -> 'b) -> 'a t -> 'b t
(** Map values *)
(** Map values. *)
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
(** Synonym to {!map} *)
(** Synonym to {!map}. *)
val size : 'a t -> int
(** Number of elements in the queue (constant time) *)
(** Number of elements in the queue (constant time). *)
val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
@ -135,5 +135,5 @@ val (--^) : int -> int -> int t
(** [a -- b] is the integer range from [a] to [b], where [b] is excluded.
@since 0.17 *)
val print : 'a printer -> 'a t printer
val pp : 'a printer -> 'a t printer
(** @since 0.13 *)

388
src/data/CCFlatHashtbl.ml
View file

@ -1,388 +0,0 @@
(*
copyright (c) 2013-2014, simon cruanes
all rights reserved.
redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(** {1 Open-Addressing Hash-table}
We use Robin-Hood hashing as described in
http://codecapsule.com/2013/11/17/robin-hood-hashing-backward-shift-deletion/
with backward shift. *)
type 'a sequence = ('a -> unit) -> unit
module type S = sig
type key
type 'a t
val create : int -> 'a t
(** Create a new table of the given initial capacity *)
val mem : 'a t -> key -> bool
(** [mem tbl k] returns [true] iff [k] is mapped to some value
in [tbl] *)
val find : 'a t -> key -> 'a option
val find_exn : 'a t -> key -> 'a
val get : key -> 'a t -> 'a option
(** [get k tbl] recovers the value for [k] in [tbl], or
returns [None] if [k] doesn't belong *)
val get_exn : key -> 'a t -> 'a
val add : 'a t -> key -> 'a -> unit
(** [add tbl k v] adds [k -> v] to [tbl], possibly replacing the old
value associated with [k]. *)
val remove : 'a t -> key -> unit
(** Remove binding *)
val size : _ t -> int
(** Number of bindings *)
val of_list : (key * 'a) list -> 'a t
val to_list : 'a t -> (key * 'a) list
val of_seq : (key * 'a) sequence -> 'a t
val to_seq : 'a t -> (key * 'a) sequence
val keys : _ t -> key sequence
val values : 'a t -> 'a sequence
end
module type HASHABLE = sig
type t
val equal : t -> t -> bool
val hash : t -> int
end
module Make(X : HASHABLE) = struct
type key = X.t
type 'a bucket =
| Empty
| Key of key * 'a * int (* store the hash too *)
type 'a t = {
mutable arr : 'a bucket array;
mutable size : int;
}
let size tbl = tbl.size
let _reached_max_load tbl =
let n = Array.length tbl.arr in
(n - tbl.size) < n/10 (* full at 9/10 *)
let create i =
let i = min Sys.max_array_length (max i 8) in
{ arr=Array.make i Empty; size=0; }
(* TODO: enforce that [tbl.arr] has a power of 2 as length, then
initial_index is just a mask with (length-1)? *)
(* initial index for a value with hash [h] *)
let _initial_idx tbl h =
h mod Array.length tbl.arr
let _succ tbl i =
let i' = i+1 in
if i' = Array.length tbl.arr then 0 else i'
(* distance to initial bucket, at index [i] with hash [h] *)
let _dib tbl h ~i =
let i0 = _initial_idx tbl h in
if i>=i0
then i - i0
else i + (Array.length tbl.arr - i0)
(* insert k->v in [tbl], currently at index [i] and distance [dib] *)
let rec _linear_probe tbl k v h_k i dib =
match tbl.arr.(i) with
| Empty ->
(* add binding *)
tbl.size <- 1 + tbl.size;
tbl.arr.(i) <- Key (k, v, h_k)
| Key (k', _, h_k') when X.equal k k' ->
(* replace *)
assert (h_k = h_k');
tbl.arr.(i) <- Key (k, v, h_k)
| Key (k', v', h_k') ->
let dib' = _dib tbl h_k' ~i in
if dib > dib'
then (
(* replace *)
tbl.arr.(i) <- Key (k, v, h_k);
_linear_probe tbl k' v' h_k' (_succ tbl i) (dib'+1)
) else (
(* go further *)
_linear_probe tbl k v h_k (_succ tbl i) (dib+1)
)
(* resize table: put a bigger array in it, then insert values
from the old array *)
let _resize tbl =
let size' = min Sys.max_array_length (2 * Array.length tbl.arr) in
let arr' = Array.make size' Empty in
let old_arr = tbl.arr in
(* replace with new table *)
tbl.size <- 0;
tbl.arr <- arr';
Array.iter
(function
| Empty -> ()
| Key (k, v, h_k) ->
_linear_probe tbl k v h_k (_initial_idx tbl h_k) 0)
old_arr
let add tbl k v =
if _reached_max_load tbl then _resize tbl;
(* insert value *)
let h_k = X.hash k in
_linear_probe tbl k v h_k (_initial_idx tbl h_k) 0
(* shift back elements that have a DIB > 0 until an empty bucket
or a bucket that doesn't need shifting is met *)
let rec _backward_shift tbl ~prev:prev_i i =
match tbl.arr.(i) with
| Empty ->
tbl.arr.(prev_i) <- Empty;
| Key (_, _, h_k) as bucket ->
let d = _dib tbl h_k ~i in
assert (d >= 0);
if d > 0 then (
(* shift backward *)
tbl.arr.(prev_i) <- bucket;
_backward_shift tbl ~prev:i (_succ tbl i)
) else (
tbl.arr.(prev_i) <- Empty;
)
(* linear probing for removal of [k]: find the bucket containing [k],
if any, and perform backward shift from there *)
let rec _linear_probe_remove tbl k h_k i dib =
match tbl.arr.(i) with
| Empty -> ()
| Key (k', _, _) when X.equal k k' ->
tbl.size <- tbl.size - 1;
(* shift all elements that follow and have a DIB > 0;
it will also erase the last shifted bucket, and erase [i] in
any case *)
_backward_shift tbl ~prev:i (_succ tbl i)
| Key (_, _, h_k') ->
if dib > _dib tbl h_k' ~i
then () (* [k] not present, would be here otherwise *)
else _linear_probe_remove tbl k h_k (_succ tbl i) (dib+1)
let remove tbl k =
let h_k = X.hash k in
_linear_probe_remove tbl k h_k (_initial_idx tbl h_k) 0
let rec get_exn_rec tbl k h_k i dib =
match tbl.arr.(i) with
| Empty -> raise Not_found
| Key (k', v', _) when X.equal k k' -> v'
| Key (_, _, h_k') ->
if dib > _dib tbl h_k' ~i
then raise Not_found (* [k] would be here otherwise *)
else get_exn_rec tbl k h_k (_succ tbl i) (dib+1)
let get_exn k tbl =
let h_k = X.hash k in
let i0 = _initial_idx tbl h_k in
(* unroll a few steps *)
match tbl.arr.(i0) with
| Empty -> raise Not_found
| Key (k', v, _) ->
if X.equal k k' then v
else
let i1 = _succ tbl i0 in
match tbl.arr.(i1) with
| Empty -> raise Not_found
| Key (k', v, _) ->
if X.equal k k' then v
else
let i2 = _succ tbl i1 in
match tbl.arr.(i2) with
| Empty -> raise Not_found
| Key (k', v, _) ->
if X.equal k k' then v
else get_exn_rec tbl k h_k (_succ tbl i2) 3
let get k tbl =
try Some (get_exn k tbl)
with Not_found -> None
let find_exn tbl k = get_exn k tbl
let find tbl k =
try Some (get_exn k tbl)
with Not_found -> None
let mem tbl k =
try ignore (get_exn k tbl); true
with Not_found -> false
let of_list l =
let tbl = create 16 in
List.iter (fun (k,v) -> add tbl k v) l;
tbl
let to_list tbl =
Array.fold_left
(fun acc bucket -> match bucket with
| Empty -> acc
| Key (k,v,_) -> (k,v)::acc)
[] tbl.arr
let of_seq seq =
let tbl = create 16 in
seq (fun (k,v) -> add tbl k v);
tbl
let to_seq tbl yield =
Array.iter
(function Empty -> () | Key (k, v, _) -> yield (k,v))
tbl.arr
let keys tbl yield =
Array.iter
(function Empty -> () | Key (k, _, _) -> yield k)
tbl.arr
let values tbl yield =
Array.iter
(function Empty -> () | Key (_, v, _) -> yield v)
tbl.arr
(*
let pp_debug_ out t =
let open T in
let pp_buck out (i,b) = match b with
| Empty -> Format.fprintf out "_"
| Key (k,v,h_k) ->
let dib = _dib t h_k ~i in
Format.fprintf out "[%d]{%d -> %d (dib=%d)}@," i (Obj.magic k) (Obj.magic v) dib
in
Format.fprintf out "@[";
Array.iteri
(fun i b -> pp_buck out (i,b))
t.arr;
Format.fprintf out "@]";
()
*)
end
(*$inject
module T = Make(CCInt)
let gen_l =
let g = Q.(list (pair small_int small_int)) in
Q.map_same_type
(CCList.sort_uniq ~cmp:(fun x y -> compare (fst x) (fst y)))
g
type op =
| Add of int*int
| Remove of int
let op_add x y = Add (x,y)
let op_remove x = Remove x
let op_exec t = function
| Add (x,y) -> T.add t x y
| Remove x -> T.remove t x
let op_pp = function
| Add (x,y) -> Printf.sprintf "add(%d,%d)" x y
| Remove x -> Printf.sprintf "remove(%d)" x
let gen_ops n =
let open Q.Gen in
let gen_op =
frequency
[ 2, return op_add <*> small_int <*> small_int
; 1, return op_remove <*> small_int
]
in
list_size (0--n) gen_op
let arb_ops n : op list Q.arbitrary =
let shrink_op o =
let open Q.Iter in
match o with
| Add (x,y) ->
(return op_add <*> Q.Shrink.int x <*> return y)
<+>
(return op_add <*> return x <*> Q.Shrink.int y)
| Remove x -> map op_remove (Q.Shrink.int x)
in
let shrink =
Q.Shrink.list ~shrink:shrink_op in
let print = Q.Print.list op_pp in
Q.make ~shrink ~print (gen_ops n)
module TRef = CCHashtbl.Make(CCInt)
let op_exec_ref t = function
| Add (x,y) -> TRef.replace t x y
| Remove x -> TRef.remove t x
*)
(*$T
let t = T.create 32 in \
T.add t 0 "0"; T.find t 0 = Some "0"
*)
(*$Q
gen_l (fun l -> \
(T.of_list l |> T.to_list |> List.sort CCOrd.compare) = l)
*)
(* test that the table behaves the same as a normal hashtable *)
(*$inject
let test_ops l =
let t = T.create 16 in
let t' = TRef.create 16 in
List.iter (op_exec t) l;
List.iter (op_exec_ref t') l;
(T.to_list t |> List.sort CCOrd.compare) =
(TRef.to_list t' |> List.sort CCOrd.compare)
*)
(*$Q & ~count:500
(arb_ops 300) test_ops
*)
(*$Q & ~count:10
(arb_ops 3000) test_ops
*)
(*$Q & ~count:5
(arb_ops 30000) test_ops
*)

83
src/data/CCFlatHashtbl.mli
View file

@ -1,83 +0,0 @@
(*
copyright (c) 2013-2014, simon cruanes
all rights reserved.
redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(** {1 Open-Addressing Hash-table}
This module was previously named [CCHashtbl], but the name is now used for
an extension of the standard library's hashtables.
@since 0.4 *)
type 'a sequence = ('a -> unit) -> unit
module type S = sig
type key
type 'a t
val create : int -> 'a t
(** Create a new table of the given initial capacity *)
val mem : 'a t -> key -> bool
(** [mem tbl k] returns [true] iff [k] is mapped to some value
in [tbl] *)
val find : 'a t -> key -> 'a option
val find_exn : 'a t -> key -> 'a
val get : key -> 'a t -> 'a option
(** [get k tbl] recovers the value for [k] in [tbl], or
returns [None] if [k] doesn't belong *)
val get_exn : key -> 'a t -> 'a
val add : 'a t -> key -> 'a -> unit
(** [add tbl k v] adds [k -> v] to [tbl], possibly replacing the old
value associated with [k]. *)
val remove : 'a t -> key -> unit
(** Remove binding *)
val size : _ t -> int
(** Number of bindings *)
val of_list : (key * 'a) list -> 'a t
val to_list : 'a t -> (key * 'a) list
val of_seq : (key * 'a) sequence -> 'a t
val to_seq : 'a t -> (key * 'a) sequence
val keys : _ t -> key sequence
val values : 'a t -> 'a sequence
end
module type HASHABLE = sig
type t
val equal : t -> t -> bool
val hash : t -> int
end
module Make(X : HASHABLE) : S with type key = X.t

62
src/data/CCGraph.ml
View file

@ -56,7 +56,7 @@ type ('k, 'a) table = {
(** Mutable set *)
type 'a set = ('a, unit) table
let mk_table (type k) ?(eq=(=)) ?(hash=Hashtbl.hash) size =
let mk_table (type k) ~eq ?(hash=Hashtbl.hash) size =
let module H = Hashtbl.Make(struct
type t = k
let equal = eq
@ -68,7 +68,7 @@ let mk_table (type k) ?(eq=(=)) ?(hash=Hashtbl.hash) size =
; add=(fun k v -> H.replace tbl k v)
}
let mk_map (type k) ?(cmp=Pervasives.compare) () =
let mk_map (type k) ~cmp () =
let module M = Map.Make(struct
type t = k
let compare = cmp
@ -160,15 +160,15 @@ module Traverse = struct
)
done
let generic ?(tbl=mk_table 128) ~bag ~graph seq =
let generic ~tbl ~bag ~graph seq =
let tags = {
get_tag=tbl.mem;
set_tag=(fun v -> tbl.add v ());
} in
generic_tag ~tags ~bag ~graph seq
let bfs ?tbl ~graph seq =
generic ?tbl ~bag:(mk_queue ()) ~graph seq
let bfs ~tbl ~graph seq =
generic ~tbl ~bag:(mk_queue ()) ~graph seq
let bfs_tag ~tags ~graph seq =
generic_tag ~tags ~bag:(mk_queue()) ~graph seq
@ -186,15 +186,15 @@ module Traverse = struct
let bag = mk_heap ~leq:(fun (_,d1,_) (_,d2,_) -> d1 <= d2) in
generic_tag ~tags:tags' ~bag ~graph:graph' seq'
let dijkstra ?(tbl=mk_table 128) ?dist ~graph seq =
let dijkstra ~tbl ?dist ~graph seq =
let tags = {
get_tag=tbl.mem;
set_tag=(fun v -> tbl.add v ());
} in
dijkstra_tag ~tags ?dist ~graph seq
let dfs ?tbl ~graph seq =
generic ?tbl ~bag:(mk_stack ()) ~graph seq
let dfs ~tbl ~graph seq =
generic ~tbl ~bag:(mk_stack ()) ~graph seq
let dfs_tag ~tags ~graph seq =
generic_tag ~tags ~bag:(mk_stack()) ~graph seq
@ -240,7 +240,7 @@ module Traverse = struct
| (v1,_,_) :: path' ->
eq v v1 || list_mem_ ~eq ~graph v path'
let dfs_tag ?(eq=(=)) ~tags ~graph seq =
let dfs_tag ~eq ~tags ~graph seq =
let first = ref true in
fun k ->
if !first then first := false else raise Sequence_once;
@ -279,17 +279,18 @@ module Traverse = struct
done
) seq
let dfs ?(tbl=mk_table 128) ?eq ~graph seq =
let dfs ~tbl ~eq ~graph seq =
let tags = {
set_tag=(fun v -> tbl.add v ());
get_tag=tbl.mem;
} in
dfs_tag ?eq ~tags ~graph seq
dfs_tag ~eq ~tags ~graph seq
end
(*$R
let l =
Traverse.Event.dfs ~graph:divisors_graph (Sequence.return 345614)
let tbl = mk_table ~eq:CCInt.equal 128 in
Traverse.Event.dfs ~tbl ~eq:CCInt.equal ~graph:divisors_graph (Sequence.return 345614)
|> Sequence.to_list in
let expected =
[`Enter (345614, 0, []); `Edge (345614, (), 172807, `Forward);
@ -305,8 +306,8 @@ end
(** {2 Cycles} *)
let is_dag ?(tbl=mk_table 128) ~graph vs =
Traverse.Event.dfs ~tbl ~graph vs
let is_dag ~tbl ~eq ~graph vs =
Traverse.Event.dfs ~tbl ~eq ~graph vs
|> Seq.exists_
(function
| `Edge (_, _, _, `Back) -> true
@ -316,7 +317,7 @@ let is_dag ?(tbl=mk_table 128) ~graph vs =
exception Has_cycle
let topo_sort_tag ?(eq=(=)) ?(rev=false) ~tags ~graph seq =
let topo_sort_tag ~eq ?(rev=false) ~tags ~graph seq =
(* use DFS *)
let l =
Traverse.Event.dfs_tag ~eq ~tags ~graph seq
@ -331,21 +332,23 @@ let topo_sort_tag ?(eq=(=)) ?(rev=false) ~tags ~graph seq =
in
if rev then List.rev l else l
let topo_sort ?eq ?rev ?(tbl=mk_table 128) ~graph seq =
let topo_sort ~eq ?rev ~tbl ~graph seq =
let tags = {
get_tag=tbl.mem;
set_tag=(fun v -> tbl.add v ());
} in
topo_sort_tag ?eq ?rev ~tags ~graph seq
topo_sort_tag ~eq ?rev ~tags ~graph seq
(*$T
let l = topo_sort ~graph:divisors_graph (Seq.return 42) in \
let tbl = mk_table ~eq:CCInt.equal 128 in \
let l = topo_sort ~tbl ~eq:CCInt.equal ~graph:divisors_graph (Seq.return 42) in \
List.for_all (fun (i,j) -> \
let idx_i = CCList.find_idx ((=)i) l |> CCOpt.get_exn |> fst in \
let idx_j = CCList.find_idx ((=)j) l |> CCOpt.get_exn |> fst in \
idx_i < idx_j) \
[ 42, 21; 14, 2; 3, 1; 21, 7; 42, 3]
let l = topo_sort ~rev:true ~graph:divisors_graph (Seq.return 42) in \
let tbl = mk_table ~eq:CCInt.equal 128 in \
let l = topo_sort ~tbl ~eq:CCInt.equal ~rev:true ~graph:divisors_graph (Seq.return 42) in \
List.for_all (fun (i,j) -> \
let idx_i = CCList.find_idx ((=)i) l |> CCOpt.get_exn |> fst in \
let idx_j = CCList.find_idx ((=)j) l |> CCOpt.get_exn |> fst in \
@ -393,7 +396,7 @@ let spanning_tree_tag ~tags ~graph v =
in
mk_node v
let spanning_tree ?(tbl=mk_table 128) ~graph v =
let spanning_tree ~tbl ~graph v =
let tags = {
get_tag=tbl.mem;
set_tag=(fun v -> tbl.add v ());
@ -482,12 +485,12 @@ end
type 'v scc_state = 'v SCC.state
let scc ?(tbl=mk_table 128) ~graph seq = SCC.explore ~tbl ~graph seq
let scc ~tbl ~graph seq = SCC.explore ~tbl ~graph seq
(* example from https://en.wikipedia.org/wiki/Strongly_connected_component *)
(*$R
let set_eq ?(eq=(=)) l1 l2 = CCList.subset ~eq l1 l2 && CCList.subset ~eq l2 l1 in
let graph = of_list
let graph = of_list ~eq:CCString.equal
[ "a", "b"
; "b", "e"
; "e", "a"
@ -503,7 +506,8 @@ let scc ?(tbl=mk_table 128) ~graph seq = SCC.explore ~tbl ~graph seq
; "h", "d"
; "h", "g"
] in
let res = scc ~graph (Seq.return "a") |> Seq.to_list in
let tbl = mk_table ~eq:CCString.equal 128 in
let res = scc ~tbl ~graph (Seq.return "a") |> Seq.to_list in
assert_bool "scc"
(set_eq ~eq:(set_eq ?eq:None) res
[ [ "a"; "b"; "e" ]
@ -541,8 +545,8 @@ module Dot = struct
(** Print an enum of Full.traverse_event *)
let pp_seq
?(tbl=mk_table 128)
?(eq=(=))
~tbl
~eq
?(attrs_v=fun _ -> [])
?(attrs_e=fun _ -> [])
?(name="graph")
@ -598,8 +602,8 @@ module Dot = struct
Format.fprintf out "}@]@;@?";
()
let pp ?tbl ?eq ?attrs_v ?attrs_e ?name ~graph fmt v =
pp_seq ?tbl ?eq ?attrs_v ?attrs_e ?name ~graph fmt (Seq.return v)
let pp ~tbl ~eq ?attrs_v ?attrs_e ?name ~graph fmt v =
pp_seq ~tbl ~eq ?attrs_v ?attrs_e ?name ~graph fmt (Seq.return v)
let with_out filename f =
let oc = open_out filename in
@ -622,7 +626,7 @@ type ('v, 'e) mut_graph = {
remove : 'v -> unit;
}
let mk_mut_tbl (type k) ?(eq=(=)) ?(hash=Hashtbl.hash) size =
let mk_mut_tbl (type k) ~eq ?(hash=Hashtbl.hash) size =
let module Tbl = Hashtbl.Make(struct
type t = k
let hash = hash
@ -757,7 +761,7 @@ end
(** {2 Misc} *)
let of_list ?(eq=(=)) l =
let of_list ~eq l =
(fun v yield -> List.iter (fun (a,b) -> if eq a v then yield ((),b)) l)
let of_fun f =

105
src/data/CCGraph.mli
View file

@ -32,7 +32,7 @@ type 'a sequence_once = 'a sequence
(** Sequence that should be used only once *)
exception Sequence_once
(** Raised when a sequence meant to be used once is used several times *)
(** Raised when a sequence meant to be used once is used several times. *)
module Seq : sig
type 'a t = 'a sequence
@ -55,7 +55,7 @@ type ('v, 'e) t = ('v -> ('e * 'v) sequence)
type ('v, 'e) graph = ('v, 'e) t
val make : ('v -> ('e * 'v) sequence) -> ('v, 'e) t
(** Make a graph by providing the children function *)
(** Make a graph by providing the children function. *)
(** {2 Tags}
@ -77,11 +77,11 @@ type ('k, 'a) table = {
(** Mutable set *)
type 'a set = ('a, unit) table
val mk_table: ?eq:('k -> 'k -> bool) -> ?hash:('k -> int) -> int -> ('k, 'a) table
(** Default implementation for {!table}: a {!Hashtbl.t} *)
val mk_table: eq:('k -> 'k -> bool) -> ?hash:('k -> int) -> int -> ('k, 'a) table
(** Default implementation for {!table}: a {!Hashtbl.t}. *)
val mk_map: ?cmp:('k -> 'k -> int) -> unit -> ('k, 'a) table
(** Use a {!Map.S} underneath *)
val mk_map: cmp:('k -> 'k -> int) -> unit -> ('k, 'a) table
(** Use a {!Map.S} underneath. *)
(** {2 Bags of vertices} *)
@ -97,14 +97,14 @@ val mk_stack: unit -> 'a bag
val mk_heap: leq:('a -> 'a -> bool) -> 'a bag
(** [mk_heap ~leq] makes a priority queue where [leq x y = true] means that
[x] is smaller than [y] and should be prioritary *)
[x] is smaller than [y] and should be prioritary. *)
(** {2 Traversals} *)
module Traverse : sig
type ('v, 'e) path = ('v * 'e * 'v) list
val generic: ?tbl:'v set ->
val generic: tbl:'v set ->
bag:'v bag ->
graph:('v, 'e) t ->
'v sequence ->
@ -120,7 +120,7 @@ module Traverse : sig
'v sequence_once
(** One-shot traversal of the graph using a tag set and the given bag *)
val dfs: ?tbl:'v set ->
val dfs: tbl:'v set ->
graph:('v, 'e) t ->
'v sequence ->
'v sequence_once
@ -130,7 +130,7 @@ module Traverse : sig
'v sequence ->
'v sequence_once
val bfs: ?tbl:'v set ->
val bfs: tbl:'v set ->
graph:('v, 'e) t ->
'v sequence ->
'v sequence_once
@ -140,7 +140,7 @@ module Traverse : sig
'v sequence ->
'v sequence_once
val dijkstra : ?tbl:'v set ->
val dijkstra : tbl:'v set ->
?dist:('e -> int) ->
graph:('v, 'e) t ->
'v sequence ->
@ -149,7 +149,7 @@ module Traverse : sig
Yields each vertex paired with its distance to the set of initial vertices
(the smallest distance needed to reach the node from the initial vertices)
@param dist distance from origin of the edge to destination,
must be strictly positive. Default is 1 for every edge *)
must be strictly positive. Default is 1 for every edge. *)
val dijkstra_tag : ?dist:('e -> int) ->
tags:'v tag_set ->
@ -174,28 +174,29 @@ module Traverse : sig
val get_edge : ('v, 'e) t -> ('v * 'e * 'v) option
val get_edge_kind : ('v, 'e) t -> ('v * 'e * 'v * edge_kind) option
val dfs: ?tbl:'v set ->
?eq:('v -> 'v -> bool) ->
val dfs: tbl:'v set ->
eq:('v -> 'v -> bool) ->
graph:('v, 'e) graph ->
'v sequence ->
('v,'e) t sequence_once
(** Full version of DFS.
@param eq equality predicate on vertices *)
@param eq equality predicate on vertices. *)
val dfs_tag: ?eq:('v -> 'v -> bool) ->
val dfs_tag: eq:('v -> 'v -> bool) ->
tags:'v tag_set ->
graph:('v, 'e) graph ->
'v sequence ->
('v,'e) t sequence_once
(** Full version of DFS using integer tags
@param eq equality predicate on vertices *)
(** Full version of DFS using integer tags.
@param eq equality predicate on vertices. *)
end
end
(** {2 Cycles} *)
val is_dag :
?tbl:'v set ->
tbl:'v set ->
eq:('v -> 'v -> bool) ->
graph:('v, _) t ->
'v sequence ->
bool
@ -207,9 +208,9 @@ val is_dag :
exception Has_cycle
val topo_sort : ?eq:('v -> 'v -> bool) ->
val topo_sort : eq:('v -> 'v -> bool) ->
?rev:bool ->
?tbl:'v set ->
tbl:'v set ->
graph:('v, 'e) t ->
'v sequence ->
'v list
@ -217,20 +218,20 @@ val topo_sort : ?eq:('v -> 'v -> bool) ->
element of [l] is reachable from [seq].
The list is sorted in a way such that if [v -> v'] in the graph, then
[v] comes before [v'] in the list (i.e. has a smaller index).
Basically [v -> v'] means that [v] is smaller than [v']
see {{: https://en.wikipedia.org/wiki/Topological_sorting} wikipedia}
@param eq equality predicate on vertices (default [(=)])
Basically [v -> v'] means that [v] is smaller than [v'].
See {{: https://en.wikipedia.org/wiki/Topological_sorting} wikipedia}.
@param eq equality predicate on vertices (default [(=)]).
@param rev if true, the dependency relation is inverted ([v -> v'] means
[v'] occurs before [v])
@raise Has_cycle if the graph is not a DAG *)
[v'] occurs before [v]).
@raise Has_cycle if the graph is not a DAG. *)
val topo_sort_tag : ?eq:('v -> 'v -> bool) ->
val topo_sort_tag : eq:('v -> 'v -> bool) ->
?rev:bool ->
tags:'v tag_set ->
graph:('v, 'e) t ->
'v sequence ->
'v list
(** Same as {!topo_sort} but uses an explicit tag set *)
(** Same as {!topo_sort} but uses an explicit tag set. *)
(** {2 Lazy Spanning Tree} *)
@ -245,12 +246,12 @@ module Lazy_tree : sig
val fold_v : ('acc -> 'v -> 'acc) -> 'acc -> ('v, _) t -> 'acc
end
val spanning_tree : ?tbl:'v set ->
val spanning_tree : tbl:'v set ->
graph:('v, 'e) t ->
'v ->
('v, 'e) Lazy_tree.t
(** [spanning_tree ~graph v] computes a lazy spanning tree that has [v]
as a root. The table [tbl] is used for the memoization part *)
as a root. The table [tbl] is used for the memoization part. *)
val spanning_tree_tag : tags:'v tag_set ->
graph:('v, 'e) t ->
@ -260,9 +261,9 @@ val spanning_tree_tag : tags:'v tag_set ->
(** {2 Strongly Connected Components} *)
type 'v scc_state
(** Hidden state for {!scc} *)
(** Hidden state for {!scc}. *)
val scc : ?tbl:('v, 'v scc_state) table ->
val scc : tbl:('v, 'v scc_state) table ->
graph:('v, 'e) t ->
'v sequence ->
'v list sequence_once
@ -271,8 +272,8 @@ val scc : ?tbl:('v, 'v scc_state) table ->
in the graph.
The components are explored in a topological order (if C1 and C2 are
components, and C1 points to C2, then C2 will be yielded before C1).
Uses {{: https://en.wikipedia.org/wiki/Tarjan's_strongly_connected_components_algorithm} Tarjan's algorithm}
@param tbl table used to map nodes to some hidden state
Uses {{: https://en.wikipedia.org/wiki/Tarjan's_strongly_connected_components_algorithm} Tarjan's algorithm}.
@param tbl table used to map nodes to some hidden state.
@raise Sequence_once if the result is iterated on more than once.
*)
@ -304,8 +305,8 @@ module Dot : sig
type vertex_state
(** Hidden state associated to a vertex *)
val pp : ?tbl:('v,vertex_state) table ->
?eq:('v -> 'v -> bool) ->
val pp : tbl:('v,vertex_state) table ->
eq:('v -> 'v -> bool) ->
?attrs_v:('v -> attribute list) ->
?attrs_e:('e -> attribute list) ->
?name:string ->
@ -313,13 +314,13 @@ module Dot : sig
Format.formatter ->
'v ->
unit
(** Print the graph, starting from given vertex, on the formatter
@param attrs_v attributes for vertices
@param attrs_e attributes for edges
@param name name of the graph *)
(** Print the graph, starting from given vertex, on the formatter.
@param attrs_v attributes for vertices.
@param attrs_e attributes for edges.
@param name name of the graph. *)
val pp_seq : ?tbl:('v,vertex_state) table ->
?eq:('v -> 'v -> bool) ->
val pp_seq : tbl:('v,vertex_state) table ->
eq:('v -> 'v -> bool) ->
?attrs_v:('v -> attribute list) ->
?attrs_e:('e -> attribute list) ->
?name:string ->
@ -329,7 +330,7 @@ module Dot : sig
unit
val with_out : string -> (Format.formatter -> 'a) -> 'a
(** Shortcut to open a file and write to it *)
(** Shortcut to open a file and write to it. *)
end
(** {2 Mutable Graph} *)
@ -340,11 +341,11 @@ type ('v, 'e) mut_graph = {
remove : 'v -> unit;
}
val mk_mut_tbl : ?eq:('v -> 'v -> bool) ->
val mk_mut_tbl : eq:('v -> 'v -> bool) ->
?hash:('v -> int) ->
int ->
('v, 'a) mut_graph
(** Make a new mutable graph from a Hashtbl. Edges are labelled with type ['a] *)
(** Make a new mutable graph from a Hashtbl. Edges are labelled with type ['a]. *)
(** {2 Immutable Graph}
@ -358,7 +359,7 @@ module type MAP = sig
type 'a t
val as_graph : 'a t -> (vertex, 'a) graph
(** Graph view of the map *)
(** Graph view of the map. *)
val empty : 'a t
@ -367,12 +368,12 @@ module type MAP = sig
val remove_edge : vertex -> vertex -> 'a t -> 'a t
val add : vertex -> 'a t -> 'a t
(** Add a vertex, possibly with no outgoing edge *)
(** Add a vertex, possibly with no outgoing edge. *)
val remove : vertex -> 'a t -> 'a t
(** Remove the vertex and all its outgoing edges.
Edges that point to the vertex are {b NOT} removed, they must be
manually removed with {!remove_edge} *)
manually removed with {!remove_edge}. *)
val union : 'a t -> 'a t -> 'a t
@ -397,18 +398,18 @@ module Map(O : Map.OrderedType) : MAP with type vertex = O.t
(** {2 Misc} *)
val of_list : ?eq:('v -> 'v -> bool) -> ('v * 'v) list -> ('v, unit) t
val of_list : eq:('v -> 'v -> bool) -> ('v * 'v) list -> ('v, unit) t
(** [of_list l] makes a graph from a list of pairs of vertices.
Each pair [(a,b)] is an edge from [a] to [b].
@param eq equality used to compare vertices *)
@param eq equality used to compare vertices. *)
val of_hashtbl : ('v, 'v list) Hashtbl.t -> ('v, unit) t
(** [of_hashtbl tbl] makes a graph from a hashtable that maps vertices
to lists of children *)
to lists of children. *)
val of_fun : ('v -> 'v list) -> ('v, unit) t
(** [of_fun f] makes a graph out of a function that maps a vertex to
the list of its children. The function is assumed to be deterministic. *)
val divisors_graph : (int, unit) t
(** [n] points to all its strict divisors *)
(** [n] points to all its strict divisors. *)

44
src/data/CCHashSet.mli
View file

@ -14,72 +14,72 @@ module type S = sig
type elt
val create : int -> t
(** [create n] makes a new set with the given capacity [n] *)
(** [create n] makes a new set with the given capacity [n]. *)
val singleton : elt -> t
(** [singleton x] is the singleton [{x}] *)
(** [singleton x] is the singleton [{x}]. *)
val clear : t -> unit
(** [clear s] removes all elements from [s] *)
(** [clear s] removes all elements from [s]. *)
val copy : t -> t
(** Fresh copy *)
(** Fresh copy. *)
val copy_into : into:t -> t -> unit
(** [copy_into ~into s] copies all elements of [s] into [into] *)
(** [copy_into ~into s] copies all elements of [s] into [into]. *)
val insert : t -> elt -> unit
(** [insert s x] adds [x] into [s] *)
(** [insert s x] adds [x] into [s]. *)
val remove : t -> elt -> unit
(** Remove the element, if it were in there *)
(** Remove the element, if it were in there. *)
val cardinal : t -> int
(** [cardinal s] returns the number of elements in [s] *)
(** [cardinal s] returns the number of elements in [s]. *)
val mem : t -> elt -> bool
(** [mem s x] returns [true] iff [x] is in [s] *)
(** [mem s x] returns [true] iff [x] is in [s]. *)
val find_exn : t -> elt -> elt
(** [find_exn s x] returns [y] if [x] and [y] are equal, and [mem s y].
@raise Not_found if [x] not in [s] *)
@raise Not_found if [x] not in [s]. *)
val find : t -> elt -> elt option
(** Safe version of {!find_exn} *)
(** Safe version of {!find_exn}. *)
val inter : t -> t -> t
(** [inter a b] returns [a ∩ b] *)
(** [inter a b] returns [a ∩ b]. *)
val inter_mut : into:t -> t -> unit
(** [inter_mut ~into a] changes [into] into [a ∩ into] *)
(** [inter_mut ~into a] changes [into] into [a ∩ into]. *)
val union : t -> t -> t
(** [union a b] returns [a ∪ b] *)
(** [union a b] returns [a ∪ b]. *)
val union_mut : into:t -> t -> unit
(** [union_mut ~into a] changes [into] into [a ∪ into] *)
(** [union_mut ~into a] changes [into] into [a ∪ into]. *)
val diff : t -> t -> t
(** [diff a b] returns [a - b] *)
(** [diff a b] returns [a - b]. *)
val subset : t -> t -> bool
(** [subset a b] returns [true] if all elements of [a] are in [b] *)
(** [subset a b] returns [true] if all elements of [a] are in [b]. *)
val equal : t -> t -> bool
(** [equal a b] is extensional equality ([a] and [b] have the same elements) *)
(** [equal a b] is extensional equality ([a] and [b] have the same elements). *)
val for_all : (elt -> bool) -> t -> bool
val exists : (elt -> bool) -> t -> bool
val iter : (elt -> unit) -> t -> unit
(** Iterate on values *)
(** Iterate on values. *)
val fold : ('a -> elt -> 'a) -> 'a -> t -> 'a
(** Fold on values *)
(** Fold on values. *)
val elements : t -> elt list
(** List of elements *)
(** List of elements. *)
val of_list : elt list -> t
@ -91,7 +91,7 @@ module type S = sig
val pp : ?sep:string -> elt printer -> t printer
(** [pp pp_elt] returns a set printer, given a printer for
individual elements *)
individual elements. *)
end
module type ELEMENT = sig

14
src/data/CCHashTrie.ml
View file

@ -24,7 +24,7 @@ module Transient = struct
type state = { mutable frozen: bool }
type t = Nil | St of state
let empty = Nil
let equal a b = a==b
let equal a b = Pervasives.(==) a b
let create () = St {frozen=false}
let active = function Nil -> false | St st -> not st.frozen
let frozen = function Nil -> true | St st -> st.frozen
@ -126,7 +126,7 @@ module type S = sig
(** {6 IO} *)
val print : key printer -> 'a printer -> 'a t printer
val pp : key printer -> 'a printer -> 'a t printer
val as_tree : 'a t -> [`L of int * (key * 'a) list | `N ] ktree
(** For debugging purpose: explore the structure of the tree,
@ -292,13 +292,15 @@ module Make(Key : KEY)
val make : Key.t -> t
val zero : t (* special "hash" *)
val is_0 : t -> bool
val equal : t -> t -> bool
val rem : t -> int (* [A.length_log] last bits *)
val quotient : t -> t (* remove [A.length_log] last bits *)
end = struct
type t = int
let make = Key.hash
let zero = 0
let is_0 h = h==0
let is_0 h = h = 0
let equal (a : int) b = Pervasives.(=) a b
let rem h = h land (A.length - 1)
let quotient h = h lsr A.length_log
end
@ -407,14 +409,14 @@ module Make(Key : KEY)
let rec add_ ~id k v ~h m = match m with
| E -> S (h, k, v)
| S (h', k', v') ->
if h=h'
if Hash.equal h h'
then if Key.equal k k'
then S (h, k, v) (* replace *)
else L (h, Cons (k, v, Cons (k', v', Nil)))
else
make_array_ ~id ~leaf:(Cons (k', v', Nil)) ~h_leaf:h' k v ~h
| L (h', l) ->
if h=h'
if Hash.equal h h'
then L (h, add_list_ k v l)
else (* split into N *)
make_array_ ~id ~leaf:l ~h_leaf:h' k v ~h
@ -696,7 +698,7 @@ module Make(Key : KEY)
| None -> raise Not_found
| Some (k,v) -> k, v
let print ppk ppv out m =
let pp ppk ppv out m =
let first = ref true in
iter m
~f:(fun k v ->

38
src/data/CCHashTrie.mli
View file

@ -28,28 +28,28 @@ module Transient : sig
is called, [r] cannot be used to modify the structure again. *)
val create : unit -> t
(** Create a new, active ID *)
(** Create a new, active ID. *)
val equal : t -> t -> bool
(** Equality between IDs *)
(** Equality between IDs. *)
val frozen : t -> bool
(** [frozen i] returns [true] if [freeze i] was called before. In this case,
the ID cannot be used for modifications again. *)
val active : t -> bool
(** [active i] is [not (frozen i)] *)
(** [active i] is [not (frozen i)]. *)
val freeze : t -> unit
(** [freeze i] makes [i] unusable for new modifications. The values
created with [i] will now be immutable. *)
val with_ : (t -> 'a) -> 'a
(** [Transient.with_ f] creates a transient ID [i], calls [f i],
(** [with_ f] creates a transient ID [i], calls [f i],
freezes the ID [i] and returns the result of [f i]. *)
exception Frozen
(** Raised when a frozen ID is used *)
(** Raised when a frozen ID is used. *)
end
(** {2 Signature} *)
@ -71,7 +71,7 @@ module type S = sig
val get : key -> 'a t -> 'a option
val get_exn : key -> 'a t -> 'a
(** @raise Not_found if key not present *)
(** @raise Not_found if key not present. *)
val remove : key -> 'a t -> 'a t
(** Remove the key, if present. *)
@ -79,29 +79,29 @@ module type S = sig
val update : key -> f:('a option -> 'a option) -> 'a t -> 'a t
(** [update k ~f m] calls [f (Some v)] if [get k m = Some v], [f None]
otherwise. Then, if [f] returns [Some v'] it binds [k] to [v'],
if [f] returns [None] it removes [k] *)
if [f] returns [None] it removes [k]. *)
val add_mut : id:Transient.t -> key -> 'a -> 'a t -> 'a t
(** [add_mut ~id k v m] behaves like [add k v m], except it will mutate
in place whenever possible. Changes done with an [id] might affect all
versions of the structure obtained with the same [id] (but not
other versions).
@raise Transient.Frozen if [id] is frozen *)
@raise Transient.Frozen if [id] is frozen. *)
val remove_mut : id:Transient.t -> key -> 'a t -> 'a t
(** Same as {!remove}, but modifies in place whenever possible
@raise Transient.Frozen if [id] is frozen *)
(** Same as {!remove}, but modifies in place whenever possible.
@raise Transient.Frozen if [id] is frozen. *)
val update_mut : id:Transient.t -> key -> f:('a option -> 'a option) -> 'a t -> 'a t
(** Same as {!update} but with mutability
@raise Transient.Frozen if [id] is frozen *)
(** Same as {!update} but with mutability.
@raise Transient.Frozen if [id] is frozen. *)
val cardinal : _ t -> int
val choose : 'a t -> (key * 'a) option
val choose_exn : 'a t -> key * 'a
(** @raise Not_found if not pair was found *)
(** @raise Not_found if not pair was found. *)
val iter : f:(key -> 'a -> unit) -> 'a t -> unit
@ -114,14 +114,14 @@ module type S = sig
val add_list : 'a t -> (key * 'a) list -> 'a t
val add_list_mut : id:Transient.t -> 'a t -> (key * 'a) list -> 'a t
(** @raise Frozen if the ID is frozen *)
(** @raise Frozen if the ID is frozen. *)
val of_list : (key * 'a) list -> 'a t
val add_seq : 'a t -> (key * 'a) sequence -> 'a t
val add_seq_mut : id:Transient.t -> 'a t -> (key * 'a) sequence -> 'a t
(** @raise Frozen if the ID is frozen *)
(** @raise Frozen if the ID is frozen. *)
val of_seq : (key * 'a) sequence -> 'a t
@ -130,7 +130,7 @@ module type S = sig
val add_gen : 'a t -> (key * 'a) gen -> 'a t
val add_gen_mut : id:Transient.t -> 'a t -> (key * 'a) gen -> 'a t
(** @raise Frozen if the ID is frozen *)
(** @raise Frozen if the ID is frozen. *)
val of_gen : (key * 'a) gen -> 'a t
@ -138,12 +138,14 @@ module type S = sig
(** {6 IO} *)
val print : key printer -> 'a printer -> 'a t printer
val pp : key printer -> 'a printer -> 'a t printer
(** Renamed from [val print].
@since NEXT_RELEASE *)
val as_tree : 'a t -> [`L of int * (key * 'a) list | `N ] ktree
(** For debugging purpose: explore the structure of the tree,
with [`L (h,l)] being a leaf (with shared hash [h])
and [`N] an inner node *)
and [`N] an inner node. *)
end
(** {2 Type for keys} *)

6
src/data/CCHet.mli
View file

@ -17,7 +17,7 @@ module Key : sig
val create : unit -> 'a t
val equal : 'a t -> 'a t -> bool
(** Compare two keys that have compatible types *)
(** Compare two keys that have compatible types. *)
end
type pair =
@ -38,7 +38,7 @@ module Tbl : sig
val find : t -> 'a Key.t -> 'a option
val find_exn : t -> 'a Key.t -> 'a
(** @raise Not_found if the key is not in the table *)
(** @raise Not_found if the key is not in the table. *)
val iter : (pair -> unit) -> t -> unit
@ -72,7 +72,7 @@ module Map : sig
val find : 'a Key.t -> t -> 'a option
val find_exn : 'a Key.t -> t -> 'a
(** @raise Not_found if the key is not in the table *)
(** @raise Not_found if the key is not in the table. *)
val iter : (pair -> unit) -> t -> unit

2
src/data/CCImmutArray.ml
View file

@ -118,7 +118,7 @@ let to_gen a =
type 'a printer = Format.formatter -> 'a -> unit
let print ?(start="") ?(stop="") ?(sep=", ") pp_item out a =
let pp ?(start="") ?(stop="") ?(sep=", ") pp_item out a =
Format.pp_print_string out start;
for k = 0 to Array.length a - 1 do
if k > 0 then (

10
src/data/CCImmutArray.mli
View file

@ -24,17 +24,17 @@ val singleton : 'a -> 'a t
val doubleton : 'a -> 'a -> 'a t
val make : int -> 'a -> 'a t
(** [make n x] makes an array of [n] times [x] *)
(** [make n x] makes an array of [n] times [x]. *)
val init : int -> (int -> 'a) -> 'a t
(** [init n f] makes the array [[| f 0; f 1; ... ; f (n-1) |]].
@raise Invalid_argument if [n < 0] *)
@raise Invalid_argument if [n < 0]. *)
val get : 'a t -> int -> 'a
(** Access the element *)
(** Access the element. *)
val set : 'a t -> int -> 'a -> 'a t
(** Copy the array and modify its copy *)
(** Copy the array and modify its copy. *)
val sub : 'a t -> int -> int -> 'a t
(** [sub a start len] returns a fresh array of length len, containing the elements
@ -88,7 +88,7 @@ val to_gen : 'a t -> 'a gen
type 'a printer = Format.formatter -> 'a -> unit
val print :
val pp :
?start:string -> ?stop:string -> ?sep:string ->
'a printer -> 'a t printer

25
src/data/CCIntMap.ml
View file

@ -11,6 +11,7 @@ module Bit : sig
type t = private int
val highest : int -> t
val min_int : t
val equal : t -> t -> bool
val is_0 : bit:t -> int -> bool
val is_1 : bit:t -> int -> bool
val mask : mask:t -> int -> int (* zeroes the bit, puts all lower bits to 1 *)
@ -21,6 +22,8 @@ end = struct
let min_int = min_int
let equal = (=)
let rec highest_bit_naive x m =
if x=m then m
else highest_bit_naive (x land (lnot m)) (2*m)
@ -237,11 +240,11 @@ let update k f t =
let doubleton k1 v1 k2 v2 = add k1 v1 (singleton k2 v2)
let rec equal ~eq a b = a==b || match a, b with
let rec equal ~eq a b = Pervasives.(==) a b || match a, b with
| E, E -> true
| L (ka, va), L (kb, vb) -> ka = kb && eq va vb
| N (pa, sa, la, ra), N (pb, sb, lb, rb) ->
pa=pb && sa=sb && equal ~eq la lb && equal ~eq ra rb
pa=pb && Bit.equal sa sb && equal ~eq la lb && equal ~eq ra rb
| E, _
| N _, _
| L _, _ -> false
@ -287,7 +290,7 @@ let choose t =
with Not_found -> None
let rec union f t1 t2 =
if t1==t2 then t1
if Pervasives.(==) t1 t2 then t1
else match t1, t2 with
| E, o | o, E -> o
| L (k, v), o
@ -295,7 +298,7 @@ let rec union f t1 t2 =
(* insert k, v into o *)
insert_ (fun ~old v -> f k old v) k v o
| N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
if p1 = p2 && m1 = m2
if p1 = p2 && Bit.equal m1 m2
then mk_node_ p1 m1 (union f l1 l2) (union f r1 r2)
else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
then if Bit.is_0 p2 ~bit:m1
@ -323,14 +326,14 @@ let rec union f t1 t2 =
*)
(*$R
assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (print CCString.print))
assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (pp CCString.pp))
(of_list [1, "1"; 2, "2"; 3, "3"; 4, "4"])
(union (fun _ a b -> a)
(of_list [1, "1"; 3, "3"]) (of_list [2, "2"; 4, "4"]));
*)
(*$R
assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (print CCString.print))
assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (pp CCString.pp))
(of_list [1, "1"; 2, "2"; 3, "3"; 4, "4"])
(union (fun _ a b -> a)
(of_list [1, "1"; 2, "2"; 3, "3"]) (of_list [2, "2"; 4, "4"]))
@ -342,7 +345,7 @@ let rec union f t1 t2 =
*)
let rec inter f a b =
if a==b then a
if Pervasives.(==) a b then a
else match a, b with
| E, _ | _, E -> E
| L (k, v), o
@ -353,7 +356,7 @@ let rec inter f a b =
with Not_found -> E
end
| N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
if p1 = p2 && m1 = m2
if p1 = p2 && Bit.equal m1 m2
then mk_node_ p1 m1 (inter f l1 l2) (inter f r1 r2)
else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
then if Bit.is_0 p2 ~bit:m1
@ -366,7 +369,7 @@ let rec inter f a b =
else E
(*$R
assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (print CCString.print))
assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (pp CCString.pp))
(singleton 2 "2")
(inter (fun _ a b -> a)
(of_list [1, "1"; 2, "2"; 3, "3"]) (of_list [2, "2"; 4, "4"]))
@ -466,7 +469,7 @@ let compare ~cmp a b =
then
let c = cmp va vb in
if c=0 then cmp_gen cmp a b else c
else Pervasives.compare ka kb
else compare ka kb
in
cmp_gen cmp (to_gen a) (to_gen b)
@ -530,7 +533,7 @@ let rec as_tree t () = match t with
type 'a printer = Format.formatter -> 'a -> unit
let print pp_x out m =
let pp pp_x out m =
Format.fprintf out "@[<hov2>intmap {@,";
let first = ref true in
iter

14
src/data/CCIntMap.mli
View file

@ -19,8 +19,8 @@ val mem : int -> _ t -> bool
val find : int -> 'a t -> 'a option
val find_exn : int -> 'a t -> 'a
(** Same as {!find} but unsafe
@raise Not_found if key not present *)
(** Same as {!find} but unsafe.
@raise Not_found if key is not present. *)
val add : int -> 'a -> 'a t -> 'a t
@ -28,17 +28,17 @@ val remove : int -> 'a t -> 'a t
val equal : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** [equal ~eq a b] checks whether [a] and [b] have the same set of pairs
(key, value), comparing values with [eq]
(key, value), comparing values with [eq].
@since 0.13 *)
val compare : cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
(** Total order between maps; the precise order is unspecified .
(** Total order between maps; the precise order is unspecified.
@since 0.13 *)
val update : int -> ('a option -> 'a option) -> 'a t -> 'a t
val cardinal : _ t -> int
(** Number of bindings in the map. Linear time *)
(** Number of bindings in the map. Linear time. *)
val iter : (int -> 'a -> unit) -> 'a t -> unit
@ -53,7 +53,7 @@ val map : ('a -> 'b) -> 'a t -> 'b t
val choose : 'a t -> (int * 'a) option
val choose_exn : 'a t -> int * 'a
(** @raise Not_found if not pair was found *)
(** @raise Not_found if not pair was found. *)
val union : (int -> 'a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t
@ -107,7 +107,7 @@ val as_tree : 'a t -> [`Node of int * int | `Leaf of int * 'a ] tree
type 'a printer = Format.formatter -> 'a -> unit
val print : 'a printer -> 'a t printer
val pp : 'a printer -> 'a t printer
(** @since 0.13 *)
(** Helpers *)

6
src/data/CCMixmap.ml
View file

@ -123,9 +123,13 @@ module Make(X : ORD) : S with type key = X.t = struct
let remove = M.remove
let is_some = function
| None -> false
| Some _ -> true
let mem ~inj x map =
try
inj.get (M.find x map) <> None
is_some (inj.get (M.find x map))
with Not_found -> false
let iter_keys ~f map =

26
src/data/CCMixmap.mli
View file

@ -37,9 +37,9 @@ type 'a injection
val create_inj : unit -> 'a injection
(** Return a value that works for a given type of values. This function is
normally called once for each type of value. Several keys may be
normally called once for each type of value. Several keys may be
created for the same type, but a value set with a given setter can only be
retrieved with the matching getter. The same key can be reused
retrieved with the matching getter. The same key can be reused
across multiple maps (although not in a thread-safe way). *)
module type S = sig
@ -49,50 +49,50 @@ module type S = sig
(** A map containing values of different types, indexed by {!key}. *)
val empty : t
(** Empty map *)
(** Empty map. *)
val get : inj:'a injection -> key -> t -> 'a option
(** Get the value corresponding to this key, if it exists and
belongs to the same key *)
belongs to the same key. *)
val add : inj:'a injection -> key -> 'a -> t -> t
(** Bind the key to the value, using [inj] *)
(** Bind the key to the value, using [inj]. *)
val find : inj:'a injection -> key -> t -> 'a
(** Find the value for the given key, which must be of the right type.
@raise Not_found if either the key is not found, or if its value
doesn't belong to the right type *)
doesn't belong to the right type. *)
val cardinal : t -> int
(** Number of bindings *)
(** Number of bindings. *)
val remove : key -> t -> t
(** Remove the binding for this key *)
(** Remove the binding for this key. *)
val mem : inj:_ injection-> key -> t -> bool
(** Is the given key in the map, with the right type? *)
val iter_keys : f:(key -> unit) -> t -> unit
(** Iterate on the keys of this map *)
(** Iterate on the keys of this map. *)
val fold_keys : f:('a -> key -> 'a) -> x:'a -> t -> 'a
(** Fold over the keys *)
(** Fold over the keys. *)
(** {2 Iterators} *)
type 'a sequence = ('a -> unit) -> unit
val keys_seq : t -> key sequence
(** All the keys *)
(** All the keys. *)
val bindings_of : inj:'a injection -> t -> (key * 'a) sequence
(** All the bindings that come from the corresponding injection *)
(** All the bindings that come from the corresponding injection. *)
type value =
| Value : ('a injection -> 'a option) -> value
val bindings : t -> (key * value) sequence
(** Iterate on all bindings *)
(** Iterate on all bindings. *)
end
module type ORD = sig

6
src/data/CCMixset.mli
View file

@ -45,8 +45,8 @@ val get : key:'a key -> t -> 'a option
(** [get ~key set] obtains the value for [key] in [set], if any. *)
val get_exn : key:'a key -> t -> 'a
(** Same as {!get}, but can fail
@raise Not_found if the key is not present *)
(** Same as {!get}, but can fail.
@raise Not_found if the key is not present. *)
val cardinal : t -> int
(** Number of mappings *)
(** Number of mappings. *)

6
src/data/CCMixtbl.ml
View file

@ -84,9 +84,13 @@ let remove tbl x = Hashtbl.remove tbl x
let copy tbl = Hashtbl.copy tbl
let is_some = function
| None -> false
| Some _ -> true
let mem ~inj tbl x =
try
inj.get (Hashtbl.find tbl x) <> None
is_some (inj.get (Hashtbl.find tbl x))
with Not_found -> false
(*$R

24
src/data/CCMixtbl.mli
View file

@ -53,49 +53,49 @@ val create_inj : unit -> 'b injection
val get : inj:'b injection -> 'a t -> 'a -> 'b option
(** Get the value corresponding to this key, if it exists and
belongs to the same key *)
belongs to the same key. *)
val set : inj:'b injection -> 'a t -> 'a -> 'b -> unit
(** Bind the key to the value, using [inj] *)
(** Bind the key to the value, using [inj]. *)
val find : inj:'b injection -> 'a t -> 'a -> 'b
(** Find the value for the given key, which must be of the right type.
@raise Not_found if either the key is not found, or if its value
doesn't belong to the right type *)
doesn't belong to the right type. *)
val length : 'a t -> int
(** Number of bindings *)
(** Number of bindings. *)
val clear : 'a t -> unit
(** Clear content of the hashtable *)
(** Clear content of the hashtable. *)
val remove : 'a t -> 'a -> unit
(** Remove the binding for this key *)
(** Remove the binding for this key. *)
val copy : 'a t -> 'a t
(** Copy of the table *)
(** Copy of the table. *)
val mem : inj:_ injection-> 'a t -> 'a -> bool
(** Is the given key in the table, with the right type? *)
val iter_keys : 'a t -> ('a -> unit) -> unit
(** Iterate on the keys of this table *)
(** Iterate on the keys of this table. *)
val fold_keys : 'a t -> 'b -> ('b -> 'a -> 'b) -> 'b
(** Fold over the keys *)
(** Fold over the keys. *)
(** {2 Iterators} *)
type 'a sequence = ('a -> unit) -> unit
val keys_seq : 'a t -> 'a sequence
(** All the keys *)
(** All the keys. *)
val bindings_of : inj:'b injection -> 'a t -> ('a * 'b) sequence
(** All the bindings that come from the corresponding injection *)
(** All the bindings that come from the corresponding injection. *)
type value =
| Value : ('b injection -> 'b option) -> value
val bindings : 'a t -> ('a * value) sequence
(** Iterate on all bindings *)
(** Iterate on all bindings. *)

25
src/data/CCMultiMap.ml
View file

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

85
src/data/CCMultiMap.mli
View file

@ -1,27 +1,4 @@
(*
copyright (c) 2013, simon cruanes
all rights reserved.
redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Multimap} *)
@ -33,59 +10,59 @@ module type S = sig
type t
val empty : t
(** Empty multimap *)
(** Empty multimap. *)
val is_empty : t -> bool
(** Empty multimap? *)
val add : t -> key -> value -> t
(** Add a key/value binding *)
(** Add a key/value binding. *)
val remove : t -> key -> value -> t
(** Remove the binding *)
(** Remove the binding. *)
val remove_all : t -> key -> t
(** Remove the key from the map *)
(** Remove the key from the map. *)
val mem : t -> key -> bool
(** Is there a binding for this key? *)
val find : t -> key -> value list
(** List of values for this key *)
(** List of values for this key. *)
val find_iter : t -> key -> (value -> unit) -> unit
(** Iterate on bindings for this key *)
(** Iterate on bindings for this key. *)
val count : t -> key -> int
(** Number of bindings for this key *)
(** Number of bindings for this key. *)
val iter : t -> (key -> value -> unit) -> unit
(** Iterate on all key/value *)
(** Iterate on all key/value. *)
val fold : t -> 'a -> ('a -> key -> value -> 'a) -> 'a
(** Fold on all key/value *)
(** Fold on all key/value. *)
val size : t -> int
(** Number of keys *)
(** Number of keys. *)
val union : t -> t -> t
(** Union of multimaps *)
(** Union of multimaps. *)
val inter : t -> t -> t
(** Intersection of multimaps *)
(** Intersection of multimaps. *)
val diff : t -> t -> t
(** Difference of maps, ie bindings of the first that are not
in the second *)
in the second. *)
val equal : t -> t -> bool
(** Same multimap *)
(** Same multimap. *)
val compare : t -> t -> int
(** Total order on multimaps *)
(** Total order on multimaps. *)
val submap : t -> t -> bool
(** [submap m1 m2] is true iff all bindings of [m1] are also in [m2] *)
(** [submap m1 m2] is true iff all bindings of [m1] are also in [m2]. *)
val to_seq : t -> (key * value) sequence
@ -94,7 +71,7 @@ module type S = sig
val keys : t -> key sequence
val values : t -> value sequence
(** Some values may occur several times *)
(** Some values may occur several times. *)
end
module type OrderedType = sig
@ -120,22 +97,22 @@ module type BIDIR = sig
val is_empty : t -> bool
val add : t -> left -> right -> t
(** Add a binding (left,right) *)
(** Add a binding (left,right). *)
val remove : t -> left -> right -> t
(** Remove a specific binding *)
(** Remove a specific binding. *)
val cardinal_left : t -> int
(** Number of distinct left keys *)
(** Number of distinct left keys. *)
val cardinal_right : t -> int
(** Number of distinct right keys *)
(** Number of distinct right keys. *)
val remove_left : t -> left -> t
(** Remove all bindings for the left key *)
(** Remove all bindings for the left key. *)
val remove_right : t -> right -> t
(** Remove all bindings for the right key *)
(** Remove all bindings for the right key. *)
val mem_left : t -> left -> bool
(** Is the left key present in at least one pair? *)
@ -144,25 +121,25 @@ module type BIDIR = sig
(** Is the right key present in at least one pair? *)
val find_left : t -> left -> right sequence
(** Find all bindings for this given left-key *)
(** Find all bindings for this given left-key. *)
val find_right : t -> right -> left sequence
(** Find all bindings for this given right-key *)
(** Find all bindings for this given right-key. *)
val find1_left : t -> left -> right option
(** like {!find_left} but returns at most one value *)
(** Like {!find_left} but returns at most one value. *)
val find1_right : t -> right -> left option
(** like {!find_right} but returns at most one value *)
(** Like {!find_right} but returns at most one value. *)
val fold : ('a -> left -> right -> 'a) -> 'a -> t -> 'a
(** Fold on pairs *)
(** Fold on pairs. *)
val pairs : t -> (left * right) sequence
(** Iterate on pairs *)
(** Iterate on pairs. *)
val add_pairs : t -> (left * right) sequence -> t
(** Add pairs *)
(** Add pairs. *)
val seq_left : t -> left sequence
val seq_right : t -> right sequence

7
src/data/CCMultiSet.ml
View file

@ -5,6 +5,9 @@
type 'a sequence = ('a -> unit) -> unit
let max_int = max
let min_int = min
module type S = sig
type elt
type t
@ -172,7 +175,7 @@ module Make(O : Set.OrderedType) = struct
(fun _ n1 n2 -> match n1, n2 with
| None, None -> assert false
| Some n, None | None, Some n -> Some n
| Some n1, Some n2 -> Some (Pervasives.max n1 n2))
| Some n1, Some n2 -> Some (max_int n1 n2))
m1 m2
let intersection m1 m2 =
@ -181,7 +184,7 @@ module Make(O : Set.OrderedType) = struct
| None, None -> assert false
| Some _, None
| None, Some _ -> None
| Some n1, Some n2 -> Some (Pervasives.min n1 n2))
| Some n1, Some n2 -> Some (min_int n1 n2))
m1 m2
let diff m1 m2 =

26
src/data/CCMultiSet.mli
View file

@ -24,31 +24,31 @@ module type S = sig
val remove : t -> elt -> t
val add_mult : t -> elt -> int -> t
(** [add_mult set x n] adds [n] occurrences of [x] to [set]
@raise Invalid_argument if [n < 0]
(** [add_mult set x n] adds [n] occurrences of [x] to [set].
@raise Invalid_argument if [n < 0].
@since 0.6 *)
val remove_mult : t -> elt -> int -> t
(** [remove_mult set x n] removes at most [n] occurrences of [x] from [set]
@raise Invalid_argument if [n < 0]
(** [remove_mult set x n] removes at most [n] occurrences of [x] from [set].
@raise Invalid_argument if [n < 0].
@since 0.6 *)
val remove_all : t -> elt -> t
(** [remove_all set x] removes all occurrences of [x] from [set]
(** [remove_all set x] removes all occurrences of [x] from [set].
@since 0.22 *)
val update : t -> elt -> (int -> int) -> t
(** [update set x f] calls [f n] where [n] is the current multiplicity
of [x] in [set] ([0] to indicate its absence); the result of [f n]
is the new multiplicity of [x].
@raise Invalid_argument if [f n < 0]
@raise Invalid_argument if [f n < 0].
@since 0.6 *)
val min : t -> elt
(** Minimal element w.r.t the total ordering on elements *)
(** Minimal element w.r.t the total ordering on elements. *)
val max : t -> elt
(** Maximal element w.r.t the total ordering on elements *)
(** Maximal element w.r.t the total ordering on elements. *)
val union : t -> t -> t
(** [union a b] contains as many occurrences of an element [x]
@ -56,25 +56,25 @@ module type S = sig
val meet : t -> t -> t
(** [meet a b] is a multiset such that
[count (meet a b) x = max (count a x) (count b x)] *)
[count (meet a b) x = max (count a x) (count b x)]. *)
val intersection : t -> t -> t
(** [intersection a b] is a multiset such that
[count (intersection a b) x = min (count a x) (count b x)] *)
[count (intersection a b) x = min (count a x) (count b x)]. *)
val diff : t -> t -> t
(** MultiSet difference.
[count (diff a b) x = max (count a x - count b x) 0] *)
[count (diff a b) x = max (count a x - count b x) 0]. *)
val contains : t -> t -> bool
(** [contains a x = (count m x > 0)] *)
(** [contains a x = (count m x > 0)]. *)
val compare : t -> t -> int
val equal : t -> t -> bool
val cardinal : t -> int
(** Number of distinct elements *)
(** Number of distinct elements. *)
val iter : t -> (int -> elt -> unit) -> unit

2
src/data/CCPersistentArray.ml
View file

@ -163,7 +163,7 @@ let to_gen a =
type 'a printer = Format.formatter -> 'a -> unit
let print pp_item out v =
let pp pp_item out v =
Format.fprintf out "[|";
iteri
(fun i x ->

24
src/data/CCPersistentArray.mli
View file

@ -43,24 +43,24 @@ val make : int -> 'a -> 'a t
array entries will modify all other entries at the same time.
@raise Invalid_argument if [n < 0] or [n > Sys.max_array_length].
If the value of x is a floating-point number, then the maximum size is
only [Sys.max_array_length / 2].*)
only [Sys.max_array_length / 2]. *)
val init : int -> (int -> 'a) -> 'a t
(** [make n f] returns a persistent array of length n, with element
(** [init n f] returns a persistent array of length n, with element
[i] initialized to the result of [f i].
@raise Invalid_argument if [n < 0] or [n > Sys.max_array_length].
If the value of x is a floating-point number, then the maximum size is
only [Sys.max_array_length / 2].*)
only [Sys.max_array_length / 2]. *)
val get : 'a t -> int -> 'a
(** [get a i] returns the element with index [i] from the array [a].
@raise Invalid_argument "index out of bounds" if [n] is outside the
range [0] to [Array.length a - 1].*)
range [0] to [Array.length a - 1]. *)
val set : 'a t -> int -> 'a -> 'a t
(** [set a i v] sets the element index [i] from the array [a] to [v].
@raise Invalid_argument "index out of bounds" if [n] is outside the
range [0] to [Array.length a - 1].*)
range [0] to [Array.length a - 1]. *)
val length : 'a t -> int
(** Returns the length of the persistent array. *)
@ -76,31 +76,31 @@ val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
It is equivalent to [fun f t -> init (fun i -> f (get t i))]. *)
val iter : ('a -> unit) -> 'a t -> unit
val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** [iter f t] applies function [f] to all elements of the persistent array,
in order from element [0] to element [length t - 1]. *)
val iteri : (int -> 'a -> unit) -> 'a t -> unit
val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b
(** Fold on the elements of the array. *)
val append : 'a t -> 'a t -> 'a t
(** Append the two arrays
(** Append the two arrays.
@since 0.13 *)
val flatten : 'a t t -> 'a t
(** Concatenates all the sub-arrays
(** Concatenates all the sub-arrays.
@since 0.13 *)
val flat_map : ('a -> 'b t) -> 'a t -> 'b t
(** Flat map (map + concatenation)
(** Flat map (map + concatenation).
@since 0.13 *)
val to_array : 'a t -> 'a array
(** [to_array t] returns a mutable copy of [t]. *)
val of_array : 'a array -> 'a t
(** [from_array a] returns an immutable copy of [a]. *)
(** [of_array a] returns an immutable copy of [a]. *)
val to_list : 'a t -> 'a list
(** [to_list t] returns the list of elements in [t]. *)
@ -109,7 +109,7 @@ val of_list : 'a list -> 'a t
(** [of_list l] returns a fresh persistent array containing the elements of [l]. *)
val of_rev_list : 'a list -> 'a t
(** [of_rev_list l] is the same as [of_list (List.rev l)] but more efficient
(** [of_rev_list l] is the same as [of_list (List.rev l)] but more efficient.
@since 0.13 *)
(** {2 Conversions} *)
@ -131,5 +131,5 @@ val to_gen : 'a t -> 'a gen
type 'a printer = Format.formatter -> 'a -> unit
val print : 'a printer -> 'a t printer
val pp : 'a printer -> 'a t printer
(** @since 0.13 *)

28
src/data/CCPersistentHashtbl.mli
View file

@ -27,29 +27,29 @@ module type S = sig
type 'a t
val empty : unit -> 'a t
(** Empty table. The table will be allocated at the first binding *)
(** Empty table. The table will be allocated at the first binding. *)
val create : int -> 'a t
(** Create a new hashtable, with the given initial capacity *)
(** Create a new hashtable, with the given initial capacity. *)
val is_empty : 'a t -> bool
(** Is the table empty? *)
val find : 'a t -> key -> 'a
(** Find the value for this key, or fails
@raise Not_found if the key is not present in the table *)
(** Find the value for this key, or fails.
@raise Not_found if the key is not present in the table. *)
val get_exn : key -> 'a t -> 'a
(** Synonym to {!find} with flipped arguments *)
(** Synonym to {!find} with flipped arguments. *)
val get : key -> 'a t -> 'a option
(** Safe version of !{get_exn} *)
(** Safe version of !{get_exn}. *)
val mem : 'a t -> key -> bool
(** Is the key bound? *)
val length : _ t -> int
(** Number of bindings *)
(** Number of bindings. *)
val add : 'a t -> key -> 'a -> 'a t
(** Add the binding to the table, returning a new table. The old binding
@ -67,11 +67,11 @@ module type S = sig
[key] is removed, else it returns [Some v'] and [key -> v'] is added. *)
val remove : 'a t -> key -> 'a t
(** Remove the key *)
(** Remove the key. *)
val copy : 'a t -> 'a t
(** Fresh copy of the table; the underlying structure is not shared
anymore, so using both tables alternatively will be efficient *)
anymore, so using both tables alternatively will be efficient. *)
val merge :
f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) ->
@ -81,13 +81,13 @@ module type S = sig
function returns [None] the key will not appear in the result. *)
val iter : 'a t -> (key -> 'a -> unit) -> unit
(** Iterate over bindings *)
(** Iterate over bindings. *)
val fold : ('b -> key -> 'a -> 'b) -> 'b -> 'a t -> 'b
(** Fold over bindings *)
(** Fold over bindings. *)
val map : (key -> 'a -> 'b) -> 'a t -> 'b t
(** Map all values *)
(** Map all values. *)
val filter : (key -> 'a -> bool) -> 'a t -> 'a t
@ -100,7 +100,7 @@ module type S = sig
(** {3 Conversions} *)
val of_seq : (key * 'a) sequence -> 'a t
(** Add (replace) bindings from the sequence to the table *)
(** Add (replace) bindings from the sequence to the table. *)
val of_list : (key * 'a) list -> 'a t
@ -109,7 +109,7 @@ module type S = sig
val add_list : 'a t -> (key * 'a) list -> 'a t
val to_seq : 'a t -> (key * 'a) sequence
(** Sequence of the bindings of the table *)
(** Sequence of the bindings of the table. *)
val to_list : 'a t -> (key * 'a) list

12
src/data/CCRAL.ml
View file

@ -96,7 +96,7 @@ let tl l = match l with
(*$Q
Q.(list_of_size Gen.(1--100) int) (fun l -> \
let l' = of_list l in \
(not (is_empty l')) ==> (equal l' (cons (hd l') (tl l'))) )
(not (is_empty l')) ==> (equal ~eq:CCInt.equal l' (cons (hd l') (tl l'))) )
*)
let front l = match l with
@ -371,7 +371,7 @@ let drop_while ~f l =
let take_drop n l = take n l, drop n l
let equal ?(eq=(=)) l1 l2 =
let equal ~eq l1 l2 =
let rec aux ~eq l1 l2 = match l1, l2 with
| Nil, Nil -> true
| Cons (size1, t1, l1'), Cons (size2, t2, l2') ->
@ -389,7 +389,7 @@ let equal ?(eq=(=)) l1 l2 =
(*$Q
Q.(pair (list int)(list int)) (fun (l1,l2) -> \
equal (of_list l1) (of_list l2) = (l1=l2))
equal ~eq:CCInt.equal (of_list l1) (of_list l2) = (l1=l2))
*)
(** {2 Utils} *)
@ -543,7 +543,7 @@ let rec of_list_map ~f l = match l with
let y = f x in
cons y (of_list_map ~f l')
let compare ?(cmp=Pervasives.compare) l1 l2 =
let compare ~cmp l1 l2 =
let rec cmp_gen ~cmp g1 g2 = match g1(), g2() with
| None, None -> 0
| Some _, None -> 1
@ -556,7 +556,7 @@ let compare ?(cmp=Pervasives.compare) l1 l2 =
(*$Q
Q.(pair (list int)(list int)) (fun (l1,l2) -> \
compare (of_list l1) (of_list l2) = (Pervasives.compare l1 l2))
compare ~cmp:CCInt.compare (of_list l1) (of_list l2) = (Pervasives.compare l1 l2))
*)
(** {2 Infix} *)
@ -576,7 +576,7 @@ include Infix
type 'a printer = Format.formatter -> 'a -> unit
let print ?(sep=", ") pp_item fmt l =
let pp ?(sep=", ") pp_item fmt l =
let first = ref true in
iter l
~f:(fun x ->

68
src/data/CCRAL.mli
View file

@ -18,50 +18,50 @@ type +'a t
(** List containing elements of type 'a *)
val empty : 'a t
(** Empty list *)
(** Empty list. *)
val is_empty : _ t -> bool
(** Check whether the list is empty *)
(** Check whether the list is empty. *)
val cons : 'a -> 'a t -> 'a t
(** Add an element at the front of the list *)
(** Add an element at the front of the list. *)
val return : 'a -> 'a t
(** Singleton *)
(** Singleton. *)
val map : f:('a -> 'b) -> 'a t -> 'b t
(** Map on elements *)
(** Map on elements. *)
val mapi : f:(int -> 'a -> 'b) -> 'a t -> 'b t
(** Map with index *)
(** Map with index. *)
val hd : 'a t -> 'a
(** First element of the list, or
@raise Invalid_argument if the list is empty *)
@raise Invalid_argument if the list is empty. *)
val tl : 'a t -> 'a t
(** Remove the first element from the list, or
@raise Invalid_argument if the list is empty *)
@raise Invalid_argument if the list is empty. *)
val front : 'a t -> ('a * 'a t) option
(** Remove and return the first element of the list *)
(** Remove and return the first element of the list. *)
val front_exn : 'a t -> 'a * 'a t
(** Unsafe version of {!front}.
@raise Invalid_argument if the list is empty *)
@raise Invalid_argument if the list is empty. *)
val length : 'a t -> int
(** Number of elements. Complexity O(ln n) where n=number of elements *)
(** Number of elements. Complexity [O(ln n)] where n=number of elements. *)
val get : 'a t -> int -> 'a option
(** [get l i] accesses the [i]-th element of the list. O(log(n)). *)
(** [get l i] accesses the [i]-th element of the list. [O(log(n))]. *)
val get_exn : 'a t -> int -> 'a
(** Unsafe version of {!get}
(** Unsafe version of {!get}.
@raise Invalid_argument if the list has less than [i+1] elements. *)
val set : 'a t -> int -> 'a -> 'a t
(** [set l i v] sets the [i]-th element of the list to [v]. O(log(n)).
(** [set l i v] sets the [i]-th element of the list to [v]. [O(log(n))].
@raise Invalid_argument if the list has less than [i+1] elements. *)
val remove : 'a t -> int -> 'a t
@ -90,39 +90,39 @@ val drop_while : f:('a -> bool) -> 'a t -> 'a t
val take_drop : int -> 'a t -> 'a t * 'a t
(** [take_drop n l] splits [l] into [a, b] such that [length a = n]
if [length l >= n], and such that [append a b = l] *)
if [length l >= n], and such that [append a b = l]. *)
val iter : f:('a -> unit) -> 'a t -> unit
(** Iterate on the list's elements *)
(** Iterate on the list's elements. *)
val iteri : f:(int -> 'a -> unit) -> 'a t -> unit
val fold : f:('b -> 'a -> 'b) -> x:'b -> 'a t -> 'b
(** Fold on the list's elements *)
(** Fold on the list's elements. *)
val fold_rev : f:('b -> 'a -> 'b) -> x:'b -> 'a t -> 'b
(** Fold on the list's elements, in reverse order (starting from the tail) *)
(** Fold on the list's elements, in reverse order (starting from the tail). *)
val rev_map : f:('a -> 'b) -> 'a t -> 'b t
(** [rev_map f l] is the same as [map f (rev l)] *)
(** [rev_map f l] is the same as [map f (rev l)]. *)
val rev : 'a t -> 'a t
(** Reverse the list *)
(** Reverse the list. *)
val equal : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val equal : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val compare : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
(** Lexicographic comparison *)
val compare : cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
(** Lexicographic comparison. *)
(** {2 Utils} *)
val make : int -> 'a -> 'a t
val repeat : int -> 'a t -> 'a t
(** [repeat n l] is [append l (append l ... l)] [n] times *)
(** [repeat n l] is [append l (append l ... l)] [n] times. *)
val range : int -> int -> int t
(** [range i j] is [i; i+1; ... ; j] or [j; j-1; ...; i] *)
(** [range i j] is [i; i+1; ... ; j] or [j; j-1; ...; i]. *)
(** {2 Conversions} *)
@ -132,19 +132,19 @@ type 'a gen = unit -> 'a option
val add_list : 'a t -> 'a list -> 'a t
val of_list : 'a list -> 'a t
(** Convert a list to a RAL. {b Caution}: non tail-rec *)
(** Convert a list to a RAL. {b Caution}: non tail-rec. *)
val to_list : 'a t -> 'a list
val of_list_map : f:('a -> 'b) -> 'a list -> 'b t
(** Combination of {!of_list} and {!map} *)
(** Combination of {!of_list} and {!map}. *)
val of_array : 'a array -> 'a t
val add_array : 'a t -> 'a array -> 'a t
val to_array : 'a t -> 'a array
(** More efficient than on usual lists *)
(** More efficient than on usual lists. *)
val add_seq : 'a t -> 'a sequence -> 'a t
@ -162,22 +162,22 @@ val to_gen : 'a t -> 'a gen
module Infix : sig
val (@+) : 'a -> 'a t -> 'a t
(** Cons (alias to {!cons}) *)
(** Cons (alias to {!cons}). *)
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
(** Alias to {!flat_map} *)
(** Alias to {!flat_map}. *)
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
(** Alias to {!map} *)
(** Alias to {!map}. *)
val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
(** Alias to {!app} *)
val (--) : int -> int -> int t
(** Alias to {!range} *)
(** Alias to {!range}. *)
val (--^) : int -> int -> int t
(** [a -- b] is the integer range from [a] to [b], where [b] is excluded.
(** [a --^ b] is the integer range from [a] to [b], where [b] is excluded.
@since 0.17 *)
end
@ -187,4 +187,4 @@ include module type of Infix
type 'a printer = Format.formatter -> 'a -> unit
val print : ?sep:string -> 'a printer -> 'a t printer
val pp : ?sep:string -> 'a printer -> 'a t printer

36
src/data/CCRingBuffer.mli
View file

@ -28,31 +28,31 @@ module Array : sig
type t
val create : int -> t
(** Make an array of the given size, filled with dummy elements *)
(** Make an array of the given size, filled with dummy elements. *)
val length: t -> int
(** [length t] gets the total number of elements currently in [t] *)
(** [length t] gets the total number of elements currently in [t]. *)
val get: t -> int -> elt
(** [get t i] gets the element at position [i] *)
(** [get t i] gets the element at position [i]. *)
val set: t -> int -> elt -> unit
(** [set t i e] sets the element at position [i] to [e] *)
(** [set t i e] sets the element at position [i] to [e]. *)
val sub: t -> int -> int -> t
(** [sub t i len] gets the subarray of [t] from
position [i] to [i + len] *)
(** [sub t i len] gets the sub-array of [t] from
position [i] to [i + len]. *)
val copy : t -> t
(** [copy t] makes a fresh copy of the array [t] *)
(** [copy t] makes a fresh copy of the array [t]. *)
val blit : t -> int -> t -> int -> int -> unit
(** [blit t s arr i len] copies [len] elements from [arr] starting at [i]
to position [s] from [t] *)
to position [s] from [t]. *)
val iter : (elt -> unit) -> t -> unit
(** [iter f t] iterates over the array [t] invoking [f] with
the current element, in array order *)
the current element, in array order. *)
end
(** Efficient array version for the [char] type *)
@ -82,7 +82,7 @@ module type S = sig
(** [create size] creates a new bounded buffer with given size.
The underlying array is allocated immediately and no further (large)
allocation will happen from now on.
@raise Invalid_argument if the arguments is [< 1] *)
@raise Invalid_argument if the arguments is [< 1]. *)
val copy : t -> t
(** Make a fresh copy of the buffer. *)
@ -102,7 +102,7 @@ module type S = sig
a input buffer [from_buf] to the end of the buffer.
If the slice is too large for the buffer, only the last part of the array
will be copied.
@raise Invalid_argument if [o,len] is not a valid slice of [s] *)
@raise Invalid_argument if [o,len] is not a valid slice of [s]. *)
val blit_into : t -> Array.t -> int -> int -> int
(** [blit_into buf to_buf o len] copies at most [len] elements from [buf]
@ -115,7 +115,7 @@ module type S = sig
end of [into]. Erases data of [into] if there is not enough room. *)
val to_list : t -> Array.elt list
(** Extract the current content into a list *)
(** Extract the current content into a list. *)
val clear : t -> unit
(** Clear the content of the buffer. Doesn't actually destroy the content. *)
@ -136,7 +136,7 @@ module type S = sig
@raise Invalid_argument if [len > length b]. *)
val iter : t -> f:(Array.elt -> unit) -> unit
(** [iter b ~f] calls [f i t] for each element [t] in [buf] *)
(** [iter b ~f] calls [f i t] for each element [t] in [buf]. *)
val iteri : t -> f:(int -> Array.elt -> unit) -> unit
(** [iteri b ~f] calls [f i t] for each element [t] in [buf], with [i]
@ -145,12 +145,12 @@ module type S = sig
val get_front : t -> int -> Array.elt
(** [get_front buf i] returns the [i]-th element of [buf] from the front, ie
the one returned by [take_front buf] after [i-1] calls to [junk_front buf].
@raise Invalid_argument if the index is invalid (> [length buf]) *)
@raise Invalid_argument if the index is invalid (> [length buf]). *)
val get_back : t -> int -> Array.elt
(** [get_back buf i] returns the [i]-th element of [buf] from the back, ie
the one returned by [take_back buf] after [i-1] calls to [junk_back buf].
@raise Invalid_argument if the index is invalid (> [length buf]) *)
@raise Invalid_argument if the index is invalid (> [length buf]). *)
val push_back : t -> Array.elt -> unit
(** Push value at the back of [t].
@ -174,14 +174,14 @@ module type S = sig
@since 1.3 *)
val take_back : t -> Array.elt option
(** Take and remove the last value from back of [t], if any *)
(** Take and remove the last value from back of [t], if any. *)
val take_back_exn : t -> Array.elt
(** Take and remove the last value from back of [t].
@raise Empty if buffer is already empty. *)
val take_front : t -> Array.elt option
(** Take and remove the first value from front of [t], if any *)
(** Take and remove the first value from front of [t], if any. *)
val take_front_exn : t -> Array.elt
(** Take and remove the first value from front of [t].
@ -189,7 +189,7 @@ module type S = sig
val of_array : Array.t -> t
(** Create a buffer from an initial array, but doesn't take ownership
of it (stills allocates a new internal array)
of it (still allocates a new internal array).
@since 0.11 *)
val to_array : t -> Array.t

10
src/data/CCSimple_queue.ml
View file

@ -23,7 +23,11 @@ let make_ hd tl = match hd with
| [] -> {hd=List.rev tl; tl=[] }
| _::_ -> {hd; tl; }
let is_empty q = q.hd = []
let list_is_empty = function
| [] -> true
| _::_ -> false
let is_empty q = list_is_empty q.hd
let push x q = make_ q.hd (x :: q.tl)
@ -31,7 +35,7 @@ let snoc q x = push x q
let peek_exn q =
match q.hd with
| [] -> assert (q.tl = []); invalid_arg "Queue.peek"
| [] -> assert (list_is_empty q.tl); invalid_arg "Queue.peek"
| x::_ -> x
let peek q = match q.hd with
@ -40,7 +44,7 @@ let peek q = match q.hd with
let pop_exn q =
match q.hd with
| [] -> assert (q.tl = []); invalid_arg "Queue.peek"
| [] -> assert (list_is_empty q.tl); invalid_arg "Queue.peek"
| x::hd' ->
let q' = make_ hd' q.tl in
x, q'

22
src/data/CCSimple_queue.mli
View file

@ -19,24 +19,24 @@ val empty : 'a t
val is_empty : 'a t -> bool
val push : 'a -> 'a t -> 'a t
(** Push element at the end of the queue *)
(** Push element at the end of the queue. *)
val snoc : 'a t -> 'a -> 'a t
(** Flip version of {!push} *)
(** Flip version of {!push}. *)
val peek : 'a t -> 'a option
(** First element of the queue *)
(** First element of the queue. *)
val peek_exn : 'a t -> 'a
(** Same as {!peek} but
@raise Invalid_argument if the queue is empty *)
@raise Invalid_argument if the queue is empty. *)
val pop : 'a t -> ('a * 'a t) option
(** Get and remove the first element *)
(** Get and remove the first element. *)
val pop_exn : 'a t -> ('a * 'a t)
(** Same as {!pop}, but fails on empty queues.
@raise Invalid_argument if the queue is empty *)
@raise Invalid_argument if the queue is empty. *)
val junk : 'a t -> 'a t
(** Remove first element. If the queue is empty, do nothing. *)
@ -47,7 +47,7 @@ val append : 'a t -> 'a t -> 'a t
Linear in the size of the second queue. *)
val map : ('a -> 'b) -> 'a t -> 'b t
(** Map values *)
(** Map values. *)
val rev : 'a t -> 'a t
(** Reverse the queue. Constant time. *)
@ -55,15 +55,15 @@ val rev : 'a t -> 'a t
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
module Infix : sig
val (>|=) : 'a t -> ('a -> 'b) -> 'b t (** Alias to {!map} *)
val (@) : 'a t -> 'a t -> 'a t (** Alias to {!append} *)
val (<::) : 'a t -> 'a -> 'a t (** Alias to {!snoc} *)
val (>|=) : 'a t -> ('a -> 'b) -> 'b t (** Alias to {!map}. *)
val (@) : 'a t -> 'a t -> 'a t (** Alias to {!append}. *)
val (<::) : 'a t -> 'a -> 'a t (** Alias to {!snoc}. *)
end
include module type of Infix
val length : 'a t -> int
(** Number of elements in the queue (linear in time) *)
(** Number of elements in the queue (linear in time). *)
val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b

2
src/data/CCTrie.ml
View file

@ -527,7 +527,7 @@ module Make(W : WORD)
| Empty -> 0
| Cons (_, t') -> size t'
| Node (v, map) ->
let s = if v=None then 0 else 1 in
let s = match v with None -> 0 | Some _ -> 1 in
M.fold
(fun _ t' acc -> size t' + acc)
map s

24
src/data/CCTrie.mli
View file

@ -32,17 +32,17 @@ module type S = sig
val is_empty : _ t -> bool
val add : key -> 'a -> 'a t -> 'a t
(** Add a binding to the trie (possibly erasing the previous one) *)
(** Add a binding to the trie (possibly erasing the previous one). *)
val remove : key -> 'a t -> 'a t
(** Remove the key, if present *)
(** Remove the key, if present. *)
val find : key -> 'a t -> 'a option
(** Find the value associated with the key, if any *)
(** Find the value associated with the key, if any. *)
val find_exn : key -> 'a t -> 'a
(** Same as {!find} but can fail.
@raise Not_found if the key is not present *)
@raise Not_found if the key is not present. *)
val longest_prefix : key -> 'a t -> key
(** [longest_prefix k m] finds the longest prefix of [k] that leads to
@ -50,7 +50,7 @@ module type S = sig
a value.
Example: if [m] has keys "abc0" and "abcd", then [longest_prefix "abc2" m]
will return "abc"
will return "abc".
@since 0.17 *)
@ -58,7 +58,7 @@ module type S = sig
(** Update the binding for the given key. The function is given
[None] if the key is absent, or [Some v] if [key] is bound to [v];
if it returns [None] the key is removed, otherwise it
returns [Some y] and [key] becomes bound to [y] *)
returns [Some y] and [key] becomes bound to [y]. *)
val fold : ('b -> key -> 'a -> 'b) -> 'b -> 'a t -> 'b
(** Fold on key/value bindings. Will use {!WORD.of_list} to rebuild keys. *)
@ -72,19 +72,19 @@ module type S = sig
@since 0.17 *)
val iter : (key -> 'a -> unit) -> 'a t -> unit
(** Same as {!fold}, but for effectful functions *)
(** Same as {!fold}, but for effectful functions. *)
val fold_values : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
(** More efficient version of {!fold}, that doesn't keep keys *)
(** More efficient version of {!fold}, that doesn't keep keys. *)
val iter_values : ('a -> unit) -> 'a t -> unit
val merge : ('a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
(** Merge two tries together. The function is used in
case of conflicts, when a key belongs to both tries *)
case of conflicts, when a key belongs to both tries. *)
val size : _ t -> int
(** Number of bindings *)
(** Number of bindings. *)
(** {6 Conversions} *)
@ -104,11 +104,11 @@ module type S = sig
val above : key -> 'a t -> (key * 'a) sequence
(** All bindings whose key is bigger or equal to the given key, in
ascending order *)
ascending order. *)
val below : key -> 'a t -> (key * 'a) sequence
(** All bindings whose key is smaller or equal to the given key,
in decreasing order *)
in decreasing order. *)
(**/**)
val check_invariants: _ t -> bool

4
src/data/CCWBTree.ml
View file

@ -161,7 +161,7 @@ module type S = sig
val to_gen : 'a t -> (key * 'a) gen
val print : key printer -> 'a printer -> 'a t printer
val pp : key printer -> 'a printer -> 'a t printer
(**/**)
val node_ : key -> 'a -> 'a t -> 'a t -> 'a t
@ -588,7 +588,7 @@ module MakeFull(K : KEY) : S with type key = K.t = struct
Some (k,v)
in next
let print pp_k pp_v fmt m =
let pp pp_k pp_v fmt m =
let start = "[" and stop = "]" and arrow = "->" and sep = ","in
Format.pp_print_string fmt start;
let first = ref true in

26
src/data/CCWBTree.mli
View file

@ -38,14 +38,14 @@ module type S = sig
val get : key -> 'a t -> 'a option
val get_exn : key -> 'a t -> 'a
(** @raise Not_found if the key is not present *)
(** @raise Not_found if the key is not present. *)
val nth : int -> 'a t -> (key * 'a) option
(** [nth i m] returns the [i]-th [key, value] in the ascending
order. Complexity is [O(log (cardinal m))] *)
order. Complexity is [O(log (cardinal m))]. *)
val nth_exn : int -> 'a t -> key * 'a
(** @raise Not_found if the index is invalid *)
(** @raise Not_found if the index is invalid. *)
val get_rank : key -> 'a t -> [`At of int | `After of int | `First]
(** [get_rank k m] looks for the rank of [k] in [m], i.e. the index
@ -60,7 +60,7 @@ module type S = sig
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
(** [update k f m] calls [f (Some v)] if [get k m = Some v], [f None]
otherwise. Then, if [f] returns [Some v'] it binds [k] to [v'],
if [f] returns [None] it removes [k] *)
if [f] returns [None] it removes [k]. *)
val cardinal : _ t -> int
@ -83,30 +83,30 @@ module type S = sig
val split : key -> 'a t -> 'a t * 'a option * 'a t
(** [split k t] returns [l, o, r] where [l] is the part of the map
with keys smaller than [k], [r] has keys bigger than [k],
and [o = Some v] if [k, v] belonged to the map *)
and [o = Some v] if [k, v] belonged to the map. *)
val merge : f:(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
(** Similar to {!Map.S.merge} *)
(** Similar to {!Map.S.merge}. *)
val extract_min : 'a t -> key * 'a * 'a t
(** [extract_min m] returns [k, v, m'] where [k,v] is the pair with the
smallest key in [m], and [m'] does not contain [k].
@raise Not_found if the map is empty *)
@raise Not_found if the map is empty. *)
val extract_max : 'a t -> key * 'a * 'a t
(** [extract_max m] returns [k, v, m'] where [k,v] is the pair with the
highest key in [m], and [m'] does not contain [k].
@raise Not_found if the map is empty *)
@raise Not_found if the map is empty. *)
val choose : 'a t -> (key * 'a) option
val choose_exn : 'a t -> key * 'a
(** @raise Not_found if the tree is empty *)
(** @raise Not_found if the tree is empty. *)
val random_choose : Random.State.t -> 'a t -> key * 'a
(** Randomly choose a (key,value) pair within the tree, using weights
as probability weights
@raise Not_found if the tree is empty *)
as probability weights.
@raise Not_found if the tree is empty. *)
val add_list : 'a t -> (key * 'a) list -> 'a t
@ -126,7 +126,9 @@ module type S = sig
val to_gen : 'a t -> (key * 'a) gen
val print : key printer -> 'a printer -> 'a t printer
val pp : key printer -> 'a printer -> 'a t printer
(** Renamed from [val print].
@since NEXT_RELEASE *)
(**/**)
val node_ : key -> 'a -> 'a t -> 'a t -> 'a t

28
src/data/CCZipper.mli
View file

@ -10,7 +10,7 @@ type 'a t = 'a list * 'a list
with the focus on [r]. *)
val empty : 'a t
(** Empty zipper *)
(** Empty zipper. *)
val is_empty : _ t -> bool
(** Empty zipper? Returns true iff the two lists are empty. *)
@ -22,36 +22,36 @@ val is_empty : _ t -> bool
val to_list : 'a t -> 'a list
(** Convert the zipper back to a list.
[to_list (l,r)] is [List.rev_append l r] *)
[to_list (l,r)] is [List.rev_append l r]. *)
val to_rev_list : 'a t -> 'a list
(** Convert the zipper back to a {i reversed} list.
In other words, [to_list (l,r)] is [List.rev_append r l] *)
In other words, [to_list (l,r)] is [List.rev_append r l]. *)
val make : 'a list -> 'a t
(** Create a zipper pointing at the first element of the list *)
(** Create a zipper pointing at the first element of the list. *)
val left : 'a t -> 'a t
(** Go to the left, or do nothing if the zipper is already at leftmost pos *)
(** Go to the left, or do nothing if the zipper is already at leftmost pos. *)
val left_exn : 'a t -> 'a t
(** Go to the left, or
@raise Invalid_argument if the zipper is already at leftmost pos *)
@raise Invalid_argument if the zipper is already at leftmost pos. *)
val right : 'a t -> 'a t
(** Go to the right, or do nothing if the zipper is already at rightmost pos *)
(** Go to the right, or do nothing if the zipper is already at rightmost pos. *)
val right_exn : 'a t -> 'a t
(** Go to the right, or
@raise Invalid_argument if the zipper is already at rightmost pos *)
@raise Invalid_argument if the zipper is already at rightmost pos. *)
val modify : ('a option -> 'a option) -> 'a t -> 'a t
(** Modify the current element, if any, by returning a new element, or
returning [None] if the element is to be deleted *)
returning [None] if the element is to be deleted. *)
val insert : 'a -> 'a t -> 'a t
(** Insert an element at the current position. If an element was focused,
[insert x l] adds [x] just before it, and focuses on [x] *)
[insert x l] adds [x] just before it, and focuses on [x]. *)
val remove : 'a t -> 'a t
(** [remove l] removes the current element, if any. *)
@ -61,12 +61,12 @@ val is_focused : _ t -> bool
return a [Some v]? *)
val focused : 'a t -> 'a option
(** Returns the focused element, if any. [focused zip = Some _] iff
[empty zip = false] *)
(** Return the focused element, if any. [focused zip = Some _] iff
[empty zip = false]. *)
val focused_exn : 'a t -> 'a
(** Returns the focused element, or
@raise Not_found if the zipper is at an end *)
(** Return the focused element, or
@raise Not_found if the zipper is at an end. *)
val drop_before : 'a t -> 'a t
(** Drop every element on the "left" (calling {!left} then will do nothing). *)

9
src/data/jbuild Normal file
View file

@ -0,0 +1,9 @@
(library
((name containers_data)
(public_name containers.data)
(wrapped false)
(flags (:standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string))
(ocamlopt_flags (:standard (:include ../flambda.flags)))
(libraries (bytes result))
))

4
src/iter/CCKList.ml
View file

@ -422,11 +422,11 @@ let of_gen g =
assert_equal [11;12] (drop 10 l |> take 2 |> to_list);
*)
let sort ?(cmp=Pervasives.compare) l =
let sort ~cmp l =
let l = to_list l in
of_list (List.sort cmp l)
let sort_uniq ?(cmp=Pervasives.compare) l =
let sort_uniq ~cmp l =
let l = to_list l in
uniq (fun x y -> cmp x y = 0) (of_list (List.sort cmp l))

64
src/iter/CCKList.mli
View file

@ -35,28 +35,28 @@ val cycle : 'a t -> 'a t
val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t
(** [unfold f acc] calls [f acc] and:
- if [f acc = Some (x, acc')], yield [x], continue with [unfold f acc']
- if [f acc = None], stops
- if [f acc = Some (x, acc')], yield [x], continue with [unfold f acc'].
- if [f acc = None], stops.
@since 0.13 *)
val is_empty : 'a t -> bool
val head : 'a t -> 'a option
(** Head of the list
(** Head of the list.
@since 0.13 *)
val head_exn : 'a t -> 'a
(** Unsafe version of {!head}
@raise Not_found if the list is empty
(** Unsafe version of {!head}.
@raise Not_found if the list is empty.
@since 0.13 *)
val tail : 'a t -> 'a t option
(** Tail of the list
(** Tail of the list.
@since 0.13 *)
val tail_exn : 'a t -> 'a t
(** Unsafe version of {!tail}
@raise Not_found if the list is empty
(** Unsafe version of {!tail}.
@raise Not_found if the list is empty.
@since 0.13 *)
val equal : 'a equal -> 'a t equal
@ -66,12 +66,12 @@ val compare : 'a ord -> 'a t ord
(** Lexicographic comparison. Eager. *)
val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
(** Fold on values *)
(** Fold on values. *)
val iter : ('a -> unit) -> 'a t -> unit
val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** Iterate with index (starts at 0)
(** Iterate with index (starts at 0).
@since 0.13 *)
val length : _ t -> int
@ -90,7 +90,7 @@ val drop_while : ('a -> bool) -> 'a t -> 'a t
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
(** Map with index (starts at 0)
(** Map with index (starts at 0).
@since 0.13 *)
val fmap : ('a -> 'b option) -> 'a t -> 'b t
@ -101,17 +101,17 @@ val append : 'a t -> 'a t -> 'a t
val product_with : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Fair product of two (possibly infinite) lists into a new list. Lazy.
The first parameter is used to combine each pair of elements
The first parameter is used to combine each pair of elements.
@since 0.3.3 *)
val product : 'a t -> 'b t -> ('a * 'b) t
(** Specialization of {!product_with} producing tuples
(** Specialization of {!product_with} producing tuples.
@since 0.3.3 *)
val group : 'a equal -> 'a t -> 'a t t
(** [group eq l] groups together consecutive elements that satisfy [eq]. Lazy.
For instance [group (=) [1;1;1;2;2;3;3;1]] yields
[[1;1;1]; [2;2]; [3;3]; [1]]
[[1;1;1]; [2;2]; [3;3]; [1]].
@since 0.3.3 *)
val uniq : 'a equal -> 'a t -> 'a t
@ -130,7 +130,7 @@ val range : int -> int -> int t
val (--) : int -> int -> int t
(** [a -- b] is the range of integers containing
[a] and [b] (therefore, never empty) *)
[a] and [b] (therefore, never empty). *)
val (--^) : int -> int -> int t
(** [a -- b] is the integer range from [a] to [b], where [b] is excluded.
@ -139,43 +139,43 @@ val (--^) : int -> int -> int t
(** {2 Operations on two Collections} *)
val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
(** Fold on two collections at once. Stop at soon as one of them ends *)
(** Fold on two collections at once. Stop at soon as one of them ends. *)
val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Map on two collections at once. Stop as soon as one of the
arguments is exhausted *)
arguments is exhausted. *)
val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit
(** Iterate on two collections at once. Stop as soon as one of them ends *)
(** Iterate on two collections at once. Stop as soon as one of them ends. *)
val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
val merge : 'a ord -> 'a t -> 'a t -> 'a t
(** Merge two sorted iterators into a sorted iterator *)
(** Merge two sorted iterators into a sorted iterator. *)
val zip : 'a t -> 'b t -> ('a * 'b) t
(** Combine elements pairwise. Stops as soon as one of the lists stops.
@since 0.13 *)
val unzip : ('a * 'b) t -> 'a t * 'b t
(** Splits each tuple in the list
(** Splits each tuple in the list.
@since 0.13 *)
(** {2 Misc} *)
val sort : ?cmp:'a ord -> 'a t -> 'a t
(** Eager sort. Requires the iterator to be finite. O(n ln(n)) time
val sort : cmp:'a ord -> 'a t -> 'a t
(** Eager sort. Requires the iterator to be finite. [O(n ln(n))] time
and space.
@since 0.3.3 *)
val sort_uniq : ?cmp:'a ord -> 'a t -> 'a t
val sort_uniq : cmp:'a ord -> 'a t -> 'a t
(** Eager sort that removes duplicate values. Requires the iterator to be
finite. O(n ln(n)) time and space.
finite. [O(n ln(n))] time and space.
@since 0.3.3 *)
val memoize : 'a t -> 'a t
(** Avoid recomputations by caching intermediate results
(** Avoid recomputations by caching intermediate results.
@since 0.14 *)
(** {2 Fair Combinations} *)
@ -189,7 +189,7 @@ val fair_flat_map : ('a -> 'b t) -> 'a t -> 'b t
@since 0.13 *)
val fair_app : ('a -> 'b) t -> 'a t -> 'b t
(** Fair version of {!(<*>)}
(** Fair version of {!(<*>)}.
@since 0.13 *)
(** {2 Implementations}
@ -202,11 +202,11 @@ val (>|=) : 'a t -> ('a -> 'b) -> 'b t
val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
val (>>-) : 'a t -> ('a -> 'b t) -> 'b t
(** Infix version of {! fair_flat_map}
(** Infix version of {! fair_flat_map}.
@since 0.13 *)
val (<.>) : ('a -> 'b) t -> 'a t -> 'b t
(** Infix version of {!fair_app}
(** Infix version of {!fair_app}.
@since 0.13 *)
(** {2 Infix operators}
@ -246,7 +246,7 @@ val to_list : 'a t -> 'a list
(** Gather all values into a list *)
val of_array : 'a array -> 'a t
(** Iterate on the array
(** Iterate on the array.
@since 0.13 *)
val to_array : 'a t -> 'a array
@ -254,18 +254,18 @@ val to_array : 'a t -> 'a array
@since 0.13 *)
val to_rev_list : 'a t -> 'a list
(** Convert to a list, in reverse order. More efficient than {!to_list} *)
(** Convert to a list, in reverse order. More efficient than {!to_list}. *)
val to_seq : 'a t -> 'a sequence
val to_gen : 'a t -> 'a gen
val of_gen : 'a gen -> 'a t
(** [of_gen g] consumes the generator and caches intermediate results
(** [of_gen g] consumes the generator and caches intermediate results.
@since 0.13 *)
(** {2 IO} *)
val pp : ?sep:string -> 'a printer -> 'a t printer
(** Print the list with the given separator (default ",").
Does not print opening/closing delimiters *)
Does not print opening/closing delimiters. *)

43
src/iter/CCKTree.ml
View file

@ -1,27 +1,4 @@
(*
copyright (c) 2013-2014, simon cruanes
all rights reserved.
redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Lazy Tree Structure}
This structure can be used to represent trees and directed
@ -91,7 +68,7 @@ class type ['a] pset = object
method mem : 'a -> bool
end
let set_of_cmp (type elt) ?(cmp=Pervasives.compare) () =
let set_of_cmp (type elt) ~cmp () =
let module S = Set.Make(struct
type t = elt
let compare = cmp
@ -105,7 +82,7 @@ let set_of_cmp (type elt) ?(cmp=Pervasives.compare) () =
let _nil () = `Nil
let _cons x l = `Cons (x, l)
let dfs ?(pset=set_of_cmp ()) t =
let dfs ~pset t =
let rec dfs pset stack () = match stack with
| [] -> `Nil
| `Explore t :: stack' ->
@ -141,19 +118,23 @@ module FQ = struct
let empty = _make [] []
let is_empty q = q.hd = []
let list_is_empty = function
| [] -> true
| _::_ -> false
let is_empty q = list_is_empty q.hd
let push q x = _make q.hd (x::q.tl)
let pop_exn q =
match q.hd with
| [] -> assert (q.tl = []); raise Empty
| [] -> assert (list_is_empty q.tl); raise Empty
| x::hd' ->
let q' = _make hd' q.tl in
x, q'
end
let bfs ?(pset=set_of_cmp ()) t =
let bfs ~pset t =
let rec bfs pset q () =
if FQ.is_empty q then `Nil
else
@ -173,7 +154,7 @@ let rec force t : ([`Nil | `Node of 'a * 'b list] as 'b) = match t() with
| `Nil -> `Nil
| `Node (x, l) -> `Node (x, List.map force l)
let find ?pset f t =
let find ~pset f t =
let rec _find_kl f l = match l() with
| `Nil -> None
| `Cons (x, l') ->
@ -181,7 +162,7 @@ let find ?pset f t =
| None -> _find_kl f l'
| Some _ as res -> res
in
_find_kl f (bfs ?pset t)
_find_kl f (bfs ~pset t)
(** {2 Pretty-printing} *)

63
src/iter/CCKTree.mli
View file

@ -1,27 +1,4 @@
(*
copyright (c) 2013-2014, simon cruanes
all rights reserved.
redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Lazy Tree Structure}
This structure can be used to represent trees and directed
@ -42,16 +19,16 @@ val empty : 'a t
val is_empty : _ t -> bool
val singleton : 'a -> 'a t
(** Tree with only one label *)
(** Tree with only one label. *)
val node : 'a -> 'a t list -> 'a t
(** Build a node from a label and a list of children *)
(** Build a node from a label and a list of children. *)
val node1 : 'a -> 'a t -> 'a t
(** Node with one child *)
(** Node with one child. *)
val node2 : 'a -> 'a t -> 'a t -> 'a t
(** Node with two children *)
(** Node with two children. *)
val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
(** Fold on values in no specified order. May not terminate if the
@ -60,10 +37,10 @@ val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
val iter : ('a -> unit) -> 'a t -> unit
val size : _ t -> int
(** Number of elements *)
(** Number of elements. *)
val height : _ t -> int
(** Length of the longest path to empty leaves *)
(** Length of the longest path to empty leaves. *)
val map : ('a -> 'b) -> 'a t -> 'b t
@ -80,22 +57,22 @@ class type ['a] pset = object
method mem : 'a -> bool
end
val set_of_cmp : ?cmp:('a -> 'a -> int) -> unit -> 'a pset
(** Build a set structure given a total ordering *)
val set_of_cmp : cmp:('a -> 'a -> int) -> unit -> 'a pset
(** Build a set structure given a total ordering. *)
val dfs : ?pset:'a pset -> 'a t -> [ `Enter of 'a | `Exit of 'a ] klist
(** Depth-first traversal of the tree *)
val dfs : pset:'a pset -> 'a t -> [ `Enter of 'a | `Exit of 'a ] klist
(** Depth-first traversal of the tree. *)
val bfs : ?pset:'a pset -> 'a t -> 'a klist
(** Breadth-first traversal of the tree *)
val bfs : pset:'a pset -> 'a t -> 'a klist
(** Breadth-first traversal of the tree. *)
val force : 'a t -> ([ `Nil | `Node of 'a * 'b list ] as 'b)
(** [force t] evaluates [t] completely and returns a regular tree
structure
structure.
@since 0.13 *)
val find : ?pset:'a pset -> ('a -> 'b option) -> 'a t -> 'b option
(** Look for an element that maps to [Some _] *)
val find : pset:'a pset -> ('a -> 'b option) -> 'a t -> 'b option
(** Look for an element that maps to [Some _]. *)
(** {2 Pretty-printing}
@ -137,13 +114,13 @@ module Dot : sig
] (** Dot attributes for nodes *)
type graph = (string * attribute list t list)
(** A dot graph is a name, plus a list of trees labelled with attributes *)
(** A dot graph is a name, plus a list of trees labelled with attributes. *)
val mk_id : ('a, Buffer.t, unit, attribute) format4 -> 'a
(** Using a formatter string, build an ID *)
(** Using a formatter string, build an ID. *)
val mk_label : ('a, Buffer.t, unit, attribute) format4 -> 'a
(** Using a formatter string, build a label *)
(** Using a formatter string, build a label. *)
val make : name:string -> attribute list t list -> graph
@ -163,6 +140,6 @@ module Dot : sig
val to_file : ?name:string -> string -> attribute list t list -> unit
(** [to_file filename trees] makes a graph out of the trees, opens the
file [filename] and prints the graph into the file.
@param name name of the graph
@param name name of the graph.
@since 0.6.1 *)
end

16
src/iter/CCLazy_list.mli
View file

@ -11,25 +11,25 @@ and +'a node =
| Cons of 'a * 'a t
val empty : 'a t
(** Empty list *)
(** Empty list. *)
val return : 'a -> 'a t
(** Return a computed value *)
(** Return a computed value. *)
val is_empty : _ t -> bool
(** Evaluates the head *)
(** Evaluates the head. *)
val length : _ t -> int
(** [length l] returns the number of elements in [l], eagerly (linear time).
Caution, will not terminate if [l] is infinite *)
Caution, will not terminate if [l] is infinite. *)
val cons : 'a -> 'a t -> 'a t
val head : 'a t -> ('a * 'a t) option
(** Evaluate head, return it, or [None] if the list is empty *)
(** Evaluate head, return it, or [None] if the list is empty. *)
val map : f:('a -> 'b) -> 'a t -> 'b t
(** Lazy map *)
(** Lazy map. *)
val filter : f:('a -> bool) -> 'a t -> 'a t
(** Filter values.
@ -40,10 +40,10 @@ val take : int -> 'a t -> 'a t
@since 0.18 *)
val append : 'a t -> 'a t -> 'a t
(** Lazy concatenation *)
(** Lazy concatenation. *)
val flat_map : f:('a -> 'b t) -> 'a t -> 'b t
(** Monadic flatten + map *)
(** Monadic flatten + map. *)
module Infix : sig
val (>|=) : 'a t -> ('a -> 'b) -> 'b t

9
src/iter/jbuild Normal file
View file

@ -0,0 +1,9 @@
(library
((name containers_iter)
(public_name containers.iter)
(wrapped false)
(flags (:standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string))
(ocamlopt_flags (:standard (:include ../flambda.flags)))
(libraries (bytes result))
))

10
src/jbuild Normal file
View file

@ -0,0 +1,10 @@
(rule
((targets (flambda.flags))
(deps ((file mkflags.ml)))
(fallback)
(action
(run ocaml ./mkflags.ml))
))

Some files were not shown because too many files have changed in this diff Show more