diff --git a/.gitignore b/.gitignore index bc27b88b6..230f587a9 100644 --- a/.gitignore +++ b/.gitignore @@ -21,7 +21,6 @@ bench.log qtest/all_tests.ml qtest2/all_tests.ml qtest.targets.log -coverage setup.data setup.log src/batUnix.mli @@ -35,3 +34,4 @@ src/batPrintf.mli src/batFormat.mli src/batSys.mli src/batBigarray.mli +src/batFilename.mli diff --git a/.travis.sh b/.travis.sh index 1dab52469..210f9877c 100644 --- a/.travis.sh +++ b/.travis.sh @@ -1,27 +1,22 @@ OPAM_DEPENDS="ocamlfind ounit qtest" -case "$OCAML_VERSION,$OPAM_VERSION" in -3.12.1,1.0.0) ppa=avsm/ocaml312+opam10 ;; -3.12.1,1.1.0) ppa=avsm/ocaml312+opam11 ;; -4.00.1,1.0.0) ppa=avsm/ocaml40+opam10 ;; -4.00.1,1.1.0) ppa=avsm/ocaml40+opam11 ;; -4.01.0,1.0.0) ppa=avsm/ocaml41+opam10 ;; -4.01.0,1.1.0) ppa=avsm/ocaml41+opam11 ;; +case "$OCAML_VERSION" in +3.12.1.1.0) ppa=avsm/ocaml312+opam11 ;; +4.00.1.0.0) ppa=avsm/ocaml40+opam10 ;; +4.00.1.1.0) ppa=avsm/ocaml40+opam11 ;; +4.01.0.0.0) ppa=avsm/ocaml41+opam10 ;; +4.01.0.1.0) ppa=avsm/ppa ;; +4.0[234567].*) ppa= *) echo Unknown $OCAML_VERSION,$OPAM_VERSION; exit 1 ;; esac echo "yes" | sudo add-apt-repository ppa:$ppa sudo apt-get update -qq -sudo apt-get install -qq ocaml ocaml-native-compilers camlp4-extra opam +sudo apt-get install -qq opam export OPAMYES=1 export OPAMVERBOSE=1 -echo OCaml version -ocaml -version -echo OPAM versions -opam --version -opam --git-version -opam init +opam init --compiler=$OCAML_VERSION eval `opam config env` echo "==== Installing $OPAM_DEPENDS ====" @@ -30,8 +25,9 @@ opam install ${OPAM_DEPENDS} echo "==== Build ====" make -echo "==== Tests ====" +echo "==== Internal tests ====" make test-native -#echo "==== Doc ====" -#make doc +echo "==== Install and use test ====" +opam pin add -n -k path batteries . +make test-build-from-install diff --git a/.travis.yml b/.travis.yml index caed85f45..4b1c8cb77 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,14 +1,18 @@ language: c script: bash -ex .travis.sh env: - - OCAML_VERSION=3.12.1 OPAM_VERSION=1.1.0 - - OCAML_VERSION=4.00.1 OPAM_VERSION=1.1.0 - - OCAML_VERSION=4.01.0 OPAM_VERSION=1.1.0 - # - OCAML_VERSION=3.12.1 OPAM_VERSION=1.0.0 - # - OCAML_VERSION=4.00.1 OPAM_VERSION=1.0.0 - # - OCAML_VERSION=4.01.0 OPAM_VERSION=1.0.0 + - OCAML_VERSION=3.12.1 + - OCAML_VERSION=4.00.1 + - OCAML_VERSION=4.01.0 + - OCAML_VERSION=4.02.3 + - OCAML_VERSION=4.03.0 + - OCAML_VERSION=4.04.2 + - OCAML_VERSION=4.05.0 + - OCAML_VERSION=4.06.0 + - OCAML_VERSION=4.07.0 + - OCAML_VERSION=4.08.0 # notifications: # email: # - simon.cruanes.2007+travis@m4x.org -# - add other adresses here (or batteries-devel or something?) +# - add other addresses here (or batteries-devel or something?) diff --git a/ChangeLog b/ChangeLog index a7379db51..565ee05af 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,29 @@ Changelog ## NEXT_RELEASE (major release) +- BatList and BatArray: sum of an empty container now return 0 rather than + raising an exception. + #519 + (Cedric Cellier, report by Simon Cruanes, review by François Berenger) +- BatString: split_on_char and nsplit now return a sigle empty string (rather + than an empty list) on empty strings. + #845, #846 + (Cedric Cellier, report by Thibault Suzanne, review by François Berenger) +- BatSeq: change Exceptionless.combine signature to make it really + exceptionless. + #418 + (Cedric Cellier, report by Hezekiah M. Carty, review by François Berenger) +- BatOo: This module was unwelcomed and has been removed + #848 + (Cedric Cellier, report by Max Mouratov, review by François Berenger) +- BatFilename: Added to Batteries from the stdlib, with the addition of + split_extension. + #445 + (Cedric Cellier, report and review by François Berenger) +- BatSet: the Infix module is no more, as it was incompatible with + metaocaml + #908 + (Cedric Cellier, review by Gabriel Scherer and François Berenger) - BatIO: make the ?cleanup parameter of BatIO.input_channel true by default: closing the returned input will close the underlying input channel #109, #489 @@ -24,7 +47,250 @@ Changelog #679 (Cedric Cellier) -## NEXT_RELEASE (minor release) +## v2.10.0 (minor release) + +This minor release adds support for OCaml 4.08.0. + +This release is compatible with OCaml 4.08.0, but it is not complete +with respect to the standard library of OCaml 4.08.0: this release saw +a lot of changes to the standard library, which have not yet been made +available in the corresponding Batteries module. This means that users +of OCaml 4.08.0 (and Batteries 2.10.0) will have access to these +functions, but users of older OCaml versions (and Batteries 2.10.0) +will not. If you are looking for this kind of backward-compatibility +of new functions, as provided by previous Batteries releases, we +recommend trying the 'stdcompat' library. + +- added LazyList.equal: ('a -> 'b -> bool) -> 'a t -> 'b t -> bool + #811 + (Marshall Abrams, review by Gabriel Scherer) + +- added BatList.fold_while : ('acc -> 'a -> bool) -> ('acc -> 'a -> 'acc) -> + 'acc -> 'a list -> 'acc * 'a list + #889 + (Francois Berenger, Thibault Suzanne) + +- fix `BatNum.of_float_string` on inputs between -1 and 0: + "-0.5" or "-.5" would be interpreted as "0.5" or ".5". + #886, #887 + (Gabriel Scherer, report by Marcel Hark) + +- added BatHashtbl.merge and merge_all + #891 + (Cedric Cellier, Francois Berenger, Gabriel Scherer) + +## v2.9.0 (minor release) + +This minor release adds support for OCaml 4.07.0, as well as a certain +number of fixes, improvements and documentation clarification from our +contributors. Thanks in particular to Max Mouratov for his varied +contributions. + +This release is compatible with OCaml 4.07.0, but it is not complete +with respect to the standard library of OCaml 4.07.0: this release saw +a lot of changes to the standard library, which have not yet been made +available in the corresponding Batteries module. This means that users +of OCaml 4.07.0 (and Batteries 2.9.0) will have access to these +functions, but users of older OCaml versions (and Batteries 2.9.0) +will not. If you are looking for this kind of backward-compatibility +of new functions, as provided by previous Batteries releases, we +recommend trying the new 'stdcompat' library by Thierry Martinez: + + https://github.com/thierry-martinez/stdcompat + +Full changelog: + +- add `BatString.cut_on_char : char -> int -> string -> string` + (Kahina Fekir, Thibault Suzanne, request by François Bérenger) + #807, #856 + +- add `BatString.index_after_n : char -> int -> string -> int` + (Kahina Fekir) + +- faster BatArray.partition + #829 + (Francois Berenger, Gabriel Scherer) + +- add `BatArray.split: ('a * 'b) array -> 'a array * 'b array` + #826 + (Francois Berenger) + +- add `BatString.count_string: string -> string -> int` + #799 + (Francois Berenger) + +- Int: optimized implementation of Safe_int.mul + #808, #851 + (Max Mouratov) + +- Fix: in case of conflicted bindings, [Map.union m1 m2] should + prefer the value from [m2], as stated in documentation. + #814 + (Max Mouratov) + +- Fix: [Map.update k1 k2 v m] did not work correctly when [k1 = k2]. + #833 + (Max Mouratov) + +- Fix: [Map.update k1 k2 v m] should throw [Not_found] if [k1] is not bound + in [m], as stated in documentation. + #833 + (Max Mouratov) + +- Fix: [Set.update x y s] should throw [Not_found] if [x] is not in [s], + as stated in documentation. + #833 + (Max Mouratov) + +- Fix: documentation of BatList.{hd,last} to match implementation w.r.t + raised exceptions + #840, #754 + (FkHina) + +- Fix: [Array.insert] should throw a more relevant message on invalid indices + instead of the generic [invalid_arg "index out of bounds]. + The assertion is now documented. + #841 + (Max Mouratov) + +- Implementation of [Array.insert] now uses [unsafe_get] and [unsafe_set]. + #841 + (Max Mouratov) + +- Fix documentation of [String.right]. + #849, #844 + (Max Mouratov, reported by Thibault Suzanne) + +- Fix: [Heap.del_min] should throw [Invalid_argument] with the specified + "del_min" message instead of "find_min_tree". + #850 + (Max Mouratov) + +- More uniform and correct [Invalid_argument] messages. + #850 + (Max Mouratov) + +- Optimization of List.unique_cmp (using Set instead of Map). + #852 + (Max Mouratov) + +- Documentation of List.append and List.concat should not include invalid + estimates of stack usage. + #854 + (Max Mouratov) + +- Implementation of String should use unsafe versions of [set] and [get]. + #836 + (Max Mouratov, review by Gabriel Scherer) + +- Fix erroneous mentions of [Different_list_size] in List.mli. + #857, #744 + (Max Mouratov, reported by Christoph Höger) + +- fix Map.equal (for polymorphic maps) with custom equality function + #865 + (Ralf Vogler) + +- ocamlfind plugin support in META file + (Arlen Cox) + #867 + +## v2.8.0 (minor release) + +This minor release supports the -safe-string mode for OCaml +compilation, enforcing a type-level separation between (immutable) +strings and mutable byte sequences. + +- support -safe-string compilation + #673 + (Gabriel Scherer) + +- Support for the upcoming OCaml release 4.06 + (Gabriel Scherer) + +## v2.7.0 (minor release) + +This minor release is the first to support OCaml 4.05.0. As with +previous OCaml versions, we backported new 4.05.0 convenience function +from the compiler stdlib, allowing Batteries user to use them with +older OCaml versions, and thus write backward-compatible code. In +particular, the new *_opt functions returning option values instead of +exceptions are all backported. + +- BatNum: fix of_float_string to handle negative numbers properly + #780 + (Anton Yabchinskiy) + +- added BatArray.min_max + #757 + (Francois Berenger) + +- added a Label module to BatVect + #763 + (Varun Gandhi, review by Francois Berenger, Gabriel Scherer, Thibault Suzanne) + +- fix documentation of BatVect.insert to match (correct) implementation + #766, #767 + (Gabriel Scherer, report by Varun Gandhi) + +- avoid using exceptions for internal control-flow + #768, #769 + This purely internal change should improve performances when using + js_of_ocaml, which generates much slower code for local exceptions + raising/catching than the native OCaml backend. + Internal exceptions (trough the BatReturn label) have been removed + from the modules BatString, BatSubstring and BatVect. + (Gabriel Scherer, request and review by Clément Pit-Claudel) + +- added `BatVect.find_opt : ('a -> bool) -> 'a t -> 'a option` + and BatVect.Make.find_opt + #769 + (Gabriel Scherer) + +- Documents exceptions for List.(min, max) + #770 + (Varun Gandhi) + +- BatText: bugfixes in `rindex{,_from}` and `rcontains_from` + #775 + (Gabriel Scherer) + +- Support for the new OCaml release 4.05 + the `*_opt` functions and List.compare_lengths, compare_length_with + are also backported to older OCaml releases, so code using them from + Batteries should be backwards-compatible + #777, #779 + (Tej Chajed, Gabriel Scherer) + +## v2.6.0 (minor release) + +- added Bat{Set,Map,Splay}.any and fixed Bat{Map,Splay}.choose + #751 + (Cedric Cellier) + +- added BatList.favg and faster BatList.fsum + #746 + (Gabriel Scherer, Francois Berenger) + +- install .cmt and .cmti files + #740 + (Francois Berenger, Gabriel Scherer) + +- BatMap: added find_default + #730 + (Francois Berenger) + +- added scripts/test_install.sh + #743 + (Francois Berenger) + +- BatHashtbl: added {to|of}_list, bindings + #728 + (Francois Berenger, Thibault Suzanne) + +- added {BatList|BatArray}.shuffle + #702, #707 + (Francois Berenger, Gabriel Scherer) - Clarification and improvements to the documentation #682, #685, #693 @@ -45,6 +311,29 @@ Changelog #705 (Ifaz Kabir) +- Add {BatSet,BatMap}.{Int,Int32,Int64,Nativeint,Float,Char,String} as + common instantions of the respective `Make` functor. + #709, #712 + (Thibault Suzanne, François Bérenger) + +- BatString: add `chop : ?l:int -> ?r:int -> string -> string` + #714, #716 + (Gabriel Scherer, request by François Bérenger) + +- BatSet: make `to_array` allocate the resulting array at first + instead of using Dynarray (faster, uses less memory). + #724 + (Thibault Suzanne) + +- BatList: add `fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list` + #734 + (Thibault Suzanne, review by Gabriel Scherer, request by Oscar Gauthier) + +- add ``BatList.frange : float -> [< `To | `Downto ] -> float -> int -> float list`` + ``frange 0. `To 1. 3`` is `[0.; 0.5; 1.]`. + #745 + (François Bérenger) + ## v2.5.3 Batteries 2.5.3 synchronizes library functions with OCaml 4.04+beta2, @@ -128,8 +417,8 @@ then it is only available under OCaml 4.03.0. - BatHashtbl: more efficient modify_opt and modify_def (Anders Fugmann) - BatFormat: add pp_print_list: ?pp_sep:(formatter -> unit -> unit) -> - (formatter -> 'a -> unit) -> - (formatter -> 'a list -> unit) + (formatter -> 'a -> unit) -> + (formatter -> 'a list -> unit) and pp_print_text: formatter -> string -> unit (Christoph Höger) - BatEnum: add uniq_by: ('a -> 'a -> bool) -> 'a t -> 'a t @@ -225,7 +514,7 @@ then it is only available under OCaml 4.03.0. - basic .merlin file for merlin users - BatDeque.eq function to compare Deques by content - BatteriesExceptionless -- More explicit overridding of ocamlbuild rules, use batteries.mllib +- More explicit overriding of ocamlbuild rules, use batteries.mllib - Add Kahan summation (numerically-accurate sum of floats) to List,Array,Enum - Add BatOption.some - (text) improve element indexing in BatList's mli documentation diff --git a/META.in b/META.in index a486362a6..bd2d0daea 100644 --- a/META.in +++ b/META.in @@ -9,3 +9,7 @@ archive(byte) ="batteries.cma" archive(byte,mt) +="batteriesThread.cma" archive(native) ="batteries.cmxa" archive(native,mt) +="batteriesThread.cmxa" +plugin(byte) ="batteries.cma" +plugin(byte,mt) +="batteriesThread.cma" +plugin(native) ="batteries.cmxs" +plugin(native,mt) +="batteriesThread.cmxs" diff --git a/Makefile b/Makefile index acea4b348..b19f3516b 100644 --- a/Makefile +++ b/Makefile @@ -37,9 +37,24 @@ INSTALL_FILES = _build/META _build/src/*.cma \ battop.ml _build/src/*.cmi _build/src/*.mli \ _build/src/batteriesHelp.cmo _build/src/batteriesConfig.cmo _build/src/batteriesPrint.cmo \ ocamlinit build/ocaml +# the bin_annot flag in _tags is not handled by versions of ocamlbuild < 4.01.0 +# hence we only install *.cmt{i} files if they were produced +ifneq ($(wildcard _build/src/*.cmt),) + INSTALL_FILES += _build/src/*.cmt +endif +ifneq ($(wildcard _build/src/*.cmti),) + INSTALL_FILES += _build/src/*.cmti +endif + OPT_INSTALL_FILES = _build/src/*.cmx _build/src/*.a _build/src/*.cmxa \ _build/src/*.cmxs _build/src/*.lib +ifneq ($(QTEST_SEED),) + QTEST_SEED_FLAG = --seed $(QTEST_SEED) +else + QTEST_SEED_FLAG = +endif + # What to build TARGETS = src/batteries.cma TARGETS += src/batteriesHelp.cmo @@ -71,7 +86,7 @@ else endif endif -.PHONY: all clean doc install uninstall reinstall test qtest qtest-clean camfail camfailunk coverage man +.PHONY: all clean doc install uninstall reinstall test qtest qtest-clean camfail camfailunk man test_install all: @echo "Build mode:" $(MODE) @@ -98,6 +113,9 @@ install: all uninstall_packages ocamlfind install $(NAME) $(INSTALL_FILES) \ -optional $(OPT_INSTALL_FILES) +test_install: + ./scripts/test_install.sh + uninstall_packages: ocamlfind remove $(NAME) @@ -139,11 +157,26 @@ clean-prefilter: ### List of source files that it's okay to try to test +# TESTABLE contains the source files as the user sees them, +# as a mix of .ml and .mlv files in the src/ directory + +# TESTDEPS represents the file whose changes Makefile should watch to +# decide to reprocess the test results. It is identical to TESTABLE. + +# TESTFILES contains the OCaml source files as `qtest` wants to see +# them, that is after preprocessing. We ask ocamlbuild to build the +# $(TESTFILES) from $(TESTABLE), and pass them to qtest from the +# `_build` directory. + DONTTEST=src/batteriesHelp.ml \ + src/batteries_compattest.ml \ src/batConcreteQueue_402.ml src/batConcreteQueue_403.ml -TESTABLE ?= $(filter-out $(DONTTEST), $(wildcard src/*.ml)) +TESTABLE ?= $(filter-out $(DONTTEST),\ + $(wildcard src/*.ml) $(wildcard src/*.mlv)) TESTDEPS = $(TESTABLE) +TESTFILES = $(TESTABLE:.mlv=.ml) + ### Test suite: "offline" unit tests ############################################## @@ -158,7 +191,10 @@ _build/testsuite/main.native: $(TESTDEPS) $(wildcard testsuite/*.ml) # extract all qtest unit tests into a single ml file $(QTESTDIR)/all_tests.ml: $(TESTABLE) - qtest -o $@ --shuffle --preamble-file qtest/qtest_preamble.ml extract $(TESTABLE) + $(OCAMLBUILD) $(OCAMLBUILDFLAGS) $(TESTFILES) + (cd _build; qtest -o ../$@ --shuffle \ + --preamble-file ../qtest/qtest_preamble.ml \ + extract $(TESTFILES)) _build/$(QTESTDIR)/all_tests.byte: $(QTESTDIR)/all_tests.ml $(OCAMLBUILD) $(OCAMLBUILDFLAGS) -cflags -warn-error,+26\ @@ -178,21 +214,22 @@ qtest-byte-clean: @${MAKE} _build/$(QTESTDIR)/all_tests.byte qtest-byte: qtest-byte-clean - @_build/$(QTESTDIR)/all_tests.byte + @_build/$(QTESTDIR)/all_tests.byte $(QTEST_SEED_FLAG) qtest-native-clean: @${RM} $(QTESTDIR)/all_tests.ml - @${MAKE} _build/$(QTESTDIR)/all_tests.native + @${MAKE} _build/$(QTESTDIR)/all_tests.native $(QTEST_SEED_FLAG) qtest-native: prefilter qtest-native-clean - @_build/$(QTESTDIR)/all_tests.native + @_build/$(QTESTDIR)/all_tests.native $(QTEST_SEED_FLAG) qtest-clean: @${RM} $(QTESTDIR)/all_tests.ml @${MAKE} _build/$(QTESTDIR)/all_tests.$(EXT) qtest: qtest-clean - @_build/$(QTESTDIR)/all_tests.$(EXT) + @_build/$(QTESTDIR)/all_tests.$(EXT) $(QTEST_SEED_FLAG) + ### run all unit tests ############################################## @@ -240,7 +277,7 @@ release: $(MAKE) release-cleaned # assumes irreproachably pristine working directory -release-cleaned: setup.ml doc test +release-cleaned: setup.ml doc test-native git archive --format=tar --prefix=batteries-$(VERSION)/ HEAD \ | gzip > batteries-$(VERSION).tar.gz @@ -251,13 +288,14 @@ setup.ml: _oasis # uploads the current documentation to github hdoc2/ directory upload-docs: - make doc && git checkout gh-pages && rm -f hdoc2/*.html && cp _build/batteries.docdir/*.html hdoc2/ && git add hdoc2/*.html && git commit -a -m"Update to latest documentation" && git push origin gh-pages && git checkout master - -############################################################################### -# CODE COVERAGE REPORTS -############################################################################### - -coverage/index.html: $(TESTDEPS) $(QTESTDIR)/all_tests.ml - $(OCAMLBUILD) $(OCAMLBUILDFLAGS) coverage/index.html - -coverage: coverage/index.html + make doc && \ + rm -rf /tmp/batteries.docdir && \ + cp -a _build/batteries.docdir /tmp/ && \ + git checkout gh-pages && \ + rm -f hdoc2/*.html && \ + cp /tmp/batteries.docdir/*.html hdoc2/ && \ + git add hdoc2/*.html && \ + git commit hdoc2 -m "Update ocamldoc to latest release" && \ + git push \ + git@github.com:ocaml-batteries-team/batteries-included.git gh-pages \ + git checkout master diff --git a/README.md b/README.md index c40bf35df..f01cd556d 100644 --- a/README.md +++ b/README.md @@ -24,25 +24,24 @@ You will need the following libraries: * [OCaml][] >= 3.12.1 * [Findlib][] >= 1.5.3 -* [qtest][] >= 2.0.1 * GNU make * [OUnit][] to build and run the tests (optional) +* [qtest][] >= 2.0.1 to build and run the tests (optional) * [ocaml-benchmark][] to build and run the performance tests (optional) -* [bisect][] to compute the coverage of the test suite (optional) [Findlib]: http://projects.camlcity.org/projects/findlib.html/ [OCaml]: http://caml.inria.fr/ocaml/release.en.html +[qtest]: http://batteries.vhugot.com/qtest/ [Camomile]: http://camomile.sourceforge.net/ [OUnit]: http://ounit.forge.ocamlcore.org/ [ocaml-benchmark]: http://ocaml-benchmark.forge.ocamlcore.org/ -[bisect]: http://bisect.x9c.fr/ ### Configuration and Installation To install the full version of Batteries, execute $ make all - $ make test test [ optional ] + $ make test [ optional ] $ sudo make install $ make doc [ optional ] @@ -82,7 +81,7 @@ ExtLib Compatibility -------------------- If your project currently uses [ExtLib][], most likely you can just change -`-package extlib` to `-package batteries` and add `open Extlibcompat` +`-package extlib` to `-package batteries` and add `open Extlib` to the top of any extlib-using modules. Batteries' modules are all named BatFoo to differentiate them from extlib's modules, so one can use Batteries and ExtLib in the same project. @@ -96,9 +95,9 @@ have a corresponding module in batteries at the moment. Extending Batteries ------------------- -See doc/batteries/GUIDELINES and the [guidelines wiki page][batwiki-dev]. +See the [guidelines wiki page][batwiki-dev]. [batwiki-dev]: https://github.com/ocaml-batteries-team/batteries-included/wiki/Developers-guidelines -If you use emacs, the file `batteries_dev.el` has extra highlighting to support writing quicktests. +If you use emacs, the file [`batteries_dev.el`](/batteries_dev.el) has extra highlighting to support writing quicktests. diff --git a/_oasis b/_oasis index 613f8f23a..70aa351b0 100644 --- a/_oasis +++ b/_oasis @@ -1,7 +1,7 @@ OASISFormat: 0.4 OCamlVersion: >= 3.12.1 Name: batteries -Version: 2.5.3 +Version: NEXT_RELEASE Authors: Batteries Included Team License: LGPL-2.1 with OCaml linking exception LicenseFile: LICENSE @@ -31,4 +31,3 @@ SourceRepository master Library "batteries" Path: src/ - diff --git a/_tags b/_tags index fbc6e9f73..c74904414 100644 --- a/_tags +++ b/_tags @@ -1,6 +1,6 @@ <**/*.ml> : annot <**/*.ml> and not : warn_-29 -true: package(bytes), warn_-3 +true: package(bytes), warn_-3, bin_annot "build": include "src": include "libs": include @@ -10,3 +10,6 @@ true: package(bytes), warn_-3 ".git": -traverse "examples": -traverse : opaque +true: safe_string +true: no_alias_deps + diff --git a/battop.ml b/battop.ml index 2d2764b03..397f55832 100644 --- a/battop.ml +++ b/battop.ml @@ -1,5 +1,5 @@ (* - * Top - An interpreted preambule for the toplevel + * Top - An interpreted preamble for the toplevel * Copyright (C) 2009 David Rajchenbach-Teller, LIFO, Universite d'Orleans * * This library is free software; you can redistribute it and/or @@ -63,13 +63,19 @@ open Batteries;; #install_printer BatteriesPrint.print_uchar;; #install_printer BatteriesPrint.print_ustring;; #install_printer BatteriesPrint.print_rope;; +(* #install_printer BatteriesPrint.print_string_cap_rw;; #install_printer BatteriesPrint.print_string_cap_ro;; + *) #install_printer BatteriesPrint.string_dynarray;; #install_printer BatteriesPrint.int_dynarray;; #install_printer BatteriesPrint.char_dynarray;; #install_printer BatteriesPrint.float_dynarray;; #install_printer BatteriesPrint.int_set;; +#install_printer BatteriesPrint.int32_set;; +#install_printer BatteriesPrint.int64_set;; +#install_printer BatteriesPrint.natint_set;; +#install_printer BatteriesPrint.float_set;; #install_printer BatteriesPrint.string_set;; #install_printer BatteriesPrint.int_pset;; #install_printer BatteriesPrint.string_pset;; diff --git a/benchsuite/bench_nreplace.ml b/benchsuite/bench_nreplace.ml index f4b56c0d0..d98259fde 100644 --- a/benchsuite/bench_nreplace.ml +++ b/benchsuite/bench_nreplace.ml @@ -117,7 +117,7 @@ let nreplace_thelema2 ~str ~sub ~by = loop_copy 0 0 idxes ; newstr -(* Independantly, MadRoach implemented the same idea with less luck aparently *) +(* Independently, MadRoach implemented the same idea with less luck apparently *) let nreplace_madroach ~str ~sub ~by = let strlen = String.length str and sublen = String.length sub @@ -132,7 +132,7 @@ let nreplace_madroach ~str ~sub ~by = BatEnum.from (fun () -> let i = find !nexti in nexti := i+1; i) in (* collect all positions where we need to replace, - * skipping overlapping occurences *) + * skipping overlapping occurrences *) let todo = let skip_unto = ref 0 in find_simple sub str |> diff --git a/build/intro.text b/build/intro.text index 1dc4944ef..319edcfbb 100644 --- a/build/intro.text +++ b/build/intro.text @@ -21,6 +21,8 @@ the {{:https://github.com/ocaml-batteries-team/batteries-included/wiki/Getting-started}Getting started manual}. +Modules listed below can also be referenced as [Batteries.]--where [] is the module name without the initial "Bat"--or as [] alone, if [Batteries] has been [open]ed. For example, [BatLazyList] can also be used as [Batteries.LazyList], or as [LazyList] after executing [open Batteries]. + Do you have suggestions? Remarks? Bug reports ? To contact us or to be kept informed, don't hesitate to visit our {{:http://batteries.forge.ocamlcore.org/}website}, @@ -53,7 +55,7 @@ These modules have base library equivalents. When using [open Batteries], [BatF {!modules: BatArray BatBigarray BatBig_int BatBuffer BatComplex BatDigest BatFormat BatGc BatGenlex BatHashtbl BatLexing BatList -BatMap BatMarshal BatNum BatOo BatPervasives BatPrintexc BatPrintf +BatMap BatMarshal BatNum BatPervasives BatPrintexc BatPrintf BatQueue BatRandom BatScanf BatSet BatStack BatStream BatString BatSys BatUnix} diff --git a/build/make-our-inline-tests-compatible-with-older-OCaml-versions.patch b/build/make-our-inline-tests-compatible-with-older-OCaml-versions.patch new file mode 100644 index 000000000..c80c682b2 --- /dev/null +++ b/build/make-our-inline-tests-compatible-with-older-OCaml-versions.patch @@ -0,0 +1,128 @@ +From c09d02f65d20c183149698cad56c1d9715b4267a Mon Sep 17 00:00:00 2001 +From: Gabriel Scherer +Date: Sun, 29 Oct 2017 18:06:05 +0100 +Subject: [PATCH] make our inline tests compatible with older OCaml versions + +Newer qtest versions introduced API changes that makes our code +incompatible with older qtest versions, and they are also incompatible +with some OCaml versions that Batteries support. The present patch +removes all advanced qtest modules from the Batteries inline test +(at the cost of slightly reducing the breadth of the coverage in +some case); applying it should make it possible to test Batteries +under 3.12.1 and 4.00.1 for example. + +Please consider rebasing this commit with new changes if the +old-qtest-incompatible features start being used in other places. +--- + src/batArray.mlv | 22 ++++++++++++---------- + src/batInnerShuffle.ml | 2 +- + src/batList.mlv | 5 +++-- + 3 files changed, 16 insertions(+), 13 deletions(-) + +diff --git a/src/batArray.mlv b/src/batArray.mlv +index 005c4df0..79ee6f94 100644 +--- a/src/batArray.mlv ++++ b/src/batArray.mlv +@@ -175,7 +175,7 @@ let findi p xs = + in + loop 0 + (*$Q findi +- (Q.pair (Q.array Q.small_int) (Q.fun1 Q.Observable.int Q.bool)) (fun (a, Q.Fun(_,f)) -> \ ++ (Q.array Q.small_int) (fun a -> let f n = (n mod 4 = 0) in \ + try let index = findi f a in \ + let i = ref (-1) in \ + for_all (fun elt -> incr i; \ +@@ -187,7 +187,7 @@ let findi p xs = + + let find p xs = xs.(findi p xs) + (*$Q find +- (Q.pair (Q.array Q.small_int) (Q.fun1 Q.Observable.int Q.bool)) (fun (a, Q.Fun(_,f)) -> \ ++ (Q.array Q.small_int) (fun a -> let f n = (n mod 4 = 0) in \ + let a = map (fun x -> `a x) a in \ + let f (`a x) = f x in\ + try let elt = find f a in \ +@@ -217,7 +217,7 @@ let filter p xs = + assert false + ) + (*$Q filter +- (Q.pair (Q.array Q.small_int) (Q.fun1 Q.Observable.int Q.bool)) (fun (a, Q.Fun(_,f)) -> \ ++ (Q.array Q.small_int) (fun a -> let f n = (n mod 4 = 0) in \ + let b = Array.to_list (filter f a) in \ + let b' = List.filter f (Array.to_list a) in \ + List.for_all (fun (x,y) -> x = y) (List.combine b b') \ +@@ -276,7 +276,7 @@ let partition p xs = + r) in + xs1, xs2 + (*$Q partition +- (Q.pair (Q.array Q.small_int) (Q.fun1 Q.Observable.int Q.bool)) (fun (a, Q.Fun(_,f)) -> \ ++ (Q.array Q.small_int) (fun a -> let f n = (n mod 4 = 0) in \ + let b1, b2 = partition f a in \ + let b1, b2 = Array.to_list b1, Array.to_list b2 in \ + let b1', b2' = List.partition f (Array.to_list a) in \ +@@ -370,8 +370,8 @@ let range xs = BatEnum.(--^) 0 (Array.length xs) + let filter_map p xs = + of_enum (BatEnum.filter_map p (enum xs)) + (*$Q filter_map +- (Q.pair (Q.array Q.small_int) (Q.fun1 Q.Observable.int (Q.option Q.int))) \ +- (fun (a, Q.Fun (_,f)) -> \ ++ (Q.array Q.small_int) (fun a -> \ ++ let f n = if (n mod 4 = 0) then Some n else None in \ + let a' = filter (fun elt -> f elt <> None) a in \ + let a' = map (f %> BatOption.get) a' in \ + let a = filter_map f a in \ +@@ -661,8 +661,9 @@ let decorate_stable_sort f xs = + = [|(0,2);(1,2);(1,3);(1,4)|] + *) + (*$Q decorate_stable_sort +- (Q.pair (Q.array Q.small_int) (Q.fun1 Q.Observable.int (Q.option Q.int))) \ +- (fun (a, Q.Fun(_,f)) -> is_sorted_by f (decorate_stable_sort f a)) ++ (Q.array Q.small_int) (fun a -> \ ++ let f n = if (n mod 4 = 0) then Some n else None in \ ++ is_sorted_by f (decorate_stable_sort f a)) + *) + + let decorate_fast_sort f xs = +@@ -670,8 +671,9 @@ let decorate_fast_sort f xs = + let () = fast_sort (fun (i,_) (j,_) -> Pervasives.compare i j) decorated in + map (fun (_,x) -> x) decorated + (*$Q decorate_fast_sort +- (Q.pair (Q.array Q.small_int) (Q.fun1 Q.Observable.int (Q.option Q.int))) \ +- (fun (a, Q.Fun(_,f)) -> is_sorted_by f (decorate_fast_sort f a)) ++ (Q.array Q.small_int) (fun a -> \ ++ let f n = if (n mod 4 = 0) then Some n else None in \ ++ is_sorted_by f (decorate_fast_sort f a)) + *) + + let bsearch cmp arr x = +diff --git a/src/batInnerShuffle.ml b/src/batInnerShuffle.ml +index 4bcda867..3593a8f8 100644 +--- a/src/batInnerShuffle.ml ++++ b/src/batInnerShuffle.ml +@@ -12,7 +12,7 @@ let array_shuffle ?state a = + done + + (*$Q +- Q.(array_of_size Gen.(2--15) small_int) (fun a -> \ ++ Q.(array_of_size (fun _ -> 10) small_int) (fun a -> \ + let a' = Array.copy a in \ + array_shuffle a'; \ + (Array.to_list a' |> List.sort Pervasives.compare) = \ +diff --git a/src/batList.mlv b/src/batList.mlv +index 9208b765..d7c5d6ce 100644 +--- a/src/batList.mlv ++++ b/src/batList.mlv +@@ -232,8 +232,9 @@ let map f = function + loop r t; + inj r + (*$Q map +- (Q.pair (Q.fun1 Q.Observable.int Q.int) (Q.list Q.small_int)) \ +- (fun (Q.Fun (_,f),l) -> map f l = List.map f l) ++ (Q.list Q.small_int) (fun l -> \ ++ let f n = n+1 in \ ++ map f l = List.map f l) + *) + + let rec drop n = function +-- +2.13.6 + diff --git a/build/odoc_batteries_factored.ml b/build/odoc_batteries_factored.ml index 58ee2477d..364ca45a1 100644 --- a/build/odoc_batteries_factored.ml +++ b/build/odoc_batteries_factored.ml @@ -79,7 +79,7 @@ let has_parent a ~parent:b = result let merge_info_opt a b = - verbose ("Merging informations"); + verbose ("Merging information"); if a <> b then begin verbose ("1: "^(string_of_info_opt a)); diff --git a/build/odoc_generator_batlib.ml b/build/odoc_generator_batlib.ml index d0b4168d2..a6cca883d 100644 --- a/build/odoc_generator_batlib.ml +++ b/build/odoc_generator_batlib.ml @@ -102,7 +102,7 @@ let has_parent a ~parent:b = let roots = ["Batteries"] let merge_info_opt a b = - verbose ("Merging informations"); + verbose ("Merging information"); if a <> b then begin verbose ("1: "^(string_of_info_opt a)); diff --git a/build/optcomp/pa_optcomp.ml b/build/optcomp/pa_optcomp.ml index e2c78c56a..a49e81926 100644 --- a/build/optcomp/pa_optcomp.ml +++ b/build/optcomp/pa_optcomp.ml @@ -78,7 +78,7 @@ let add_include_dir dir = dirs := dir :: !dirs module String_set = Set.Make(String) -(* All depencies of the file being parsed *) +(* All dependencies of the file being parsed *) let dependencies = ref String_set.empty (* Where to write dependencies *) @@ -302,7 +302,7 @@ let rec parse_eol stream = | _ -> Loc.raise loc (Stream.Error "end of line expected") -(* Return wether a keyword can be interpreted as an identifier *) +(* Return whether a keyword can be interpreted as an identifier *) let keyword_is_id str = let rec aux i = if i = String.length str then @@ -516,13 +516,13 @@ type state = { (* Input stream *) mutable bol : bool; - (* Wether we are at the beginning of a line *) + (* Whether we are at the beginning of a line *) mutable stack : context list; (* Nested contexts *) on_eoi : Gram.Token.t * Loc.t -> Gram.Token.t * Loc.t; - (* Eoi handler, it is used to restore the previous sate on #include + (* Eoi handler, it is used to restore the previous state on #include directives *) } diff --git a/build/optcomp/sample.ml b/build/optcomp/sample.ml index 07e88d0b6..7cdaa0e39 100644 --- a/build/optcomp/sample.ml +++ b/build/optcomp/sample.ml @@ -77,7 +77,7 @@ type t = private int type t #endif -(* It is also possible to split the expression over multible lines by +(* It is also possible to split the expression over multiple lines by using parentheses: *) #let ocaml_major_version = fst ocaml_version @@ -101,7 +101,7 @@ let x = 1 is what is allowed: - litterals booleans, integers, strings and characters: - - basic interger operations: +, -, /, *, mod + - basic integer operations: +, -, /, *, mod - value comparing: =, <>, <, >, <=, >= - maximum and minimum: max, min - basic boolean operations: or, ||, &&, not diff --git a/build/prefilter.ml b/build/prefilter.ml index 21a1e5988..0045645c0 100644 --- a/build/prefilter.ml +++ b/build/prefilter.ml @@ -38,8 +38,9 @@ let print_loc = function end let process_line loc line = - if Str.string_match filter_cookie_re line 0 then begin - mark_loc_stale loc; + if not (Str.string_match filter_cookie_re line 0) + then print_endline line + else begin let cmp = match Str.matched_group 1 line with | "<" -> (<) | ">" -> (>) | "=" -> (=) | "<=" -> (<=) | ">=" -> (>=) @@ -52,16 +53,15 @@ let process_line loc line = let pass = cmp (major*100+minor) (ver_maj*100+ver_min) in if pass then print_endline (Str.replace_first filter_cookie_re "" line) - end else begin - print_loc loc; - print_endline line; - end + else mark_loc_stale loc + end let ( |> ) x f = f x let process in_channel loc = try while true do + print_loc loc; input_line in_channel |> process_line loc; incr_loc loc; done diff --git a/examples/euler/euler012.ml b/examples/euler/euler012.ml index 385c8a172..06c233b16 100644 --- a/examples/euler/euler012.ml +++ b/examples/euler/euler012.ml @@ -6,7 +6,7 @@ let num_div x = if x mod i = 0 then incr count done; count := !count * 2; (* every factor < max_test has a corresponding one > *) - if x mod max_test = 0 then decr count; (* dont double count root if x square *) + if x mod max_test = 0 then decr count; (* don't double count root if x square *) !count let rec loop i n = diff --git a/examples/pleac/strings.ml b/examples/pleac/strings.ml index 28416c278..7d402958a 100644 --- a/examples/pleac/strings.ml +++ b/examples/pleac/strings.ml @@ -383,7 +383,7 @@ val rest : string = Expanding Variables in User Input (* As far as I know there is no way to do this in OCaml due to - type-safety contraints built into the OCaml compiler -- it may be + type-safety constraints built into the OCaml compiler -- it may be feasible with *much* juju, but don't expect to see this anytime soon... @@ -551,7 +551,7 @@ Escaping Characters ** interpreter or the compilers. ** ** The "#load" line is only needed if you are running this in the -** command interpretter. +** command interpreter. ** ** If you are using either of the ocaml compilers, you will need ** to remove the "#load" line and link in str.cmxa in the final diff --git a/howto/coverage.md b/howto/coverage.md deleted file mode 100644 index 10045b2a3..000000000 --- a/howto/coverage.md +++ /dev/null @@ -1,12 +0,0 @@ -Test Coverage -------------- - -First, you need to install `bisect` and `qtest`: - - $ opam install bisect qtest - -Then, run - - $ make coverage - -Then open the file `coverage/index.html` to see how many tests you need to write :) diff --git a/howto/release.md b/howto/release.md index 4f3b14c71..0368e0dd6 100644 --- a/howto/release.md +++ b/howto/release.md @@ -5,6 +5,11 @@ Make a release - `make test` on a 64 bits machine - `make test` on a 32 bits machine + (in practice, we have a hard time finding 32 bits machine these + days, so it's okay to skip this test) + +- `make test` with the oldest ocaml compiler version we are supporting + (for example, in an opam 3.12.1 switch) - install the to-be-released version with `opam pin add -k git .`, and then run the post-install tests with `make test-build-from-install` @@ -13,6 +18,14 @@ Make a release software in your main development switch, feel free to move to a fresh new switch to test this.) +- instead of the previous, you can also run the fully automatic + 'make test_install'. This will force a rebuild and install + of batteries (make clean && make install); + then go to a temporary directory and try to compile and run + a test program using batteries. + After, you may want to 'opam reinstall batteries' in order to get rid + of this development version of batteries from your current opam switch. + # Release marking These steps can be redone as many times as necessary, and do not need @@ -20,7 +33,7 @@ to be performed by someone with commit rights. - inspect commits and sources to find @since tags to add/substitute (especially @since NEXT_RELEASE); `sh scripts/find_since.sh` can - help + help. ./scripts/replace_since.sh helps even more. - check whether new functions should go in Incubator @@ -40,17 +53,67 @@ to be performed by someone with commit rights. - check that `make release` correctly produces a release tarball +## opam preparation work + +Performing the release will require sending a pull-request against the +public opam repository with an `opam` metadata file for the new +version. Here is how you should prepare this `opam` file. + +There are two sources of inspiration for the new opam file: + +- there is a local `opam` file at the root of the ocamlbuild + repository, that is used for pinning the development version. + +- there are the `opam` files for previous OCamlbuild releases in the + public opam repository: + https://github.com/ocaml/opam-repository/tree/master/packages/batteries + +In theory the two should be in synch: the `opam` file we send to the +public opam repository is derived from the local `opam` file. However, +upstream opam repository curators may have made changes to the public +opam files, to reflect new packaging best practices and policies. You +should check for any change to the latest version's `opam` file; if +there is any, it should probably be reproduced into our local `opam` +file, and committed. + +Note that the local file may have changed during the release lifetime +to reflect new dependencies or changes in packaging policies. These +changes should also be preserved in the opam file for the new version. + +To summarize, you should first update the local `opam` file to contain +interesting changes from the in-repository versions. You can then +prepare an `opam` file for the new version, derived from the local +`opam` file. + +When editing an opam file (locally or in the package repository), you +should use use `opam lint` to check that the opam file follows best +practices. + # Performing the actual release - Commit and add a tag (`git tag -a `; `git push --tags origin`) Tag names are usually of the form "vM.m.b", for example "v2.5.3", use `git tag --list` to see existing tags. + - run `make release` to produce a tarball -- upload the tarball to ocamlforge -- upload the documentation (`make upload-docs` ?) -- send a pull-request against the public opam repository + +- on the Github "Releases" + [page](https://github.com/ocaml-batteries-team/batteries-included/releases) + you should see the just-pushed tag. You should `edit` the release to + include the release notes (the general blurb you wrote and the + detailed Changelog, in markdown format), and upload the release + tarball. + +- Upload the documentation (`make upload-docs`). You can check that + the documentation is appropriately updated at + http://ocaml-batteries-team.github.io/batteries-included/hdoc2/ + +- send a pull-request against the public opam repository with the + opam file prepared for the new version # Post-release work -- create a Changelog section for NEXT_RELEASE -- once the new opam package is merged, announce on the mailing-list +- create a Changelog section for NEXT_RELEASE, + use NEXT_RELEASE in the _oasis version field + +- once the new opam package is merged, announce on the mailing-list. diff --git a/myocamlbuild.ml b/myocamlbuild.ml index 702476557..4a535a145 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -14,22 +14,6 @@ let packs = "bigarray,num,str" let doc_intro = "build/intro.text" let mkconf = "build/mkconf.byte" let compiler_libs = if Sys.ocaml_version.[0] = '4' then [A"-I"; A"+compiler-libs"] else [] -(* removes the trailing newlines in the stdout of s *) -let run_and_read s = - let res = run_and_read s in - String.chomp res - -(* Throws exception if bisect not installed - ignore this exception *) -let bisect_dir = try run_and_read "ocamlfind query bisect" with _ -> "." -let bisect_pp = Pathname.concat bisect_dir "bisect_pp.cmo" - -let src_bat_ml = - let l = Array.to_list (Pathname.readdir "src") in - let l = - List.filter (fun filename -> - String.is_prefix "bat" filename && String.is_suffix filename ".ml" - ) l in - List.map (fun filename -> Pathname.concat "src" filename) l let _ = dispatch begin function | Before_options -> @@ -65,33 +49,7 @@ let _ = dispatch begin function ~deps:["META.in"; mkconf] begin fun env build -> Cmd(S[A"ocamlrun"; P mkconf; P"META.in"; P"META"]) - end; - - rule "code coverage" - ~prod:"coverage/index.html" - ~deps:src_bat_ml - begin fun env build -> - List.iter (fun filename -> - tag_file filename ["with_pa_bisect"; "syntax_camlp4o"; "use_bisect"]; - ) src_bat_ml; - let test_exes = [ - "testsuite/main.native"; - "qtest/all_tests.native"; - ] in - List.iter (fun exe -> tag_file exe ["use_bisect"]) test_exes; - List.iter Outcome.ignore_good (build ( - List.map (fun exe -> [exe]) test_exes - )); - Seq ([ - Cmd(S[Sh"rm -f bisect*.out"]); - ] @ - List.map (fun exe -> Cmd(S[A exe])) test_exes - @ [ - Cmd(S[Sh"bisect-report -html coverage bisect*.out"]); - ]) - end; - - () + end | After_rules -> @@ -111,17 +69,22 @@ let _ = dispatch begin function prefilter_rule "ml"; prefilter_rule "mli"; - begin (* BatConcreteQueue is either BatConcreteQueue_40x *) - let major, minor = - try Scanf.sscanf Sys.ocaml_version "%d.%d" (fun m n -> (m, n)) - with _ -> (* an arbitrary choice is better than failing here *) - (4, 0) in + + let ocaml_version = + try Scanf.sscanf Sys.ocaml_version "%d.%d" (fun m n -> (m, n)) + with _ -> (* an arbitrary choice is better than failing here *) + (4, 0) + in + + begin + (* BatConcreteQueue is either BatConcreteQueue_40x *) let queue_implementation = + let major, minor = ocaml_version in if major < 4 || major = 4 && minor <= 2 then "src/batConcreteQueue_402.ml" else "src/batConcreteQueue_403.ml" in copy_rule "queue implementation" - queue_implementation "src/BatConcreteQueue.ml"; + queue_implementation "src/batConcreteQueue.ml"; end; (* Rules to create libraries from .mllib instead of .cmo. @@ -193,15 +156,6 @@ let _ = dispatch begin function flag ["ocaml"; "ocamldep"; "syntax_camlp4o"] & S[A"-syntax"; A"camlp4o"; A"-package"; A"camlp4"]; - let flags_pa_bisect = - S[A"-ppopt"; P"str.cma"; A"-ppopt"; P bisect_pp; - A"-ppopt"; A"-disable"; A"-ppopt"; A"b"] in - (* bisect screws up polymorphic recursion without -disable b *) - flag ["ocaml"; "compile"; "with_pa_bisect"] & flags_pa_bisect; - flag ["ocaml"; "ocamldep"; "with_pa_bisect"] & flags_pa_bisect; - - ocaml_lib ~extern:true ~dir:bisect_dir "bisect"; - ocaml_lib "src/batteries"; ocaml_lib "src/batteriesThread"; @@ -209,8 +163,13 @@ let _ = dispatch begin function flag ["ocaml"; "link"; "compiler-libs"] & S compiler_libs; flag ["ocaml"; "ocamldep"; "compiler-libs"] & S compiler_libs; - flag ["ocaml"; "link"; "linkall"] & S[A"-linkall"]; + + if ocaml_version = (4, 0) then begin + (* OCaml 4.00 has -bin-annot but no ocamlbuild flag *) + flag ["ocaml"; "bin_annot"; "compile"] (A "-bin-annot"); + flag ["ocaml"; "bin_annot"; "pack"] (A "-bin-annot"); + end; (* dep ["ocaml"; "link"; "include_tests"; "byte"] & [Pathname.mk "qtest/test_mods.cma"]; diff --git a/opam b/opam index bd6183f6b..f40435a67 100644 --- a/opam +++ b/opam @@ -1,27 +1,31 @@ -opam-version: "1.2" -name: "batteries" -maintainer: "thelema314@gmail.com" +opam-version: "2.0" +synopsis: "A community-maintained standard library extension" +maintainer: [ + "Francois Berenger " + "Gabriel Scherer " + "Thibault Suzanne " +] authors: "OCaml batteries-included team" homepage: "http://batteries.forge.ocamlcore.org/" bug-reports: "https://github.com/ocaml-batteries-team/batteries-included/issues" -dev-repo: "https://github.com/ocaml-batteries-team/batteries-included.git" +dev-repo: "git://github.com/ocaml-batteries-team/batteries-included.git" license: "LGPL-2.1+ with OCaml linking exception" doc: "http://ocaml-batteries-team.github.io/batteries-included/hdoc2/" - build: [ ["ocaml" "setup.ml" "-configure" "--prefix" prefix] [make "all"] ] -install: [ - [make "install"] -] -remove: [["ocamlfind" "remove" "batteries"]] - +install: [make "install"] +remove: ["ocamlfind" "remove" "batteries"] depends: [ - "ocamlfind" {>= "1.5.3"} + "ocaml" {>= "3.12.1"} + "ocamlfind" {build & >= "1.5.3"} "ocamlbuild" {build} - "qtest" {test & >= "2.0.0"} -] -available: [ - ocaml-version >= "3.12.1" + "qtest" {with-test & >= "2.5"} + "qcheck" {with-test & >= "0.6"} + "num" ] +#url { +# src: "https://github.com/ocaml-batteries-team/batteries-included/releases/download/vXXX/batteries-XXX.tar.gz" +# checksum: "md5=XXX" +#} diff --git a/scripts/replace_since.sh b/scripts/replace_since.sh index c7455cf3b..bcba99909 100755 --- a/scripts/replace_since.sh +++ b/scripts/replace_since.sh @@ -7,9 +7,11 @@ VERSION="$1" echo "version number: $VERSION" -if [ -e "$VERSION" ] ; then - echo "please give a version number" +if [ -z "$VERSION" ] ; then + echo "please give a version number, for example:" + echo "sh scripts/replace_since.sh 2.8.0" exit 1 fi -find src/ -name '*.ml*' -exec sed -i'' "s/NEXT_RELEASE/$VERSION/g" {} \; +sed "s/NEXT_RELEASE/$VERSION/g" -i'' -- _oasis +find src/ -name '*.ml*' -exec sed "s/NEXT_RELEASE/$VERSION/g" -i'' {} \; diff --git a/scripts/test_install.sh b/scripts/test_install.sh new file mode 100755 index 000000000..d5dc90a5c --- /dev/null +++ b/scripts/test_install.sh @@ -0,0 +1,22 @@ +#!/bin/bash + +#set -x + +temp_dir=`mktemp -d` + +cat< $temp_dir/install_test.ml +open Batteries +let () = + assert(List.takedrop 2 [1;2;3;4] = ([1;2], [3;4])); + Printf.printf "install_test: OK\n" +EOF + +make clean # force rebuild next +make install && \ + cd $temp_dir && \ + rm -f install_test.native && \ + ocamlbuild -pkg batteries install_test.native && \ + ./install_test.native + +cd - # go back where we were before +rm -rf $temp_dir # clean our mess diff --git a/setup.ml b/setup.ml index df2daf7d9..8df1e0dde 100644 --- a/setup.ml +++ b/setup.ml @@ -1,9 +1,9 @@ (* setup.ml generated for the first time by OASIS v0.2.0 *) (* OASIS_START *) -(* DO NOT EDIT (digest: a51a2b1c68e2c0b4704f4a3a53c5a91f) *) +(* DO NOT EDIT (digest: 8eacb5fc3c01b3f2ec2fa94f8db2c52a) *) (* - Regenerated by OASIS v0.4.7 + Regenerated by OASIS v0.4.11 Visit http://oasis.forge.ocamlcore.org for more information and documentation about functions used in this file. *) @@ -112,10 +112,7 @@ module OASISString = struct ok := false; incr str_idx done; - if !what_idx = String.length what then - true - else - false + !what_idx = String.length what let strip_starts_with ~what str = @@ -138,10 +135,7 @@ module OASISString = struct ok := false; decr str_idx done; - if !what_idx = -1 then - true - else - false + !what_idx = -1 let strip_ends_with ~what str = @@ -658,6 +652,7 @@ module OASISContext = struct ignore_unknown_fields: bool; printf: level -> string -> unit; srcfs: source OASISFileSystem.fs; + load_oasis_plugin: string -> bool; } @@ -682,6 +677,7 @@ module OASISContext = struct ignore_unknown_fields = false; printf = printf; srcfs = new OASISFileSystem.host_fs(Sys.getcwd ()); + load_oasis_plugin = (fun _ -> false); } @@ -3160,7 +3156,7 @@ module OASISFileUtil = struct end -# 3163 "setup.ml" +# 3159 "setup.ml" module BaseEnvLight = struct (* # 22 "src/base/BaseEnvLight.ml" *) @@ -3240,7 +3236,7 @@ module BaseEnvLight = struct end -# 3243 "setup.ml" +# 3239 "setup.ml" module BaseContext = struct (* # 22 "src/base/BaseContext.ml" *) @@ -5663,7 +5659,7 @@ module BaseCompat = struct end -# 5666 "setup.ml" +# 5662 "setup.ml" module InternalConfigurePlugin = struct (* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *) @@ -6014,17 +6010,14 @@ module InternalInstallPlugin = struct let install = - let in_destdir = + let in_destdir fn = try - let destdir = - destdir () - in - (* Practically speaking destdir is prepended - * at the beginning of the target filename - *) - fun fn -> destdir^fn + (* Practically speaking destdir is prepended at the beginning of the + target filename + *) + (destdir ())^fn with PropList.Not_set _ -> - fun fn -> fn + fn in let install_file ~ctxt ?(prepend_destdir=true) ?tgt_fn src_file envdir = @@ -6469,7 +6462,7 @@ module InternalInstallPlugin = struct end -# 6472 "setup.ml" +# 6465 "setup.ml" module CustomPlugin = struct (* # 22 "src/plugins/custom/CustomPlugin.ml" *) @@ -6601,7 +6594,7 @@ module CustomPlugin = struct end -# 6604 "setup.ml" +# 6597 "setup.ml" open OASISTypes;; let setup_t = @@ -6749,7 +6742,7 @@ let setup_t = { oasis_version = "0.4"; ocaml_version = Some (OASISVersion.VGreaterEqual "3.12.1"); - version = "2.5.3"; + version = "2.10.0"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -7025,8 +7018,8 @@ let setup_t = plugin_data = [] }; oasis_fn = Some "_oasis"; - oasis_version = "0.4.7"; - oasis_digest = Some "\143s\158&\025\149\1607\029T\137G\136\\C\185"; + oasis_version = "0.4.11"; + oasis_digest = Some "\031B\"\198\141\157`Yd\200\159F\169\162\127\022"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -7034,7 +7027,7 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 7038 "setup.ml" +# 7031 "setup.ml" let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t open BaseCompat.Compat_0_4 (* OASIS_STOP *) diff --git a/src/batArray.mliv b/src/batArray.mliv index 56ba12573..3bdb1007f 100644 --- a/src/batArray.mliv +++ b/src/batArray.mliv @@ -96,6 +96,10 @@ external make : int -> 'a -> 'a array = "caml_make_vect" @since 2.3.0 *) +##V>=4.07##val of_seq: 'a Seq.t -> 'a array +##V>=4.07##val to_seq: 'a array -> 'a Seq.t +##V>=4.07##val to_seqi: 'a array -> (int * 'a) Seq.t + external create : int -> 'a -> 'a array = "caml_make_vect" (** @deprecated [Array.create] is an alias for {!Array.make}. *) @@ -166,6 +170,9 @@ val blit : 'a array -> int -> 'a array -> int -> int -> unit val to_list : 'a array -> 'a list (** [Array.to_list a] returns the list of all the elements of [a]. *) +val split : ('a * 'b) array -> 'a array * 'b array +(** [Array.split a] converts the array of pairs [a] into a pair of arrays. *) + val of_list : 'a list -> 'a array (** [Array.of_list l] returns a fresh array containing the elements of [l]. *) @@ -182,6 +189,12 @@ val min : 'a array -> 'a @raise Invalid_argument on empty input *) +val min_max : 'a array -> 'a * 'a +(** [min_max a] returns the (smallest, largest) pair of values from [a] + as judged by [Pervasives.compare] + + @raise Invalid_argument on empty input *) + val sum : int array -> int (** [sum l] returns the sum of the integers of [l] *) @@ -525,13 +538,16 @@ val range : 'a array -> int BatEnum.t val insert : 'a array -> 'a -> int -> 'a array (** [insert xs x i] returns a copy of [xs] except the value [x] is inserted in position [i] (and all later indices are shifted to the - right). *) + right). + + @raise Invalid_argument + if [i < 0 || i > Array.length xs]. *) (** {6 Boilerplate code}*) val print : ?first:string -> ?last:string -> ?sep:string -> ('a, 'b) BatIO.printer -> ('a t, 'b) BatIO.printer -(** Print the contents of an array, with [~first] preceeding the first +(** Print the contents of an array, with [~first] preceding the first item (default: "\[|"), [~last] following the last item (default: "|\]") and [~sep] separating items (default: "; "). A printing function must be provided to print the items in the array. @@ -551,6 +567,18 @@ val ord : 'a BatOrd.ord -> 'a array BatOrd.ord lexicographically for arrays of the same size. This is a different ordering than [compare], but is often faster. *) +val shuffle : ?state:Random.State.t -> 'a array -> unit +(** [shuffle ~state:rs a] randomly shuffles in place the elements of [a]. + The optional random state [rs] allows to control the random + numbers being used during shuffling (for reproducibility). + + Shuffling is implemented using the Fisher-Yates + algorithm and works in O(n), where n is the number + of elements of [a]. + + @since 2.6.0 +*) + val equal : 'a BatOrd.eq -> 'a array BatOrd.eq (** Hoist a equality test for elements to arrays. Arrays are only equal if their lengths are the same and corresponding elements @@ -741,6 +769,7 @@ sig val backwards : ('a, [> `Read]) t -> 'a BatEnum.t val of_backwards : 'a BatEnum.t -> ('a, _) t val to_list : ('a, [> `Read]) t -> 'a list + val split : ('a * 'b, [> `Read]) t -> ('a, _) t * ('b, _) t val of_list : 'a list -> ('a, _) t (** {6 Utilities} *) @@ -830,4 +859,14 @@ val is_sorted_by : ('a -> 'b) -> 'a array -> bool external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get" external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set" +##V>=4.6##module Floatarray : sig +##V>=4.6## external create : int -> floatarray = "caml_floatarray_create" +##V>=4.6## external length : floatarray -> int = "%floatarray_length" +##V>=4.6## external get : floatarray -> int -> float = "%floatarray_safe_get" +##V>=4.6## external set : floatarray -> int -> float -> unit = "%floatarray_safe_set" +##V>=4.6## external unsafe_get : floatarray -> int -> float = "%floatarray_unsafe_get" +##V>=4.6## external unsafe_set : floatarray -> int -> float -> unit +##V>=4.6## = "%floatarray_unsafe_set" +##V>=4.6##end + (**/**) diff --git a/src/batArray.mlv b/src/batArray.mlv index 70d34f489..aaf31f847 100644 --- a/src/batArray.mlv +++ b/src/batArray.mlv @@ -20,12 +20,12 @@ *) +include Array + type 'a t = 'a array type 'a enumerable = 'a t type 'a mappable = 'a t -include Array - ##V<4.2##let create_float n = make n 0. ##V<4.2##let make_float = create_float @@ -175,7 +175,7 @@ let findi p xs = in loop 0 (*$Q findi - (Q.pair (Q.array Q.small_int) (Q.fun1 Q.small_int Q.bool)) (fun (a, f) -> \ + (Q.pair (Q.array Q.small_int) (Q.fun1 Q.Observable.int Q.bool)) (fun (a, Q.Fun(_,f)) -> \ try let index = findi f a in \ let i = ref (-1) in \ for_all (fun elt -> incr i; \ @@ -187,7 +187,7 @@ let findi p xs = let find p xs = xs.(findi p xs) (*$Q find - (Q.pair (Q.array Q.small_int) (Q.fun1 Q.small_int Q.bool)) (fun (a, f) -> \ + (Q.pair (Q.array Q.small_int) (Q.fun1 Q.Observable.int Q.bool)) (fun (a, Q.Fun(_,f)) -> \ let a = map (fun x -> `a x) a in \ let f (`a x) = f x in\ try let elt = find f a in \ @@ -214,10 +214,10 @@ let filter p xs = | Some i -> j := i+1; xs.(i) | None -> (* not enough 1 bits - incorrect count? *) - assert false (*BISECT-VISIT*) + assert false ) (*$Q filter - (Q.pair (Q.array Q.small_int) (Q.fun1 Q.small_int Q.bool)) (fun (a, f) -> \ + (Q.pair (Q.array Q.small_int) (Q.fun1 Q.Observable.int Q.bool)) (fun (a, Q.Fun(_,f)) -> \ let b = Array.to_list (filter f a) in \ let b' = List.filter f (Array.to_list a) in \ List.for_all (fun (x,y) -> x = y) (List.combine b b') \ @@ -239,7 +239,7 @@ let filteri p xs = | Some i -> j := i+1; xs.(i) | None -> (* not enough 1 bits - incorrect count? *) - assert false (*BISECT-VISIT*) + assert false ) (*$T filteri @@ -248,35 +248,36 @@ let filteri p xs = let find_all = filter -let partition p xs = - let n = length xs in - (* Use a bitset to store which elements will be in which final array. *) - let bs = BatBitSet.create n in - for i = 0 to n-1 do - if p xs.(i) then BatBitSet.set bs i - done; - (* Allocate the final arrays and copy elements into them. *) - let n1 = BatBitSet.count bs in - let n2 = n - n1 in - let j = ref 0 in - let xs1 = init n1 - (fun _ -> - (* Find the next set bit in the BitSet. *) - while not (BatBitSet.mem bs !j) do incr j done; - let r = xs.(!j) in - incr j; - r) in - let j = ref 0 in - let xs2 = init n2 - (fun _ -> - (* Find the next clear bit in the BitSet. *) - while BatBitSet.mem bs !j do incr j done; - let r = xs.(!j) in - incr j; - r) in - xs1, xs2 +(* <=> List.partition *) +let partition p a = + let n = length a in + if n = 0 then ([||], [||]) + else + let ok_count = ref 0 in + let mask = + init n (fun i -> + let pi = p (unsafe_get a i) in + if pi then incr ok_count; + pi) in + let ko_count = n - !ok_count in + let init = unsafe_get a 0 in + let ok = make !ok_count init in + let ko = make ko_count init in + let j = ref 0 in + let k = ref 0 in + for i = 0 to n - 1 do + let x = unsafe_get a i in + let px = unsafe_get mask i in + if px then + (unsafe_set ok !j x; + incr j) + else + (unsafe_set ko !k x; + incr k) + done; + (ok, ko) (*$Q partition - (Q.pair (Q.array Q.small_int) (Q.fun1 Q.small_int Q.bool)) (fun (a, f) -> \ + (Q.pair (Q.array Q.small_int) (Q.fun1 Q.Observable.int Q.bool)) (fun (a, Q.Fun(_,f)) -> \ let b1, b2 = partition f a in \ let b1, b2 = Array.to_list b1, Array.to_list b2 in \ let b1', b2' = List.partition f (Array.to_list a) in \ @@ -355,7 +356,7 @@ let of_enum e = (fun _i -> match BatEnum.get e with | Some x -> x - | None -> assert false (*BISECT-VISIT*)) + | None -> assert false) let of_backwards e = of_list (BatList.of_backwards e) @@ -370,8 +371,8 @@ let range xs = BatEnum.(--^) 0 (Array.length xs) let filter_map p xs = of_enum (BatEnum.filter_map p (enum xs)) (*$Q filter_map - (Q.pair (Q.array Q.small_int) (Q.fun1 Q.small_int (Q.option Q.int))) \ - (fun (a, f) -> \ + (Q.pair (Q.array Q.small_int) (Q.fun1 Q.Observable.int (Q.option Q.int))) \ + (fun (a, Q.Fun (_,f)) -> \ let a' = filter (fun elt -> f elt <> None) a in \ let a' = map (f %> BatOption.get) a' in \ let a = filter_map f a in \ @@ -381,7 +382,7 @@ let filter_map p xs = let iter2 f a1 a2 = if Array.length a1 <> Array.length a2 - then raise (Invalid_argument "Array.iter2"); + then invalid_arg "Array.iter2"; for i = 0 to Array.length a1 - 1 do f a1.(i) a2.(i); done @@ -405,7 +406,7 @@ let iter2 f a1 a2 = let iter2i f a1 a2 = if Array.length a1 <> Array.length a2 - then raise (Invalid_argument "Array.iter2i"); + then invalid_arg "Array.iter2i"; for i = 0 to Array.length a1 - 1 do f i a1.(i) a2.(i); done @@ -429,7 +430,7 @@ let iter2i f a1 a2 = let for_all2 p xs ys = let n = length xs in - if length ys <> n then raise (Invalid_argument "Array.for_all2"); + if length ys <> n then invalid_arg "Array.for_all2"; let rec loop i = if i = n then true else if p xs.(i) ys.(i) then loop (succ i) @@ -449,7 +450,7 @@ let for_all2 p xs ys = let exists2 p xs ys = let n = length xs in - if length ys <> n then raise (Invalid_argument "Array.exists2"); + if length ys <> n then invalid_arg "Array.exists2"; let rec loop i = if i = n then false else if p xs.(i) ys.(i) then true @@ -466,7 +467,7 @@ let exists2 p xs ys = let map2 f xs ys = let n = length xs in - if length ys <> n then raise (Invalid_argument "Array.map2"); + if length ys <> n then invalid_arg "Array.map2"; Array.init n (fun i -> f xs.(i) ys.(i)) (*$T map2 @@ -573,12 +574,31 @@ let max a = reduce Pervasives.max a max [|2;3;1|] = 3 *) -let sum = reduce (+) -let fsum = reduce (+.) +let min_max a = + let n = Array.length a in + if n = 0 then + invalid_arg "Array.min_max: empty array" + else + let mini = ref a.(0) in + let maxi = ref a.(0) in + for i = 1 to n - 1 do + if a.(i) > !maxi then maxi := a.(i); + if a.(i) < !mini then mini := a.(i) + done; + (!mini, !maxi) +(*$T min_max + min_max [|1|] = (1, 1) + min_max [|1;-2;10;3|] = (-2, 10) + try ignore (min_max [||]); false with Invalid_argument _ -> true +*) + +let sum = fold_left (+) 0 +let fsum = fold_left (+.) 0. (*$T sum sum [|1;2;3|] = 6 sum [|0|] = 0 + sum [||] = 0 *) (*$T fsum fsum [|1.0;2.0;3.0|] = 6.0 fsum [|0.0|] = 0.0 @@ -643,8 +663,8 @@ let decorate_stable_sort f xs = = [|(0,2);(1,2);(1,3);(1,4)|] *) (*$Q decorate_stable_sort - (Q.pair (Q.array Q.small_int) (Q.fun1 Q.small_int (Q.option Q.int))) \ - (fun (a, f) -> is_sorted_by f (decorate_stable_sort f a)) + (Q.pair (Q.array Q.small_int) (Q.fun1 Q.Observable.int (Q.option Q.int))) \ + (fun (a, Q.Fun(_,f)) -> is_sorted_by f (decorate_stable_sort f a)) *) let decorate_fast_sort f xs = @@ -652,8 +672,8 @@ let decorate_fast_sort f xs = let () = fast_sort (fun (i,_) (j,_) -> Pervasives.compare i j) decorated in map (fun (_,x) -> x) decorated (*$Q decorate_fast_sort - (Q.pair (Q.array Q.small_int) (Q.fun1 Q.small_int (Q.option Q.int))) \ - (fun (a, f) -> is_sorted_by f (decorate_fast_sort f a)) + (Q.pair (Q.array Q.small_int) (Q.fun1 Q.Observable.int (Q.option Q.int))) \ + (fun (a, Q.Fun(_,f)) -> is_sorted_by f (decorate_fast_sort f a)) *) let bsearch cmp arr x = @@ -730,8 +750,16 @@ let split cmp arr x = *) let insert xs x i = - if i > Array.length xs then invalid_arg "Array.insert: offset out of range"; - Array.init (Array.length xs + 1) (fun j -> if j < i then xs.(j) else if j > i then xs.(j-1) else x) + let len = Array.length xs in + if i < 0 || i > len then + invalid_arg "Array.insert: offset out of range"; + Array.init (len+1) (fun j -> + if j < i then + unsafe_get xs j + else if j > i then + unsafe_get xs (j-1) + else + x) (*$T insert insert [|1;2;3|] 4 0 = [|4;1;2;3|] @@ -781,6 +809,37 @@ let ord ord_elt a1 a2 = ord BatInt.ord [|1;1;1|] [|1;1;1|] = BatOrd.Eq *) +let shuffle ?state a = + BatInnerShuffle.array_shuffle ?state a +(*$T shuffle + let s = Random.State.make [|11|] in \ + let a = [|1;2;3;4;5;6;7;8;9|] in \ + shuffle ~state:s a; \ + a = [|7; 2; 9; 5; 3; 6; 4; 1; 8|] + let b = [||] in \ + shuffle b; \ + b = [||] +*) + +(* equivalent of List.split *) +let split a = + let n = length a in + if n = 0 then ([||], [||]) + else + let l, r = unsafe_get a 0 in + let left = make n l in + let right = make n r in + for i = 1 to n - 1 do + let l, r = unsafe_get a i in + unsafe_set left i l; + unsafe_set right i r + done; + (left, right) +(*$T split + split [||] = ([||], [||]) + split [|(1,2);(3,4);(5,6)|] = ([|1;3;5|], [|2;4;6|]) +*) + module Incubator = struct module Eq (T : BatOrd.Eq) = struct type t = T.t array @@ -882,6 +941,7 @@ struct let backwards = backwards let of_backwards = of_backwards let to_list = to_list + let split = split let of_list = of_list let sort = sort let stable_sort = stable_sort @@ -893,7 +953,6 @@ struct external unsafe_get : ('a, [> `Read]) t -> int -> 'a = "%array_unsafe_get" external unsafe_set : ('a, [> `Write])t -> int -> 'a -> unit = "%array_unsafe_set" - (*BISECT-IGNORE-BEGIN*) module Labels = struct let init i ~f = init i f @@ -934,10 +993,8 @@ struct try Some (findi f e) with Not_found -> None end - (*BISECT-IGNORE-END*) end -(*BISECT-IGNORE-BEGIN*) module Exceptionless = struct let find f e = @@ -984,4 +1041,3 @@ struct let findi ~f e = findi f e end end -(*BISECT-IGNORE-END*) diff --git a/src/batBase64.ml b/src/batBase64.ml index 17e0e54bc..4660f9eb2 100644 --- a/src/batBase64.ml +++ b/src/batBase64.ml @@ -67,7 +67,7 @@ let encode ?(tbl=chars) ch = in let output s p l = for i = p to p + l - 1 do - write (String.unsafe_get s i) + write (Bytes.unsafe_get s i) done; l in diff --git a/src/batBig_int.mliv b/src/batBig_int.mliv index 557f69518..4693f08ca 100644 --- a/src/batBig_int.mliv +++ b/src/batBig_int.mliv @@ -180,6 +180,13 @@ val big_int_of_string : string -> big_int (** Convert a string to a big integer, in decimal. The string consists of an optional [-] or [+] sign, followed by one or several decimal digits. *) +val big_int_of_string_opt: string -> big_int option +(** Convert a string to a big integer, in decimal. + The string consists of an optional [-] or [+] sign, + followed by one or several decimal digits. Other the function + returns [None]. + @since 2.7.0 +*) val to_string_in_binary : big_int -> string (** as [string_of_big_int], but in base 2 *) @@ -242,6 +249,12 @@ val int_of_big_int : big_int -> int (** Convert a big integer to a small integer (type [int]). @raise Failure if the big integer is not representable as a small integer. *) +val int_of_big_int_opt: big_int -> int option +(** Convert a big integer to a small integer (type [int]). Return + [None] if the big integer is not representable as a small + integer. + @since 2.7.0 +*) val big_int_of_int32 : int32 -> big_int (** Convert a 32-bit integer to a big integer. *) @@ -253,14 +266,30 @@ val int32_of_big_int : big_int -> int32 (** Convert a big integer to a 32-bit integer. @raise Failure if the big integer is outside the range [[-2{^31}, 2{^31}-1]]. *) +val int32_of_big_int_opt: big_int -> int32 option +(** Convert a big integer to a 32-bit integer. Return [None] if the + big integer is outside the range \[-2{^31}, 2{^31}-1\]. + @since 2.7.0 +*) val nativeint_of_big_int : big_int -> nativeint (** Convert a big integer to a native integer. @raise Failure if the big integer is outside the range [[Nativeint.min_int, Nativeint.max_int]]. *) +val nativeint_of_big_int_opt: big_int -> nativeint option +(** Convert a big integer to a native integer. Return [None] if the + big integer is outside the range [[Nativeint.min_int, + Nativeint.max_int]]; + @since 2.7.0 +*) val int64_of_big_int : big_int -> int64 (** Convert a big integer to a 64-bit integer. @raise Failure if the big integer is outside the range [[-2{^63}, 2{^63}-1]]. *) +val int64_of_big_int_opt: big_int -> int64 option +(** Convert a big integer to a 64-bit integer. Return [None] if the + big integer is outside the range \[-2{^63}, 2{^63}-1\]. + @since 2.7.0 +*) val float_of_big_int : big_int -> float (** Returns a floating-point number approximating the @@ -316,7 +345,7 @@ val nat_of_big_int : big_int -> Nat.nat val big_int_of_nat : Nat.nat -> big_int val base_power_big_int: int -> int -> big_int -> big_int val sys_big_int_of_string: string -> int -> int -> big_int -val round_futur_last_digit : string -> int -> int -> bool +val round_futur_last_digit : Bytes.t -> int -> int -> bool val approx_big_int: int -> big_int -> string ##V>=4.3##val round_big_int_to_float: big_int -> bool -> float diff --git a/src/batBig_int.ml b/src/batBig_int.mlv similarity index 89% rename from src/batBig_int.ml rename to src/batBig_int.mlv index cc2dc1eb4..f79742cf2 100644 --- a/src/batBig_int.ml +++ b/src/batBig_int.mlv @@ -20,11 +20,15 @@ *) let big_int_base_default_symbols = - let s = Bytes.create (10 + 26*2) in - let set off c k = Bytes.set s k (char_of_int (k - off + (int_of_char c))) in - for k = 0 to String.length s - 1 do - if k < 10 then set 0 '0' k else if k < 36 then set 10 'a' k else set 36 'A' k - done; s + let symbol offset base k = + char_of_int (k - offset + (int_of_char base)) in + BatBytesCompat.string_init (10 + 26*2) (fun k -> + if k < 10 + then symbol 0 '0' k + else if k < 36 + then symbol 10 'a' k + else symbol 36 'A' k + ) let to_string_in_custom_base @@ -64,7 +68,7 @@ let to_string_in_custom_base done; addchar symbols.[int_of_big_int !n]; if isnegative then addchar '-'; - String.sub buff (!curr + 1) !count + Bytes.sub_string buff (!curr + 1) !count let to_string_in_base b n = if b <= 1 || b > 36 then invalid_arg @@ -134,7 +138,7 @@ module BaseBig_int = struct let of_float f = try of_string (Printf.sprintf "%.0f" f) - with Failure _ -> invalid_arg "batBig_int.of_float" + with Failure _ -> invalid_arg "Big_int.of_float" (*$T of_float to_int (of_float 4.46) = 4 to_int (of_float 4.56) = 5 @@ -172,3 +176,10 @@ let print out t = BatIO.nwrite out (to_string t) ((of_int 3 --- of_int 1) /@ to_int |> List.of_enum) [3; 2; 1] *) (*$>*) + + +##V<4.5##let big_int_of_string_opt s = try Some (big_int_of_string s) with _ -> None +##V<4.5##let int_of_big_int_opt n = try Some (int_of_big_int n) with _ -> None +##V<4.5##let int32_of_big_int_opt n = try Some (int32_of_big_int n) with _ -> None +##V<4.5##let int64_of_big_int_opt n = try Some (int64_of_big_int n) with _ -> None +##V<4.5##let nativeint_of_big_int_opt n = try Some (nativeint_of_big_int n) with _ -> None diff --git a/src/batBigarray.mliv b/src/batBigarray.mliv index 8af3d5026..730ec2fcd 100644 --- a/src/batBigarray.mliv +++ b/src/batBigarray.mliv @@ -560,6 +560,63 @@ sig end +##V>=4.5##(** {6 Zero-dimensional arrays} *) +##V>=4.5## +##V>=4.5##(** Zero-dimensional arrays. The [Array0] structure provides operations +##V>=4.5## similar to those of {!Bigarray.Genarray}, but specialized to the case +##V>=4.5## of zero-dimensional arrays that only contain a single scalar value. +##V>=4.5## Statically knowing the number of dimensions of the array allows +##V>=4.5## faster operations, and more precise static type-checking. +##V>=4.5## @since 2.7.0 and OCaml 4.05.0 *) +##V>=4.5##module Array0 : sig +##V>=4.5## type ('a, 'b, 'c) t = ('a, 'b, 'c) Bigarray.Array0.t +##V>=4.5## (** The type of zero-dimensional big arrays whose elements have +##V>=4.5## OCaml type ['a], representation kind ['b], and memory layout ['c]. *) +##V>=4.5## +##V>=4.5## val create: ('a, 'b) kind -> 'c layout -> ('a, 'b, 'c) t +##V>=4.5## (** [Array0.create kind layout] returns a new bigarray of zero dimension. +##V>=4.5## [kind] and [layout] determine the array element kind and the array +##V>=4.5## layout as described for {!Genarray.create}. *) +##V>=4.5## +##V>=4.5## external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind" +##V>=4.5## (** Return the kind of the given big array. *) +##V>=4.5## +##V>=4.5## external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" +##V>=4.5## (** Return the layout of the given big array. *) +##V>=4.5## +##V>=4.6## val change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t +##V>=4.6## (** [Array0.change_layout a layout] returns a big array with the +##V>=4.6## specified [layout], sharing the data with [a]. No copying of elements +##V>=4.6## is involved: the new array and the original array share the same +##V>=4.6## storage space. +##V>=4.6## +##V>=4.6## @since 4.06.0 +##V>=4.6## *) +##V>=4.5## +##V>=4.5## val size_in_bytes : ('a, 'b, 'c) t -> int +##V>=4.5## (** [size_in_bytes a] is [a]'s {!kind_size_in_bytes}. *) +##V>=4.5## +##V>=4.5## val get: ('a, 'b, 'c) t -> 'a +##V>=4.5## (** [Array0.get a] returns the only element in [a]. *) +##V>=4.5## +##V>=4.5## val set: ('a, 'b, 'c) t -> 'a -> unit +##V>=4.5## (** [Array0.set a x v] stores the value [v] in [a]. *) +##V>=4.5## +##V>=4.5## external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit" +##V>=4.5## (** Copy the first big array to the second big array. +##V>=4.5## See {!Genarray.blit} for more details. *) +##V>=4.5## +##V>=4.5## external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill" +##V>=4.5## (** Fill the given big array with the given value. +##V>=4.5## See {!Genarray.fill} for more details. *) +##V>=4.5## +##V>=4.5## val of_value: ('a, 'b) kind -> 'c layout -> 'a -> ('a, 'b, 'c) t +##V>=4.5## (** Build a zero-dimensional big array initialized from the +##V>=4.5## given value. *) +##V>=4.5## +##V>=4.5##end + + (** {6 One-dimensional arrays} *) (** One-dimensional arrays. The [Array1] structure provides operations @@ -591,6 +648,15 @@ module Array1 : sig external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" (** Return the layout of the given big array. *) +##V>=4.6## val change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t +##V>=4.6## (** [Array1.change_layout a layout] returns a bigarray with the +##V>=4.6## specified [layout], sharing the data with [a] (and hence having +##V>=4.6## the same dimension as [a]). No copying of elements is involved: the +##V>=4.6## new array and the original array share the same storage space. +##V>=4.6## +##V>=4.6## @since 4.06.0 +##V>=4.6## *) + val size_in_bytes : ('a, 'b, 'c) t -> int (** [size_in_bytes a] is the number of elements in [a] multiplied by [a]'s {!kind_size_in_bytes}. @@ -618,6 +684,13 @@ module Array1 : sig (** Extract a sub-array of the given one-dimensional big array. See [Genarray.sub_left] for more details. *) +##V>=4.5## val slice: ('a, 'b, 'c) t -> int -> ('a, 'b, 'c) Array0.t +##V>=4.5## (** Extract a scalar (zero-dimensional slice) of the given one-dimensional +##V>=4.5## big array. The integer parameter is the index of the scalar to +##V>=4.5## extract. See {!Bigarray.Genarray.slice_left} and +##V>=4.5## {!Bigarray.Genarray.slice_right} for more details. +##V>=4.5## @since 2.7.0 and OCaml 4.05.0 *) + external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit" (** Copy the first big array to the second big array. @@ -728,6 +801,17 @@ sig external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" (** Return the layout of the given big array. *) +##V>=4.6## val change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t +##V>=4.6## (** [Array2.change_layout a layout] returns a bigarray with the +##V>=4.6## specified [layout], sharing the data with [a] (and hence having +##V>=4.6## the same dimensions as [a]). No copying of elements is involved: the +##V>=4.6## new array and the original array share the same storage space. +##V>=4.6## The dimensions are reversed, such that [get v [| a; b |]] in +##V>=4.6## C layout becomes [get v [| b+1; a+1 |]] in Fortran layout. +##V>=4.6## +##V>=4.6## @since 4.06.0 +##V>=4.6## *) + val size_in_bytes : ('a, 'b, 'c) t -> int (** [size_in_bytes a] is the number of elements in [a] multiplied by [a]'s {!kind_size_in_bytes}. @@ -879,6 +963,17 @@ sig external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout" (** Return the layout of the given big array. *) +##V>=4.6## val change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t +##V>=4.6## (** [Array3.change_layout a layout] returns a bigarray with the +##V>=4.6## specified [layout], sharing the data with [a] (and hence having +##V>=4.6## the same dimensions as [a]). No copying of elements is involved: the +##V>=4.6## new array and the original array share the same storage space. +##V>=4.6## The dimensions are reversed, such that [get v [| a; b; c |]] in +##V>=4.6## C layout becomes [get v [| c+1; b+1; a+1 |]] in Fortran layout. +##V>=4.6## +##V>=4.6## @since 4.06.0 +##V>=4.6## *) + val size_in_bytes : ('a, 'b, 'c) t -> int (** [size_in_bytes a] is the number of elements in [a] multiplied by [a]'s {!kind_size_in_bytes}. @@ -1017,6 +1112,11 @@ end (** {6 Coercions between generic big arrays and fixed-dimension big arrays} *) +##V>=4.5##external genarray_of_array0 : +##V>=4.5## ('a, 'b, 'c) Array0.t -> ('a, 'b, 'c) Genarray.t = "%identity" +##V>=4.5##(** Return the generic big array corresponding to the given zero-dimensional +##V>=4.5## big array. @since 2.7.0 and OCaml 4.05.0 *) + external genarray_of_array1 : ('a, 'b, 'c) Array1.t -> ('a, 'b, 'c) Genarray.t = "%identity" (** Return the generic big array corresponding to the given one-dimensional @@ -1032,6 +1132,12 @@ external genarray_of_array3 : (** Return the generic big array corresponding to the given three-dimensional big array. *) +##V>=4.5##val array0_of_genarray : ('a, 'b, 'c) Genarray.t -> ('a, 'b, 'c) Array0.t +##V>=4.5##(** Return the zero-dimensional big array corresponding to the given +##V>=4.5## generic big array. Raise [Invalid_argument] if the generic big array +##V>=4.5## does not have exactly zero dimension. +##V>=4.5## @since 2.7.0 and OCaml 4.05.0 *) + val array1_of_genarray : ('a, 'b, 'c) Genarray.t -> ('a, 'b, 'c) Array1.t (** Return the one-dimensional big array corresponding to the given generic big array. @raise Invalid_argument if the generic big array @@ -1066,6 +1172,11 @@ val reshape : ('a, 'b, 'c) Genarray.t -> int array -> ('a, 'b, 'c) Genarray.t of the dimensions of [b] must be equal to [i1 * ... * iN]. @raise Invalid_argument otherwise. *) +##V>=4.5##val reshape_0 : ('a, 'b, 'c) Genarray.t -> ('a, 'b, 'c) Array0.t +##V>=4.5##(** Specialized version of {!Bigarray.reshape} for reshaping to +##V>=4.5## zero-dimensional arrays. +##V>=4.5## @since 2.7.0 and OCaml 4.05.0 *) + val reshape_1 : ('a, 'b, 'c) Genarray.t -> int -> ('a, 'b, 'c) Array1.t (** Specialized version of {!Bigarray.reshape} for reshaping to one-dimensional arrays. *) diff --git a/src/batBigarray.mlv b/src/batBigarray.mlv index b0a18ac97..aae051b08 100644 --- a/src/batBigarray.mlv +++ b/src/batBigarray.mlv @@ -153,6 +153,8 @@ module Genarray = struct include Bigarray.Genarray +##V>=4.8##let map_file = Unix.map_file + let ofs e = ofs_of_layout (layout e) ##V<4.3## let size_in_bytes arr = @@ -284,6 +286,8 @@ struct end +##V>=4.5##external genarray_of_array0: ('a, 'b, 'c) Bigarray.Array0.t -> ('a, 'b, 'c) Genarray.t +##V>=4.5## = "%identity" external genarray_of_array1: ('a, 'b, 'c) Bigarray.Array1.t -> ('a, 'b, 'c) Genarray.t = "%identity" external genarray_of_array2: ('a, 'b, 'c) Bigarray.Array2.t -> ('a, 'b, 'c) Genarray.t @@ -298,14 +302,24 @@ external reshape: let reshape_3 = Bigarray.reshape_3 let reshape_2 = Bigarray.reshape_2 let reshape_1 = Bigarray.reshape_1 +##V>=4.5##let reshape_0 = Bigarray.reshape_0 let array3_of_genarray = Bigarray.array3_of_genarray let array2_of_genarray = Bigarray.array2_of_genarray let array1_of_genarray = Bigarray.array1_of_genarray +##V>=4.5##let array0_of_genarray = Bigarray.array0_of_genarray + +##V>=4.5##module Array0 = struct +##V>=4.5## include Bigarray.Array0 +##V>=4.5##end module Array1 = struct include Bigarray.Array1 +##V>=4.8##let map_file fd ?pos kind layout shared dim = +##V>=4.8## Bigarray.array1_of_genarray +##V>=4.8## (Unix.map_file fd ?pos kind layout shared [|dim|]) + let ofs e = ofs_of_layout (layout e) ##V<4.3## let size_in_bytes arr = @@ -363,6 +377,10 @@ end module Array2 = struct include Bigarray.Array2 +##V>=4.8##let map_file fd ?pos kind layout shared dim1 dim2 = +##V>=4.8## Bigarray.array2_of_genarray +##V>=4.8## (Unix.map_file fd ?pos kind layout shared [|dim1; dim2|]) + let ofs e = ofs_of_layout (layout e) ##V<4.3## let size_in_bytes arr = @@ -417,6 +435,10 @@ end module Array3 = struct include Bigarray.Array3 +##V>=4.8##let map_file fd ?pos kind layout shared dim1 dim2 dim3 = +##V>=4.8## Bigarray.array3_of_genarray +##V>=4.8## (Unix.map_file fd ?pos kind layout shared [|dim1; dim2; dim3|]) + let ofs e = ofs_of_layout (layout e) ##V<4.3## let size_in_bytes arr = diff --git a/src/batBitSet.ml b/src/batBitSet.ml index 89fb773b6..4a1346eda 100644 --- a/src/batBitSet.ml +++ b/src/batBitSet.ml @@ -37,17 +37,18 @@ let print_array = Array.init 256 print_bchar let print out t = - for i = 0 to (String.length !t) - 1 do + let buf = !t in + for i = 0 to (Bytes.length buf) - 1 do BatInnerIO.nwrite out - (Array.unsafe_get print_array (Char.code (Bytes.unsafe_get !t i))) + (Array.unsafe_get print_array (Char.code (Bytes.unsafe_get buf i))) done let capacity t = (Bytes.length !t) * 8 -let empty () = ref "" +let empty () = ref (Bytes.create 0) let create_ sfun c n = (* n is in bits *) - if n < 0 then invalid_arg ("BitSet."^sfun^": negative size"); + if n < 0 then invalid_arg ("BitSet." ^ sfun ^ ": negative size"); let size = n / 8 + (if n mod 8 = 0 then 0 else 1) in ref (Bytes.make size c) @@ -70,7 +71,7 @@ type bit_op = let rec apply_bit_op sfun op t x = let pos = x / 8 in if pos < 0 then - invalid_arg ("BitSet."^sfun^": negative index") + invalid_arg ("BitSet." ^ sfun ^ ": negative index") else if pos < Bytes.length !t then let delta = x mod 8 in let c = Char.code (Bytes.unsafe_get !t pos) in @@ -104,7 +105,7 @@ let toggle t x = apply_bit_op "toggle" Toggle t x let mem t x = let pos = x / 8 in if pos < 0 then - invalid_arg ("BitSet.mem: negative index") + invalid_arg "BitSet.mem: negative index" else if pos < Bytes.length !t then let delta = x mod 8 in let c = Char.code (Bytes.unsafe_get !t pos) in diff --git a/src/batBool.ml b/src/batBool.ml index ed0e7a03a..25c88ba20 100644 --- a/src/batBool.ml +++ b/src/batBool.ml @@ -46,16 +46,14 @@ module BaseBool = struct let add = ( || ) let mul = ( && ) let sub _ = not (*Weird extrapolation*) - (*BISECT-IGNORE-BEGIN*) let div _ _= - raise (Invalid_argument "Bool.div") + invalid_arg "Bool.div" let modulo _ _ = - raise (Invalid_argument "Bool.modulo") + invalid_arg "Bool.modulo" let pow _ _ = - raise (Invalid_argument "Bool.pow") - (*BISECT-IGNORE-END*) + invalid_arg "Bool.pow" let compare = compare @@ -76,7 +74,7 @@ module BaseBool = struct let of_string = function | "true" | "tt" | "1" -> true | "false"| "ff" | "0" -> false - | _ -> raise (Invalid_argument "Bool.of_string") + | _ -> invalid_arg "Bool.of_string" let to_string = string_of_bool end diff --git a/src/batBounded.mli b/src/batBounded.mli index b077064ad..3aeef855a 100644 --- a/src/batBounded.mli +++ b/src/batBounded.mli @@ -28,7 +28,7 @@ val bounding_of_ord_chain : high:('a -> 'b) -> ('a -> 'b) -> ('a -> 'a -> BatOrd.order) -> ('a, 'b) bounding_f -(** [bounding_oF_ord_chain ?low ?high ord] is like {!bounding_of_ord} except +(** [bounding_of_ord_chain ?low ?high ord] is like {!bounding_of_ord} except that functions are used to handle out of range values rather than single default values. *) @@ -99,7 +99,7 @@ module type S = sig back to type {!base_u}, otherwise returns [None]. *) val map2 : (base_u -> base_u -> base_u) -> t -> t -> t option - (** [map f x y] applies [f] to [x] and [y]. Returns [Some z] if [x] and [y] + (** [map2 f x y] applies [f] to [x] and [y]. Returns [Some z] if [x] and [y] can be converted back to type {!base_u}, otherwise returns [None]. *) val map_exn : (base_u -> base_u) -> t -> t @@ -107,7 +107,7 @@ module type S = sig back to type {!base_u}, otherwise raise an exception. *) val map2_exn : (base_u -> base_u -> base_u) -> t -> t -> t - (** [map f x y] applies [f] to [x] and [y]. Returns [z] if [x] and [y] + (** [map2_exn f x y] applies [f] to [x] and [y]. Returns [z] if [x] and [y] can be converted back to type {!base_u}, otherwise raise an exception. *) end diff --git a/src/batBuffer.mli b/src/batBuffer.mli deleted file mode 100644 index 5765e064a..000000000 --- a/src/batBuffer.mli +++ /dev/null @@ -1,166 +0,0 @@ -(* - * BatBuffer - Additional buffer operations - * Copyright (C) 1999 Pierre Weis, Xavier Leroy - * 2009 David Teller, LIFO, Universite d'Orleans - * 2009 Dawid Toton - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version, - * with the special exception on linking described in file LICENSE. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - *) - - -(** Extensible string buffers. - - This module implements string buffers that automatically expand - as necessary. It provides accumulative concatenation of strings - in quasi-linear time (instead of quadratic time when strings are - concatenated pairwise). - - @author Pierre Weis (Base module) - @author Xavier Leroy (Base module) - @author David Teller - @author Dawid Toton -*) - -type t = Buffer.t -(** The abstract type of buffers. *) - -val create : int -> t -(** [create n] returns a fresh buffer, initially empty. - The [n] parameter is the initial size of the internal string - that holds the buffer contents. That string is automatically - reallocated when more than [n] characters are stored in the buffer, - but shrinks back to [n] characters when [reset] is called. - For best performance, [n] should be of the same order of magnitude - as the number of characters that are expected to be stored in - the buffer (for instance, 80 for a buffer that holds one output - line). Nothing bad will happen if the buffer grows beyond that - limit, however. In doubt, take [n = 16] for instance. - If [n] is not between 1 and {!Sys.max_string_length}, it will - be clipped to that interval. *) - -val contents : t -> string -(** Return a copy of the current contents of the buffer. - The buffer itself is unchanged. *) - -val to_bytes : t -> Bytes.t -(** Return a copy of the current contents of the buffer. - The buffer itself is unchanged. - - @since 2.3.0 -*) - -val sub : t -> int -> int -> string -(** [Buffer.sub b off len] returns (a copy of) the substring of the - current contents of the buffer [b] starting at offset [off] of length - [len] bytes. May raise [Invalid_argument] if out of bounds request. The - buffer itself is unaffected. *) - -val blit : t -> int -> string -> int -> int -> unit -(** [Buffer.blit src srcoff dst dstoff len] copies [len] characters from - the current contents of the buffer [src], starting at offset [srcoff] - to string [dst], starting at character [dstoff]. - - @raise Invalid_argument if [srcoff] and [len] do not designate a valid - substring of [src], or if [dstoff] and [len] do not designate a valid - substring of [dst]. - @since 3.11.2 -*) - -val nth : t -> int -> char -(** get the n-th character of the buffer. @raise Invalid_argument if - index out of bounds *) - -val length : t -> int -(** Return the number of characters currently contained in the buffer. *) - -val clear : t -> unit -(** Empty the buffer. *) - -val reset : t -> unit -(** Empty the buffer and deallocate the internal string holding the - buffer contents, replacing it with the initial internal string - of length [n] that was allocated by {!Buffer.create} [n]. - For long-lived buffers that may have grown a lot, [reset] allows - faster reclamation of the space used by the buffer. *) - -val add_char : t -> char -> unit -(** [add_char b c] appends the character [c] at the end of the buffer [b]. *) - -val add_string : t -> string -> unit -(** [add_string b s] appends the string [s] at the end of the buffer [b]. *) - -val add_bytes : t -> Bytes.t -> unit -(** [add_string b s] appends the string [s] at the end of the buffer [b]. - - @since 2.3.0 -*) - -val add_substring : t -> string -> int -> int -> unit -(** [add_substring b s ofs len] takes [len] characters from offset - [ofs] in string [s] and appends them at the end of the buffer [b]. *) - -val add_subbytes : t -> Bytes.t -> int -> int -> unit -(** [add_substring b s ofs len] takes [len] characters from offset - [ofs] in byte sequence [s] and appends them at the end of the buffer [b]. - - @since 2.3.0 -*) - -val add_substitute : t -> (string -> string) -> string -> unit -(** [add_substitute b f s] appends the string pattern [s] at the end - of the buffer [b] with substitution. - The substitution process looks for variables into - the pattern and substitutes each variable name by its value, as - obtained by applying the mapping [f] to the variable name. Inside the - string pattern, a variable name immediately follows a non-escaped - [$] character and is one of the following: - - a non empty sequence of alphanumeric or [_] characters, - - an arbitrary sequence of characters enclosed by a pair of - matching parentheses or curly brackets. - An escaped [$] character is a [$] that immediately follows a backslash - character; it then stands for a plain [$]. - @raise Not_found if the closing character of a parenthesized variable - cannot be found. *) - -val add_buffer : t -> t -> unit -(** [add_buffer b1 b2] appends the current contents of buffer [b2] - at the end of buffer [b1]. [b2] is not modified. *) - -val add_input : t -> BatInnerIO.input -> int -> unit -(** [add_input b ic n] reads exactly [n] character from the input [ic] - and stores them at the end of buffer [b]. @raise End_of_file if - the channel contains fewer than [n] characters. *) - -val add_channel : t -> BatInnerIO.input -> int -> unit -(** @obsolete replaced by {!add_input}*) - -val output_buffer : t -> string BatInnerIO.output -(** [output_buffer b] creates an output channel that writes to that - buffer, and when closed, returns the contents of the buffer. *) - - -(** {6 Boilerplate code}*) - -val enum : t -> char BatEnum.t -(** Returns an enumeration of the characters of a buffer. - - Contents of the enumeration is unspecified if the buffer is modified after - the enumeration is returned.*) - -val of_enum : char BatEnum.t -> t -(** Creates a buffer from a character enumeration. *) - -val print: 'a BatInnerIO.output -> t -> unit diff --git a/src/batBuffer.mliv b/src/batBuffer.mliv new file mode 100644 index 000000000..2378e4f4b --- /dev/null +++ b/src/batBuffer.mliv @@ -0,0 +1,316 @@ +(* + * BatBuffer - Additional buffer operations + * Copyright (C) 1999 Pierre Weis, Xavier Leroy + * 2009 David Teller, LIFO, Universite d'Orleans + * 2009 Dawid Toton + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version, + * with the special exception on linking described in file LICENSE. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + *) + + +(** Extensible string buffers. + + This module implements string buffers that automatically expand + as necessary. It provides accumulative concatenation of strings + in quasi-linear time (instead of quadratic time when strings are + concatenated pairwise). + + @author Pierre Weis (Base module) + @author Xavier Leroy (Base module) + @author David Teller + @author Dawid Toton +*) + +type t = Buffer.t +(** The abstract type of buffers. *) + +val create : int -> t +(** [create n] returns a fresh buffer, initially empty. + The [n] parameter is the initial size of the internal string + that holds the buffer contents. That string is automatically + reallocated when more than [n] characters are stored in the buffer, + but shrinks back to [n] characters when [reset] is called. + For best performance, [n] should be of the same order of magnitude + as the number of characters that are expected to be stored in + the buffer (for instance, 80 for a buffer that holds one output + line). Nothing bad will happen if the buffer grows beyond that + limit, however. In doubt, take [n = 16] for instance. + If [n] is not between 1 and {!Sys.max_string_length}, it will + be clipped to that interval. *) + +val contents : t -> string +(** Return a copy of the current contents of the buffer. + The buffer itself is unchanged. *) + +val to_bytes : t -> Bytes.t +(** Return a copy of the current contents of the buffer. + The buffer itself is unchanged. + + @since 2.3.0 +*) + +val sub : t -> int -> int -> string +(** [Buffer.sub b off len] returns a copy of [len] bytes from the + current contents of the buffer [b], starting at offset [off]. + + Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid + range of [b]. *) + +val blit : t -> int -> Bytes.t -> int -> int -> unit +(** [Buffer.blit src srcoff dst dstoff len] copies [len] characters from + the current contents of the buffer [src], starting at offset [srcoff] + to string [dst], starting at character [dstoff]. + + @raise Invalid_argument if [srcoff] and [len] do not designate a valid + substring of [src], or if [dstoff] and [len] do not designate a valid + substring of [dst]. + @since 3.11.2 +*) + +val nth : t -> int -> char +(** get the n-th character of the buffer. @raise Invalid_argument if + index out of bounds *) + +val length : t -> int +(** Return the number of characters currently contained in the buffer. *) + +val clear : t -> unit +(** Empty the buffer. *) + +val reset : t -> unit +(** Empty the buffer and deallocate the internal string holding the + buffer contents, replacing it with the initial internal string + of length [n] that was allocated by {!Buffer.create} [n]. + For long-lived buffers that may have grown a lot, [reset] allows + faster reclamation of the space used by the buffer. *) + +val add_char : t -> char -> unit +(** [add_char b c] appends the character [c] at the end of the buffer [b]. *) + +val add_string : t -> string -> unit +(** [add_string b s] appends the string [s] at the end of the buffer [b]. *) + +val add_bytes : t -> Bytes.t -> unit +(** [add_bytes b s] appends the string [s] at the end of the buffer [b]. + + @since 2.3.0 +*) + +val add_substring : t -> string -> int -> int -> unit +(** [add_substring b s ofs len] takes [len] characters from offset + [ofs] in string [s] and appends them at the end of the buffer [b]. *) + +val add_subbytes : t -> Bytes.t -> int -> int -> unit +(** [add_subbytes b s ofs len] takes [len] characters from offset + [ofs] in byte sequence [s] and appends them at the end of the buffer [b]. + + @since 2.3.0 +*) + +val add_substitute : t -> (string -> string) -> string -> unit +(** [add_substitute b f s] appends the string pattern [s] at the end + of the buffer [b] with substitution. + The substitution process looks for variables into + the pattern and substitutes each variable name by its value, as + obtained by applying the mapping [f] to the variable name. Inside the + string pattern, a variable name immediately follows a non-escaped + [$] character and is one of the following: + - a non empty sequence of alphanumeric or [_] characters, + - an arbitrary sequence of characters enclosed by a pair of + matching parentheses or curly brackets. + An escaped [$] character is a [$] that immediately follows a backslash + character; it then stands for a plain [$]. + @raise Not_found if the closing character of a parenthesized variable + cannot be found. *) + +val add_buffer : t -> t -> unit +(** [add_buffer b1 b2] appends the current contents of buffer [b2] + at the end of buffer [b1]. [b2] is not modified. *) + +val add_input : t -> BatInnerIO.input -> int -> unit +(** [add_input b ic n] reads exactly [n] character from the input [ic] + and stores them at the end of buffer [b]. @raise End_of_file if + the channel contains fewer than [n] characters. *) + +val add_channel : t -> BatInnerIO.input -> int -> unit +(** @obsolete replaced by {!add_input}*) + +val output_buffer : t -> string BatInnerIO.output +(** [output_buffer b] creates an output channel that writes to that + buffer, and when closed, returns the contents of the buffer. *) + +##V>=4.5##val truncate : t -> int -> unit +##V>=4.5##(** [truncate b len] truncates the length of [b] to [len] +##V>=4.5## Note: the internal byte sequence is not shortened. +##V>=4.5## Raises [Invalid_argument] if [len < 0] or [len > length b]. +##V>=4.5## @since 2.7.0 and OCaml 4.05.0 *) + +##V>=4.6##val add_utf_8_uchar : t -> Uchar.t -> unit +##V>=4.6##(** [add_utf_8_uchar b u] appends the {{:https://tools.ietf.org/html/rfc3629} +##V>=4.6## UTF-8} encoding of [u] at the end of buffer [b]. +##V>=4.6## +##V>=4.6## @since 2.8.0 and OCaml 4.06.0 *) + +##V>=4.6##val add_utf_16le_uchar : t -> Uchar.t -> unit +##V>=4.6##(** [add_utf_16le_uchar b u] appends the +##V>=4.6## {{:https://tools.ietf.org/html/rfc2781}UTF-16LE} encoding of [u] +##V>=4.6## at the end of buffer [b]. +##V>=4.6## +##V>=4.6## @since 2.8.0 and OCaml 4.06.0 *) + +##V>=4.6##val add_utf_16be_uchar : t -> Uchar.t -> unit +##V>=4.6##(** [add_utf_16be_uchar b u] appends the +##V>=4.6## {{:https://tools.ietf.org/html/rfc2781}UTF-16BE} encoding of [u] +##V>=4.6## at the end of buffer [b]. +##V>=4.6## +##V>=4.6## @since 2.8.0 and OCaml 4.06.0 *) + +(** {6 Boilerplate code}*) + +val enum : t -> char BatEnum.t +(** Returns an enumeration of the characters of a buffer. + + Contents of the enumeration is unspecified if the buffer is modified after + the enumeration is returned.*) + +val of_enum : char BatEnum.t -> t +(** Creates a buffer from a character enumeration. *) + +val print: 'a BatInnerIO.output -> t -> unit + +##V>=4.07##(** {1 Iterators} *) +##V>=4.07## +##V>=4.07##val to_seq : t -> char Seq.t +##V>=4.07##(** Iterate on the buffer, in increasing order. +##V>=4.07## Modification of the buffer during iteration is undefined behavior. +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) + +##V>=4.07##val to_seqi : t -> (int * char) Seq.t +##V>=4.07##(** Iterate on the buffer, in increasing order, yielding indices along chars. +##V>=4.07## Modification of the buffer during iteration is undefined behavior. +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) + +##V>=4.07##val add_seq : t -> char Seq.t -> unit +##V>=4.07##(** Add chars to the buffer +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) + +##V>=4.07##val of_seq : char Seq.t -> t +##V>=4.07##(** Create a buffer from the generator +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) + +##V>=4.08##(** {1 Binary encoding of integers} *) +##V>=4.08## +##V>=4.08##(** The functions in this section append binary encodings of integers +##V>=4.08## to buffers. +##V>=4.08## +##V>=4.08## Little-endian (resp. big-endian) encoding means that least +##V>=4.08## (resp. most) significant bytes are stored first. Big-endian is +##V>=4.08## also known as network byte order. Native-endian encoding is +##V>=4.08## either little-endian or big-endian depending on {!Sys.big_endian}. +##V>=4.08## +##V>=4.08## 32-bit and 64-bit integers are represented by the [int32] and +##V>=4.08## [int64] types, which can be interpreted either as signed or +##V>=4.08## unsigned numbers. +##V>=4.08## +##V>=4.08## 8-bit and 16-bit integers are represented by the [int] type, +##V>=4.08## which has more bits than the binary encoding. Functions that +##V>=4.08## encode these values truncate their inputs to their least +##V>=4.08## significant bytes. +##V>=4.08##*) + +##V>=4.08##val add_uint8 : t -> int -> unit +##V>=4.08##(** [add_uint8 b i] appends a binary unsigned 8-bit integer [i] to +##V>=4.08## [b]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val add_int8 : t -> int -> unit +##V>=4.08##(** [add_int8 b i] appends a binary signed 8-bit integer [i] to +##V>=4.08## [b]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val add_uint16_ne : t -> int -> unit +##V>=4.08##(** [add_uint16_ne b i] appends a binary native-endian unsigned 16-bit +##V>=4.08## integer [i] to [b]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val add_uint16_be : t -> int -> unit +##V>=4.08##(** [add_uint16_be b i] appends a binary big-endian unsigned 16-bit +##V>=4.08## integer [i] to [b]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val add_uint16_le : t -> int -> unit +##V>=4.08##(** [add_uint16_le b i] appends a binary little-endian unsigned 16-bit +##V>=4.08## integer [i] to [b]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val add_int16_ne : t -> int -> unit +##V>=4.08##(** [add_int16_ne b i] appends a binary native-endian signed 16-bit +##V>=4.08## integer [i] to [b]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val add_int16_be : t -> int -> unit +##V>=4.08##(** [add_int16_be b i] appends a binary big-endian signed 16-bit +##V>=4.08## integer [i] to [b]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val add_int16_le : t -> int -> unit +##V>=4.08##(** [add_int16_le b i] appends a binary little-endian signed 16-bit +##V>=4.08## integer [i] to [b]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val add_int32_ne : t -> int32 -> unit +##V>=4.08##(** [add_int32_ne b i] appends a binary native-endian 32-bit integer +##V>=4.08## [i] to [b]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val add_int32_be : t -> int32 -> unit +##V>=4.08##(** [add_int32_be b i] appends a binary big-endian 32-bit integer +##V>=4.08## [i] to [b]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val add_int32_le : t -> int32 -> unit +##V>=4.08##(** [add_int32_le b i] appends a binary little-endian 32-bit integer +##V>=4.08## [i] to [b]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val add_int64_ne : t -> int64 -> unit +##V>=4.08##(** [add_int64_ne b i] appends a binary native-endian 64-bit integer +##V>=4.08## [i] to [b]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val add_int64_be : t -> int64 -> unit +##V>=4.08##(** [add_int64_be b i] appends a binary big-endian 64-bit integer +##V>=4.08## [i] to [b]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val add_int64_le : t -> int64 -> unit +##V>=4.08##(** [add_int64_ne b i] appends a binary little-endian 64-bit integer +##V>=4.08## [i] to [b]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) diff --git a/src/batBuffer.mlv b/src/batBuffer.mlv index db25e6f96..635095b1a 100644 --- a/src/batBuffer.mlv +++ b/src/batBuffer.mlv @@ -72,10 +72,16 @@ let add_input t inp n = (Q.string) (fun s -> let b = create 10 in add_input b (BatIO.input_string s) (String.length s); contents b = s) *) +let add_channel = add_input + +##V<4.2##let add_bytes = add_string +##V<4.2##let add_subbytes = add_substring +##V<4.2##let to_bytes = contents + let output_buffer buf = BatInnerIO.create_out ~write: (add_char buf) - ~output:(fun s p l -> add_substring buf s p l; l) + ~output:(fun s p l -> add_subbytes buf s p l; l) ~close: (fun () -> contents buf) ~flush: BatInnerIO.noop @@ -83,8 +89,22 @@ let output_buffer buf = (Q.string) (fun s -> let b = create 10 in let oc = output_buffer b in IO.nwrite oc s; IO.close_out oc = s) *) -let add_channel = add_input - -##V<4.2##let add_bytes = add_string -##V<4.2##let add_subbytes = add_substring -##V<4.2##let to_bytes = contents +##V>=4.07##let to_seq = to_seq +##V>=4.07##let to_seqi = to_seqi +##V>=4.07##let add_seq = add_seq +##V>=4.07##let of_seq = of_seq + +##V>=4.08##let add_uint8 = add_uint8 +##V>=4.08##let add_int8 = add_int8 +##V>=4.08##let add_uint16_ne = add_uint16_ne +##V>=4.08##let add_uint16_be = add_uint16_be +##V>=4.08##let add_uint16_le = add_uint16_le +##V>=4.08##let add_int16_ne = add_int16_ne +##V>=4.08##let add_int16_be = add_int16_be +##V>=4.08##let add_int16_le = add_int16_le +##V>=4.08##let add_int32_ne = add_int32_ne +##V>=4.08##let add_int32_be = add_int32_be +##V>=4.08##let add_int32_le = add_int32_le +##V>=4.08##let add_int64_ne = add_int64_ne +##V>=4.08##let add_int64_be = add_int64_be +##V>=4.08##let add_int64_le = add_int64_le diff --git a/src/batBytes.mliv b/src/batBytes.mliv index f3dbfa5ad..386a7b72f 100644 --- a/src/batBytes.mliv +++ b/src/batBytes.mliv @@ -136,7 +136,7 @@ val blit : t -> int -> t -> int -> int -> unit do not designate a valid range of [dst]. *) val blit_string : string -> int -> t -> int -> int -> unit -(** [blit src srcoff dst dstoff len] copies [len] bytes from string +(** [blit_string src srcoff dst dstoff len] copies [len] bytes from string [src], starting at index [srcoff], to byte sequence [dst], starting at index [dstoff]. @@ -197,12 +197,22 @@ val index : t -> char -> int Raise [Not_found] if [c] does not occur in [s]. *) +val index_opt: t -> char -> int option +(** [index_opt s c] returns the index of the first occurrence of byte [c] + in [s] or [None] if [c] does not occur in [s]. + @since 2.7.0 *) + val rindex : t -> char -> int (** [rindex s c] returns the index of the last occurrence of byte [c] in [s]. Raise [Not_found] if [c] does not occur in [s]. *) +val rindex_opt: t -> char -> int option +(** [rindex_opt s c] returns the index of the last occurrence of byte [c] + in [s] or [None] if [c] does not occur in [s]. + @since 2.7.0 *) + val index_from : t -> int -> char -> int (** [index_from s i c] returns the index of the first occurrence of byte [c] in [s] after position [i]. [Bytes.index s c] is @@ -211,6 +221,14 @@ val index_from : t -> int -> char -> int Raise [Invalid_argument] if [i] is not a valid position in [s]. Raise [Not_found] if [c] does not occur in [s] after position [i]. *) +val index_from_opt: t -> int -> char -> int option +(** [index_from _opts i c] returns the index of the first occurrence of + byte [c] in [s] after position [i] or [None] if [c] does not occur in [s] after position [i]. + [Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c]. + + Raise [Invalid_argument] if [i] is not a valid position in [s]. + @since 2.7.0 *) + val rindex_from : t -> int -> char -> int (** [rindex_from s i c] returns the index of the last occurrence of byte [c] in [s] before position [i+1]. [rindex s c] is equivalent @@ -219,6 +237,15 @@ val rindex_from : t -> int -> char -> int Raise [Invalid_argument] if [i+1] is not a valid position in [s]. Raise [Not_found] if [c] does not occur in [s] before position [i+1]. *) +val rindex_from_opt: t -> int -> char -> int option +(** [rindex_from_opt s i c] returns the index of the last occurrence + of byte [c] in [s] before position [i+1] or [None] if [c] does not + occur in [s] before position [i+1]. [rindex_opt s c] is equivalent to + [rindex_from s (Bytes.length s - 1) c]. + + Raise [Invalid_argument] if [i+1] is not a valid position in [s]. + @since 2.7.0 *) + val contains : t -> char -> bool (** [contains s c] tests if byte [c] appears in [s]. *) @@ -414,6 +441,216 @@ let s = Bytes.of_string "hello" [string] type for this purpose. *) +##V>=4.07##(** {1 Iterators} *) +##V>=4.07## +##V>=4.07##val to_seq : t -> char Seq.t +##V>=4.07##(** Iterate on the string, in increasing index order. Modifications of the +##V>=4.07## string during iteration will be reflected in the iterator. +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) + +##V>=4.07##val to_seqi : t -> (int * char) Seq.t +##V>=4.07##(** Iterate on the string, in increasing order, yielding indices along chars +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) + +##V>=4.07##val of_seq : char Seq.t -> t +##V>=4.07##(** Create a string from the generator +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) + +##V>=4.08##(** {1 Binary encoding/decoding of integers} *) +##V>=4.08## +##V>=4.08##(** The functions in this section binary encode and decode integers to +##V>=4.08## and from byte sequences. +##V>=4.08## +##V>=4.08## All following functions raise [Invalid_argument] if the space +##V>=4.08## needed at index [i] to decode or encode the integer is not +##V>=4.08## available. +##V>=4.08## +##V>=4.08## Little-endian (resp. big-endian) encoding means that least +##V>=4.08## (resp. most) significant bytes are stored first. Big-endian is +##V>=4.08## also known as network byte order. Native-endian encoding is +##V>=4.08## either little-endian or big-endian depending on {!Sys.big_endian}. +##V>=4.08## +##V>=4.08## 32-bit and 64-bit integers are represented by the [int32] and +##V>=4.08## [int64] types, which can be interpreted either as signed or +##V>=4.08## unsigned numbers. +##V>=4.08## +##V>=4.08## 8-bit and 16-bit integers are represented by the [int] type, +##V>=4.08## which has more bits than the binary encoding. These extra bits +##V>=4.08## are handled as follows: {ul +##V>=4.08## {- Functions that decode signed (resp. unsigned) 8-bit or 16-bit +##V>=4.08## integers represented by [int] values sign-extend +##V>=4.08## (resp. zero-extend) their result.} +##V>=4.08## {- Functions that encode 8-bit or 16-bit integers represented by +##V>=4.08## [int] values truncate their input to their least significant +##V>=4.08## bytes.}} +##V>=4.08##*) + +##V>=4.08##val get_uint8 : bytes -> int -> int +##V>=4.08##(** [get_uint8 b i] is [b]'s unsigned 8-bit integer starting at byte index [i]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val get_int8 : bytes -> int -> int +##V>=4.08##(** [get_int8 b i] is [b]'s signed 8-bit integer starting at byte index [i]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val get_uint16_ne : bytes -> int -> int +##V>=4.08##(** [get_uint16_ne b i] is [b]'s native-endian unsigned 16-bit integer +##V>=4.08## starting at byte index [i]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val get_uint16_be : bytes -> int -> int +##V>=4.08##(** [get_uint16_be b i] is [b]'s big-endian unsigned 16-bit integer +##V>=4.08## starting at byte index [i]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val get_uint16_le : bytes -> int -> int +##V>=4.08##(** [get_uint16_le b i] is [b]'s little-endian unsigned 16-bit integer +##V>=4.08## starting at byte index [i]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val get_int16_ne : bytes -> int -> int +##V>=4.08##(** [get_int16_ne b i] is [b]'s native-endian signed 16-bit integer +##V>=4.08## starting at byte index [i]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val get_int16_be : bytes -> int -> int +##V>=4.08##(** [get_int16_be b i] is [b]'s big-endian signed 16-bit integer +##V>=4.08## starting at byte index [i]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val get_int16_le : bytes -> int -> int +##V>=4.08##(** [get_int16_le b i] is [b]'s little-endian signed 16-bit integer +##V>=4.08## starting at byte index [i]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val get_int32_ne : bytes -> int -> int32 +##V>=4.08##(** [get_int32_ne b i] is [b]'s native-endian 32-bit integer +##V>=4.08## starting at byte index [i]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val get_int32_be : bytes -> int -> int32 +##V>=4.08##(** [get_int32_be b i] is [b]'s big-endian 32-bit integer +##V>=4.08## starting at byte index [i]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val get_int32_le : bytes -> int -> int32 +##V>=4.08##(** [get_int32_le b i] is [b]'s little-endian 32-bit integer +##V>=4.08## starting at byte index [i]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val get_int64_ne : bytes -> int -> int64 +##V>=4.08##(** [get_int64_ne b i] is [b]'s native-endian 64-bit integer +##V>=4.08## starting at byte index [i]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val get_int64_be : bytes -> int -> int64 +##V>=4.08##(** [get_int64_be b i] is [b]'s big-endian 64-bit integer +##V>=4.08## starting at byte index [i]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val get_int64_le : bytes -> int -> int64 +##V>=4.08##(** [get_int64_le b i] is [b]'s little-endian 64-bit integer +##V>=4.08## starting at byte index [i]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val set_uint8 : bytes -> int -> int -> unit +##V>=4.08##(** [set_uint8 b i v] sets [b]'s unsigned 8-bit integer starting at byte index +##V>=4.08## [i] to [v]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val set_int8 : bytes -> int -> int -> unit +##V>=4.08##(** [set_int8 b i v] sets [b]'s signed 8-bit integer starting at byte index +##V>=4.08## [i] to [v]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val set_uint16_ne : bytes -> int -> int -> unit +##V>=4.08##(** [set_uint16_ne b i v] sets [b]'s native-endian unsigned 16-bit integer +##V>=4.08## starting at byte index [i] to [v]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val set_uint16_be : bytes -> int -> int -> unit +##V>=4.08##(** [set_uint16_be b i v] sets [b]'s big-endian unsigned 16-bit integer +##V>=4.08## starting at byte index [i] to [v]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val set_uint16_le : bytes -> int -> int -> unit +##V>=4.08##(** [set_uint16_le b i v] sets [b]'s little-endian unsigned 16-bit integer +##V>=4.08## starting at byte index [i] to [v]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val set_int16_ne : bytes -> int -> int -> unit +##V>=4.08##(** [set_int16_ne b i v] sets [b]'s native-endian signed 16-bit integer +##V>=4.08## starting at byte index [i] to [v]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val set_int16_be : bytes -> int -> int -> unit +##V>=4.08##(** [set_int16_be b i v] sets [b]'s big-endian signed 16-bit integer +##V>=4.08## starting at byte index [i] to [v]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val set_int16_le : bytes -> int -> int -> unit +##V>=4.08##(** [set_int16_le b i v] sets [b]'s little-endian signed 16-bit integer +##V>=4.08## starting at byte index [i] to [v]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val set_int32_ne : bytes -> int -> int32 -> unit +##V>=4.08##(** [set_int32_ne b i v] sets [b]'s native-endian 32-bit integer +##V>=4.08## starting at byte index [i] to [v]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val set_int32_be : bytes -> int -> int32 -> unit +##V>=4.08##(** [set_int32_be b i v] sets [b]'s big-endian 32-bit integer +##V>=4.08## starting at byte index [i] to [v]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val set_int32_le : bytes -> int -> int32 -> unit +##V>=4.08##(** [set_int32_le b i v] sets [b]'s little-endian 32-bit integer +##V>=4.08## starting at byte index [i] to [v]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val set_int64_ne : bytes -> int -> int64 -> unit +##V>=4.08##(** [set_int64_ne b i v] sets [b]'s native-endian 64-bit integer +##V>=4.08## starting at byte index [i] to [v]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val set_int64_be : bytes -> int -> int64 -> unit +##V>=4.08##(** [set_int64_be b i v] sets [b]'s big-endian 64-bit integer +##V>=4.08## starting at byte index [i] to [v]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + +##V>=4.08##val set_int64_le : bytes -> int -> int64 -> unit +##V>=4.08##(** [set_int64_le b i v] sets [b]'s little-endian 64-bit integer +##V>=4.08## starting at byte index [i] to [v]. +##V>=4.08## @since 2.10.0 and OCaml 4.08 +##V>=4.08##*) + (**/**) (* The following is for system use only. Do not call directly. *) diff --git a/src/batBytes.mlv b/src/batBytes.mlv index 832731549..901a79111 100644 --- a/src/batBytes.mlv +++ b/src/batBytes.mlv @@ -47,13 +47,13 @@ include Bytes ##V<4.3##let lowercase_ascii s = map BatChar.lowercase_ascii s (*$T uppercase_ascii - equal ("five" |> of_string |> capitalize_ascii |> to_string) "FIVE" - equal ("école" |> of_string |> captialize_ascii |> to_string) "éCOLE" + String.equal ("five" |> of_string |> uppercase_ascii |> to_string) "FIVE" + String.equal ("école" |> of_string |> uppercase_ascii |> to_string) "éCOLE" *) (*$T lowercase_ascii - equal ("FIVE" |> of_string |> capitalize_ascii |> to_string) "five" - equal ("ÉCOLE" |> of_string |> captialize_ascii |> to_string) "École" + String.equal ("FIVE" |> of_string |> lowercase_ascii |> to_string) "five" + String.equal ("ÉCOLE" |> of_string |> lowercase_ascii |> to_string) "École" *) ##V<4.3##let map_first_char f s = @@ -66,11 +66,50 @@ include Bytes ##V<4.3##let uncapitalize_ascii s = map_first_char BatChar.lowercase_ascii s (*$T capitalize_ascii - equal ("five" |> of_string |> capitalize_ascii |> to_string) "Five" - equal ("école" |> of_string |> captialize_ascii |> to_string) "école" + String.equal ("five" |> of_string |> capitalize_ascii |> to_string) "Five" + String.equal ("école" |> of_string |> capitalize_ascii |> to_string) "école" *) (*$T uncapitalize_ascii - equal ("Five" |> of_string |> capitalize_ascii |> to_string) "Five" - equal ("école" |> of_string |> captialize_ascii |> to_string) "école" + String.equal ("Five" |> of_string |> uncapitalize_ascii |> to_string) "five" + String.equal ("École" |> of_string |> uncapitalize_ascii |> to_string) "École" *) + + +##V<4.5##let index_opt b c = try Some (index b c) with _ -> None +##V<4.5##let rindex_opt b c = try Some (rindex b c) with _ -> None +##V<4.5##let index_from_opt b i c = try Some (index_from b i c) with _ -> None +##V<4.5##let rindex_from_opt b i c = try Some (rindex_from b i c) with _ -> None + +##V>=4.07##let to_seq = to_seq +##V>=4.07##let to_seqi = to_seqi +##V>=4.07##let of_seq = of_seq + +##V>=4.08##let get_uint8 = get_uint8 +##V>=4.08##let get_int8 = get_int8 +##V>=4.08##let get_uint16_ne = get_uint16_ne +##V>=4.08##let get_uint16_be = get_uint16_be +##V>=4.08##let get_uint16_le = get_uint16_le +##V>=4.08##let get_int16_ne = get_int16_ne +##V>=4.08##let get_int16_be = get_int16_be +##V>=4.08##let get_int16_le = get_int16_le +##V>=4.08##let get_int32_ne = get_int32_ne +##V>=4.08##let get_int32_be = get_int32_be +##V>=4.08##let get_int32_le = get_int32_le +##V>=4.08##let get_int64_ne = get_int64_ne +##V>=4.08##let get_int64_be = get_int64_be +##V>=4.08##let get_int64_le = get_int64_le +##V>=4.08##let set_uint8 = set_uint8 +##V>=4.08##let set_int8 = set_int8 +##V>=4.08##let set_uint16_ne = set_uint16_ne +##V>=4.08##let set_uint16_be = set_uint16_be +##V>=4.08##let set_uint16_le = set_uint16_le +##V>=4.08##let set_int16_ne = set_int16_ne +##V>=4.08##let set_int16_be = set_int16_be +##V>=4.08##let set_int16_le = set_int16_le +##V>=4.08##let set_int32_ne = set_int32_ne +##V>=4.08##let set_int32_be = set_int32_be +##V>=4.08##let set_int32_le = set_int32_le +##V>=4.08##let set_int64_ne = set_int64_ne +##V>=4.08##let set_int64_be = set_int64_be +##V>=4.08##let set_int64_le = set_int64_le diff --git a/src/batBytesCompat.mlv b/src/batBytesCompat.mlv new file mode 100644 index 000000000..85db5f8e2 --- /dev/null +++ b/src/batBytesCompat.mlv @@ -0,0 +1,26 @@ +(* This compatible module contains compatibility versions of stdlib + functions that are commonly used when porting code to the + (string / bytes) separation, but are not available in older OCaml + versions that Batteries support. + + We could push each function in the corresponding Batteries module + (Buffer.add_subbtypes into BatBuffer, etc.), but this would have + the effect of turning dependencies on the stdlib into + inter-Batteries-module dependencies: any module using + Buffer.add_subbtypes would then depend on the whole BatBuffer, + increasing binary sizes and risk of cycles. +*) + +##V>=4.2##let string_init = String.init +##V<4.2##let string_init len f = +##V<4.2## let s = Bytes.create len in +##V<4.2## for i = 0 to len - 1 do +##V<4.2## Bytes.unsafe_set s i (f i) +##V<4.2## done; +##V<4.2## Bytes.unsafe_to_string s + +##V>=4.2##let buffer_add_subbytes = Buffer.add_subbytes +##V<4.2##let buffer_add_subbytes = Buffer.add_substring + +##V>=4.2##let buffer_to_bytes = Buffer.to_bytes +##V<4.2##let buffer_to_bytes = Buffer.contents diff --git a/src/batChar.mlv b/src/batChar.mlv index 9e523d4bd..44a2a550a 100644 --- a/src/batChar.mlv +++ b/src/batChar.mlv @@ -19,7 +19,6 @@ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) -(*BISECT-IGNORE-BEGIN*) include Char ##V<4.3##let lowercase_ascii = function @@ -78,7 +77,6 @@ let is_letter c = external unsafe_int : char-> int = "%identity" external unsafe_chr : int -> char = "%identity" -(*BISECT-IGNORE-END*) let of_digit i = if i >= 0 && i < 10 then @@ -103,10 +101,8 @@ let ( -- ) from last = let e = Char.chr 12 -- Char.chr 52 in for i = 12 to 52 do assert (Char.chr i = BatEnum.get_exn e) done; BatEnum.is_empty e *) -(*BISECT-IGNORE-BEGIN*) let range ?until:(last = unsafe_chr 255) from = from -- last -(*BISECT-IGNORE-END*) module Infix = struct let (--) = (--) @@ -118,14 +114,12 @@ let print out t = BatInnerIO.write out t BatIO.to_string print '\n' = "\n" *) -(*BISECT-IGNORE-BEGIN*) let ord (x:char) y = if x > y then BatOrd.Gt else if y > x then BatOrd.Lt else BatOrd.Eq let equal (x:char) y = x == y (* safe because int-like value *) let hash = code -(*BISECT-IGNORE-END*) module Incubator = struct module Comp = struct diff --git a/src/batComplex.ml b/src/batComplex.ml index 57563be1d..b446f5f73 100644 --- a/src/batComplex.ml +++ b/src/batComplex.ml @@ -23,7 +23,7 @@ module BaseComplex = struct include Complex let modulo _ _ = - failwith "BatComplex.modulo is meaningless" (*BISECT-VISIT*) + failwith "BatComplex.modulo is meaningless" let to_string x = ( string_of_float x.re ) ^ " + i " ^ ( string_of_float x.im ) diff --git a/src/batConcreteQueue_403.ml b/src/batConcreteQueue_403.ml index 9eebc8b36..479297b9b 100644 --- a/src/batConcreteQueue_403.ml +++ b/src/batConcreteQueue_403.ml @@ -31,7 +31,7 @@ let filter_inplace f queue = loop (length + 1) cons next in let first = find_next queue.first in - (* returning a pair is unecessary, the writes could be made at the + (* returning a pair is unnecessary, the writes could be made at the end of 'loop', but the present style makes it obvious that all three writes are performed atomically, without allocation, function call or return (yield points) in between, guaranteeing diff --git a/src/batDeque.mli b/src/batDeque.mli index 077f5cf49..d63dd96f2 100644 --- a/src/batDeque.mli +++ b/src/batDeque.mli @@ -68,7 +68,7 @@ val rev : 'a dq -> 'a dq (** [rev dq] reverses [dq]. O(1) *) val is_empty : 'a dq -> bool -(** [is_empty dq] returns [false] iff [dq] has no elements. O(1) *) +(** [is_empty dq] returns [true] iff [dq] has no elements. O(1) *) val at : ?backwards:bool -> 'a dq -> int -> 'a option (** [at ~backwards dq k] returns the [k]th element of [dq], from @@ -77,11 +77,11 @@ val at : ?backwards:bool -> 'a dq -> int -> 'a option val map : ('a -> 'b) -> 'a dq -> 'b dq (** [map f dq] returns a deque where every element [x] of [dq] has - been replaces with [f x]. O(n) *) + been replaced with [f x]. O(n) *) val mapi : (int -> 'a -> 'b) -> 'a dq -> 'b dq -(** [map f dq] returns a deque where every element [x] of [dq] has - been replaces with [f n x], where [n] is the position of [x] +(** [mapi f dq] returns a deque where every element [x] of [dq] has + been replaced with [f n x], where [n] is the position of [x] from the front of [dq]. O(n) *) val iter : ('a -> unit) -> 'a dq -> unit @@ -116,7 +116,7 @@ val append_list : 'a dq -> 'a list -> 'a dq more efficient. O(min(m, n)) *) val prepend_list : 'a list -> 'a dq -> 'a dq -(** [prepent_list l dq] is equivalent to [append (of_list l) dq], +(** [prepend_list l dq] is equivalent to [append (of_list l) dq], but more efficient. O(min(m, n)) *) val rotate_forward : 'a dq -> 'a dq diff --git a/src/batDigest.mlv b/src/batDigest.mlv index b9f416a4f..e85a49aa9 100644 --- a/src/batDigest.mlv +++ b/src/batDigest.mlv @@ -21,14 +21,9 @@ include Digest -open BatIO - (*Imported from [Digest.input] -- the functions used take advantage of [BatIO.input] rather than [in_channel]*) -let input inp = - let digest = Bytes.create 16 in - let _ = really_input inp digest 0 16 in - digest +let input inp = BatIO.really_nread inp 16 (*$T let digest = Digest.string "azerty" in \ input (BatIO.input_string digest) = digest @@ -38,10 +33,8 @@ let output = BatIO.nwrite let print oc t = BatIO.nwrite oc (to_hex t) let channel inp len = (*TODO: Make efficient*) - if len >= 0 then - let buf = Bytes.create len in - let _ = BatIO.really_input inp buf 0 len in - Digest.string buf + if len >= 0 + then Digest.string (BatIO.really_nread inp len) else Digest.channel (BatIO.to_input_channel inp) len (*$T let digest = Digest.string "azerty" in \ @@ -69,20 +62,16 @@ let channel inp len = (*TODO: Make efficient*) *) let from_hex s = - if String.length s <> 32 then raise (Invalid_argument "Digest.from_hex"); + if String.length s <> 32 then invalid_arg "Digest.from_hex"; let digit c = match c with | '0'..'9' -> Char.code c - Char.code '0' | 'A'..'F' -> Char.code c - Char.code 'A' + 10 | 'a'..'f' -> Char.code c - Char.code 'a' + 10 - | _ -> raise (Invalid_argument "Digest.from_hex") + | _ -> invalid_arg "Digest.from_hex" in let byte i = digit s.[i] lsl 4 + digit s.[i+1] in - let result = Bytes.create 16 in - for i = 0 to 15 do - Bytes.set result i (Char.chr (byte (2 * i))); - done; - result + BatBytesCompat.string_init 16 (fun i -> Char.chr (byte (2 * i))) (*$Q Q.string (fun s -> \ @@ -98,7 +87,7 @@ let compare = String.compare (*$T equal (string "foo") (string "foo") equal (string "") (string "") - not <| equal (string "foo") (string "bar") - not <| equal (string "foo") (string "foo\0") - not <| equal (string "foo") (string "") + not @@ equal (string "foo") (string "bar") + not @@ equal (string "foo") (string "foo\000") + not @@ equal (string "foo") (string "") *) diff --git a/src/batDllist.ml b/src/batDllist.ml index 624e68262..75347fe7a 100644 --- a/src/batDllist.ml +++ b/src/batDllist.ml @@ -164,7 +164,7 @@ let splice node1 node2 = next.prev <- prev; prev.next <- next -let set node data = node.data <- data (*BISECT-VISIT*) +let set node data = node.data <- data let get node = node.data @@ -173,14 +173,14 @@ let next node = node.next let prev node = node.prev let skip node idx = - let m = if idx > 0 then -1 else 1 in + let f = if idx > 0 then next else prev in let rec loop idx n = if idx == 0 then n else - loop (idx + m) n.next + loop (idx - 1) (f n) in - loop idx node +loop (abs idx) node let rev node = let rec loop next n = diff --git a/src/batDynArray.mli b/src/batDynArray.mli index 0aa81d91a..c5355be4e 100644 --- a/src/batDynArray.mli +++ b/src/batDynArray.mli @@ -153,7 +153,7 @@ val iter : ('a -> unit) -> 'a t -> unit is equivalent to [for i = 0 to length darr - 1 do f (get darr i) done;] *) val iteri : (int -> 'a -> unit) -> 'a t -> unit -(** [iter f darr] calls the function [f] on every element of [darr]. It +(** [iteri f darr] calls the function [f] on every element of [darr]. It is equivalent to [for i = 0 to length darr - 1 do f i (get darr i) done;] *) diff --git a/src/batEnum.ml b/src/batEnum.ml index 8ca9d08f4..3cb7f8ccd 100644 --- a/src/batEnum.ml +++ b/src/batEnum.ml @@ -46,7 +46,7 @@ let make ~next ~count ~clone = } (** {6 Internal utilities}*) -let _dummy () = assert false (*BISECT-VISIT*) +let _dummy () = assert false (* raised by 'count' functions, may go outside the API *) exception Infinite_enum @@ -189,7 +189,7 @@ let from2 next clone = e let init n f = (*Experimental fix for init*) - if n < 0 then invalid_arg "BatEnum.init"; + if n < 0 then invalid_arg "Enum.init"; let count = ref n in let f' () = match !count with @@ -1148,7 +1148,7 @@ let unfold data next = let arg_min f enum = match get enum with - None -> invalid_arg "arg_min: Empty enum" + None -> invalid_arg "Enum.arg_min: Empty enum" | Some v -> let item, eval = ref v, ref (f v) in iter (fun v -> let fv = f v in @@ -1157,7 +1157,7 @@ let arg_min f enum = let arg_max f enum = match get enum with - None -> invalid_arg "arg_max: Empty enum" + None -> invalid_arg "Enum.arg_max: Empty enum" | Some v -> let item, eval = ref v, ref (f v) in iter (fun v -> let fv = f v in @@ -1349,7 +1349,7 @@ let print ?(first="") ?(last="") ?(sep=" ") print_a out e = _print_common ~first ~last ~sep ~limit:max_int print_a out e let print_at_most ?(first="") ?(last="") ?(sep=" ") ~limit print_a out e = - if limit <= 0 then raise (Invalid_argument "enum.print_at_most"); + if limit <= 0 then invalid_arg "Enum.print_at_most"; _print_common ~first ~last ~sep ~limit print_a out e (*$T print_at_most diff --git a/src/batEnum.mli b/src/batEnum.mli index 9392c31f8..a2e7a04e6 100644 --- a/src/batEnum.mli +++ b/src/batEnum.mli @@ -50,7 +50,7 @@ As most data structures in Batteries can be enumerated and built from enumerations, these operations may be used also on lists, arrays, hashtables, etc. When designing a new data structure, it - is usuallly a good idea to allow enumeration and construction + is usually a good idea to allow enumeration and construction from an enumeration. {b Note} Enumerations are not thread-safe. You should not attempt @@ -602,7 +602,7 @@ val uniqq : 'a t -> 'a t @since 2.4.0 *) val uniq_by : ('a -> 'a -> bool) -> 'a t -> 'a t -(** [uniqq cmp e] behaves as [uniq e] except it allows to specify a +(** [uniq_by cmp e] behaves as [uniq e] except it allows to specify a comparison function. @since 2.4.0 *) @@ -794,7 +794,7 @@ val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int *) val ord : ('a -> 'a -> BatOrd.order) -> 'a t -> 'a t -> BatOrd.order -(** Same as [compare] but returning a {!BatOrd.order} instead of an interger. *) +(** Same as [compare] but returning a {!BatOrd.order} instead of an integer. *) val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool (** [equal eq a b] returns [true] when [a] and [b] contain diff --git a/src/batFile.ml b/src/batFile.ml index 1782f4c2d..b69629869 100644 --- a/src/batFile.ml +++ b/src/batFile.ml @@ -45,8 +45,8 @@ let perm l = ~f:(fun acc x -> acc lor x) let unix_perm i = - if 0<= i && i <= 511 then i - else raise (Invalid_argument (Printf.sprintf "Unix permission %o " i)) + if 0 <= i && i <= 511 then i + else Printf.ksprintf invalid_arg "File.unix_perm: Unix permission %o" i (* Opening *) type open_in_flag = diff --git a/src/batFile.mli b/src/batFile.mli index 4177d1c82..da42c85fc 100644 --- a/src/batFile.mli +++ b/src/batFile.mli @@ -30,7 +30,7 @@ open BatInnerIO (** {6 Utilities} *) val lines_of : string -> string BatEnum.t -(** [line_of name] reads the contents of file [name] as an enumeration of lines. +(** [lines_of name] reads the contents of file [name] as an enumeration of lines. The file is automatically closed once the last line has been reached or the enumeration is garbage-collected. *) diff --git a/src/batOo.ml b/src/batFilename.ml similarity index 63% rename from src/batOo.ml rename to src/batFilename.ml index 48844cd06..82c2e1b12 100644 --- a/src/batOo.ml +++ b/src/batFilename.ml @@ -1,6 +1,6 @@ (* - * BatOO - Extended operations on objects - * Copyright (C) 1996 Jerome Vouillon, INRIA + * BatFilename - Extended Filename module + * Copyright (C) 1996 Xavier Leroy * 2008 David Teller, LIFO, Universite d'Orleans * * This library is free software; you can redistribute it and/or @@ -19,6 +19,15 @@ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) +include Filename -include Oo -module Internal = CamlinternalOO +let split_extension s = + remove_extension s, extension s + +(*$= split_extension & ~printer:(IO.to_string (Tuple2.print String.print String.print)) + ("/foo/bar", ".baz") (split_extension "/foo/bar.baz") + ("/foo/bar", "") (split_extension "/foo/bar") + ("/foo/bar", ".") (split_extension "/foo/bar.") + ("/foo/.rc", "") (split_extension "/foo/.rc") + ("", "") (split_extension "") +*) diff --git a/src/batFilename.mliv b/src/batFilename.mliv new file mode 100644 index 000000000..0bcec2e32 --- /dev/null +++ b/src/batFilename.mliv @@ -0,0 +1,234 @@ +(* + * BatFilename - Extended Filename module + * Copyright (C) 1996 Xavier Leroy + * 2008 David Teller + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version, + * with the special exception on linking described in file LICENSE. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + *) + +(** Operations on file names. *) + +val current_dir_name : string +(** The conventional name for the current directory (e.g. [.] in Unix). *) + +val parent_dir_name : string +(** The conventional name for the parent of the current directory + (e.g. [..] in Unix). *) + +val dir_sep : string +(** The directory separator (e.g. [/] in Unix). + @since NEXT_RELEASE and OCaml 3.11.2 *) + +val concat : string -> string -> string +(** [concat dir file] returns a file name that designates file + [file] in directory [dir]. *) + +val is_relative : string -> bool +(** Return [true] if the file name is relative to the current + directory, [false] if it is absolute (i.e. in Unix, starts + with [/]). *) + +val is_implicit : string -> bool +(** Return [true] if the file name is relative and does not start + with an explicit reference to the current directory ([./] or + [../] in Unix), [false] if it starts with an explicit reference + to the root directory or the current directory. *) + +val check_suffix : string -> string -> bool +(** [check_suffix name suff] returns [true] if the filename [name] + ends with the suffix [suff]. + + Under Windows ports (including Cygwin), comparison is + case-insensitive, relying on [String.lowercase_ascii]. Note that + this does not match exactly the interpretation of case-insensitive + filename equivalence from Windows. *) + +val chop_suffix : string -> string -> string +(** [chop_suffix name suff] removes the suffix [suff] from + the filename [name]. The behavior is undefined if [name] does not + end with the suffix [suff]. [chop_suffix_opt] is thus recommended + instead. +*) + +##V>=4.8##val chop_suffix_opt: suffix:string -> string -> string option +##V>=4.8##(** [chop_suffix_opt ~suffix filename] removes the suffix from +##V>=4.8## the [filename] if possible, or returns [None] if the +##V>=4.8## filename does not end with the suffix. +##V>=4.8## +##V>=4.8## Under Windows ports (including Cygwin), comparison is +##V>=4.8## case-insensitive, relying on [String.lowercase_ascii]. Note that +##V>=4.8## this does not match exactly the interpretation of case-insensitive +##V>=4.8## filename equivalence from Windows. +##V>=4.8## +##V>=4.8## @since NEXT_RELEASE and OCaml 4.08 +##V>=4.8##*) + + +##V>=4.4##val extension : string -> string +##V>=4.4##(** [extension name] is the shortest suffix [ext] of [name0] where: +##V>=4.4## +##V>=4.4## - [name0] is the longest suffix of [name] that does not +##V>=4.4## contain a directory separator; +##V>=4.4## - [ext] starts with a period; +##V>=4.4## - [ext] is preceded by at least one non-period character +##V>=4.4## in [name0]. +##V>=4.4## +##V>=4.4## If such a suffix does not exist, [extension name] is the empty +##V>=4.4## string. +##V>=4.4## +##V>=4.4## @since NEXT_RELEASE and OCaml 4.04 +##V>=4.4##*) + +##V>=4.4##val remove_extension : string -> string +##V>=4.4##(** Return the given file name without its extension, as defined +##V>=4.4## in {!Filename.extension}. If the extension is empty, the function +##V>=4.4## returns the given file name. +##V>=4.4## +##V>=4.4## The following invariant holds for any file name [s]: +##V>=4.4## +##V>=4.4## [remove_extension s ^ extension s = s] +##V>=4.4## +##V>=4.4## @since NEXT_RELEASE and OCaml 4.04 +##V>=4.4##*) + +val chop_extension : string -> string +(** Same as {!Filename.remove_extension}, but raise [Invalid_argument] + if the given name has an empty extension. *) + + +val basename : string -> string +(** Split a file name into directory name / base file name. + If [name] is a valid file name, then [concat (dirname name) (basename name)] + returns a file name which is equivalent to [name]. Moreover, + after setting the current directory to [dirname name] (with {!Sys.chdir}), + references to [basename name] (which is a relative file name) + designate the same file as [name] before the call to {!Sys.chdir}. + + This function conforms to the specification of POSIX.1-2008 for the + [basename] utility. *) + +val dirname : string -> string +(** See {!Filename.basename}. + This function conforms to the specification of POSIX.1-2008 for the + [dirname] utility. *) + +val temp_file : ?temp_dir: string -> string -> string -> string +(** [temp_file prefix suffix] returns the name of a + fresh temporary file in the temporary directory. + The base name of the temporary file is formed by concatenating + [prefix], then a suitably chosen integer number, then [suffix]. + The optional argument [temp_dir] indicates the temporary directory + to use, defaulting to the current result of {!Filename.get_temp_dir_name}. + The temporary file is created empty, with permissions [0o600] + (readable and writable only by the file owner). The file is + guaranteed to be different from any other file that existed when + [temp_file] was called. + Raise [Sys_error] if the file could not be created. + @before 3.11.2 no ?temp_dir optional argument +*) + +val open_temp_file : + ?mode: open_flag list -> ?perms: int -> ?temp_dir: string -> string -> + string -> string * out_channel +(** Same as {!Filename.temp_file}, but returns both the name of a fresh + temporary file, and an output channel opened (atomically) on + this file. This function is more secure than [temp_file]: there + is no risk that the temporary file will be modified (e.g. replaced + by a symbolic link) before the program opens it. The optional argument + [mode] is a list of additional flags to control the opening of the file. + It can contain one or several of [Open_append], [Open_binary], + and [Open_text]. The default is [[Open_text]] (open in text mode). The + file is created with permissions [perms] (defaults to readable and + writable only by the file owner, [0o600]). + + @raise Sys_error if the file could not be opened. + @before 4.03.0 no ?perms optional argument + @before 3.11.2 no ?temp_dir optional argument +*) + +##V>=4.0##val get_temp_dir_name : unit -> string +##V>=4.0##(** The name of the temporary directory: +##V>=4.0## Under Unix, the value of the [TMPDIR] environment variable, or "/tmp" +##V>=4.0## if the variable is not set. +##V>=4.0## Under Windows, the value of the [TEMP] environment variable, or "." +##V>=4.0## if the variable is not set. +##V>=4.0## The temporary directory can be changed with {!Filename.set_temp_dir_name}. +##V>=4.0## @since NEXT_RELEASE and OCaml 4.00.0 +##V>=4.0##*) + +##V>=4.0##val set_temp_dir_name : string -> unit +##V>=4.0##(** Change the temporary directory returned by {!Filename.get_temp_dir_name} +##V>=4.0## and used by {!Filename.temp_file} and {!Filename.open_temp_file}. +##V>=4.0## @since NEXT_RELEASE and OCaml 4.00.0 +##V>=4.0##*) + +val temp_dir_name : string + [@@ocaml.deprecated "Use Filename.get_temp_dir_name instead"] +(** The name of the initial temporary directory: + Under Unix, the value of the [TMPDIR] environment variable, or "/tmp" + if the variable is not set. + Under Windows, the value of the [TEMP] environment variable, or "." + if the variable is not set. + @deprecated You should use {!Filename.get_temp_dir_name} instead. + @since NEXT_RELEASE and OCaml 3.09.1 +*) + +val quote : string -> string +(** Return a quoted version of a file name, suitable for use as + one argument in a command line, escaping all meta-characters. + Warning: under Windows, the output is only suitable for use + with programs that follow the standard Windows quoting + conventions. + *) + +##V>4.9##val quote_command : +##V>4.9## string -> ?stdin:string -> ?stdout:string -> ?stderr:string +##V>4.9## -> string list -> string +##V>4.9##(** [quote_command cmd args] returns a quoted command line, suitable +##V>4.9## for use as an argument to {!Sys.command}, {!Unix.system}, and the +##V>4.9## {!Unix.open_process} functions. +##V>4.9## +##V>4.9## The string [cmd] is the command to call. The list [args] is +##V>4.9## the list of arguments to pass to this command. It can be empty. +##V>4.9## +##V>4.9## The optional arguments [?stdin] and [?stdout] and [?stderr] are +##V>4.9## file names used to redirect the standard input, the standard +##V>4.9## output, or the standard error of the command. +##V>4.9## If [~stdin:f] is given, a redirection [< f] is performed and the +##V>4.9## standard input of the command reads from file [f]. +##V>4.9## If [~stdout:f] is given, a redirection [> f] is performed and the +##V>4.9## standard output of the command is written to file [f]. +##V>4.9## If [~stderr:f] is given, a redirection [2> f] is performed and the +##V>4.9## standard error of the command is written to file [f]. +##V>4.9## If both [~stdout:f] and [~stderr:f] are given, with the exact +##V>4.9## same file name [f], a [2>&1] redirection is performed so that the +##V>4.9## standard output and the standard error of the command are interleaved +##V>4.9## and redirected to the same file [f]. +##V>4.9## +##V>4.9## Under Unix and Cygwin, the command, the arguments, and the redirections +##V>4.9## if any are quoted using {!Filename.quote}, then concatenated. +##V>4.9## Under Win32, additional quoting is performed as required by the +##V>4.9## [cmd.exe] shell that is called by {!Sys.command}. +##V>4.9## +##V>4.9## Raise [Failure] if the command cannot be escaped on the current platform. +##V>4.9##*) + +val split_extension : string -> string * string +(** [split_extension s] returns both the filename [s] without its extension + and its extension in two distinct strings. + For instance, [split_extension "foo.bar"] returns the pair ["foo",".bar"]. + + @since NEXT_RELEASE *) diff --git a/src/batFingerTree.ml b/src/batFingerTree.ml index 4475d1360..6db4069d6 100644 --- a/src/batFingerTree.ml +++ b/src/batFingerTree.ml @@ -85,7 +85,7 @@ struct * It is slightly faster when benchmarking construction/deconstruction * even with dummy annotations. - * In many places, it looks like functions are defined twice in slighly + * In many places, it looks like functions are defined twice in slightly * different versions. This is for performance reasons, to avoid higher * order calls (made everything 30% slower on my tests). *) @@ -152,7 +152,6 @@ struct (*---------------------------------*) (* debug printing *) (*---------------------------------*) - (*BISECT-IGNORE-BEGIN*) let pp_debug_digit pp_measure pp_a f = function | One (m, a) -> Format.fprintf f "@[@[<2>One (@,%a,@ %a@])@]" pp_measure m pp_a a @@ -193,7 +192,6 @@ struct Format.fprintf f "[%a" pp_a h; List.iter (fun a -> Format.fprintf f "; %a" pp_a a) t; Format.fprintf f "]" - (*BISECT-IGNORE-END*) (*---------------------------------*) (* measurement functions *) @@ -316,26 +314,26 @@ struct | One (v, a) -> Two (monoid.combine (measure_node x) v, x, a) | Two (v, a, b) -> Three (monoid.combine (measure_node x) v, x, a, b) | Three (v, a, b, c) -> Four (monoid.combine (measure_node x) v, x, a, b, c) - | Four _ -> assert false (*BISECT-VISIT*) + | Four _ -> assert false let cons_digit ~monoid ~measure d x = match d with | One (v, a) -> Two (monoid.combine (measure x) v, x, a) | Two (v, a, b) -> Three (monoid.combine (measure x) v, x, a, b) | Three (v, a, b, c) -> Four (monoid.combine (measure x) v, x, a, b, c) - | Four _ -> assert false (*BISECT-VISIT*) + | Four _ -> assert false let snoc_digit_node ~monoid d x = match d with | One (v, a) -> Two (monoid.combine v (measure_node x), a, x) | Two (v, a, b) -> Three (monoid.combine v (measure_node x), a, b, x) | Three (v, a, b, c) -> Four (monoid.combine v (measure_node x), a, b, c, x) - | Four _ -> assert false (*BISECT-VISIT*) + | Four _ -> assert false let snoc_digit ~monoid ~measure d x = match d with | One (v, a) -> Two (monoid.combine v (measure x), a, x) | Two (v, a, b) -> Three (monoid.combine v (measure x), a, b, x) | Three (v, a, b, c) -> Four (monoid.combine v (measure x), a, b, c, x) - | Four _ -> assert false (*BISECT-VISIT*) + | Four _ -> assert false let rec cons_aux : 'a 'm. monoid:'m monoid -> (('a, 'm) node, 'm) fg -> ('a, 'm) node -> (('a, 'm) node, 'm) fg = @@ -404,7 +402,7 @@ struct | [a; b] -> deep ~monoid (one ~measure a) Nil (one ~measure b) | [a; b; c] -> deep ~monoid (two ~monoid ~measure a b) Nil (one ~measure c) | [a; b; c; d] -> deep ~monoid (three ~monoid ~measure a b c) Nil (one ~measure d) - | _ -> assert false (*BISECT-VISIT*) + | _ -> assert false let to_digit_node = function | Node2 (v, a, b) -> Two (v, a, b) @@ -414,13 +412,13 @@ struct | [a; b] -> two ~monoid ~measure a b | [a; b; c] -> three ~monoid ~measure a b c | [a; b; c; d] -> four ~monoid ~measure a b c d - | _ -> assert false (*BISECT-VISIT*) + | _ -> assert false let to_digit_list_node ~monoid = function | [a] -> one_node a | [a; b] -> two_node ~monoid a b | [a; b; c] -> three_node ~monoid a b c | [a; b; c; d] -> four_node ~monoid a b c d - | _ -> assert false (*BISECT-VISIT*) + | _ -> assert false (*---------------------------------*) (* front / rear / etc. *) @@ -436,22 +434,22 @@ struct | Three (_, _, _, a) | Four (_, _, _, _, a) -> a let tail_digit_node ~monoid = function - | One _ -> assert false (*BISECT-VISIT*) + | One _ -> assert false | Two (_, _, a) -> one_node a | Three (_, _, a, b) -> two_node ~monoid a b | Four (_, _, a, b, c) -> three_node ~monoid a b c let tail_digit ~monoid ~measure = function - | One _ -> assert false (*BISECT-VISIT*) + | One _ -> assert false | Two (_, _, a) -> one ~measure a | Three (_, _, a, b) -> two ~monoid ~measure a b | Four (_, _, a, b, c) -> three ~monoid ~measure a b c let init_digit_node ~monoid = function - | One _ -> assert false (*BISECT-VISIT*) + | One _ -> assert false | Two (_, a, _) -> one_node a | Three (_, a, b, _) -> two_node ~monoid a b | Four (_, a, b, c, _) -> three_node ~monoid a b c let init_digit ~monoid ~measure = function - | One _ -> assert false (*BISECT-VISIT*) + | One _ -> assert false | Two (_, a, _) -> one ~measure a | Three (_, a, b, _) -> two ~monoid ~measure a b | Four (_, a, b, c, _) -> three ~monoid ~measure a b c @@ -581,7 +579,7 @@ struct let rec nodes_aux ~monoid ~measure ts sf2 = (* no idea if this should be tail rec *) match ts, sf2 with - | [], One _ -> assert false (*BISECT-VISIT*) + | [], One _ -> assert false | [], Two (_, a, b) | [a], One (_, b) -> [node2 ~monoid ~measure a b] | [], Three (_, a, b, c) @@ -737,7 +735,7 @@ struct (* lookup *) (*---------------------------------*) (* This is a simplification of splitTree that avoids rebuilding the tree - * two trees aroud the elements being looked up + * two trees around the elements being looked up * But you can't just find the element, so instead these functions find the * element _and_ the measure of the elements of the current node that are on * the left of the element. @@ -1173,7 +1171,8 @@ let reverse t = Generic.reverse ~monoid:nat_plus_monoid ~measure:size_measurer t let split f t = Generic.split ~monoid:nat_plus_monoid ~measure:size_measurer f t let split_at t i = - if i < 0 || i >= size t then invalid_arg "Index out of bounds"; + if i < 0 || i >= size t then + invalid_arg "FingerTree.split_at: Index out of bounds"; split (fun index -> i < index) t (*$T split_at let n = 50 in \ @@ -1187,7 +1186,8 @@ let split_at t i = let lookup f t = Generic.lookup ~monoid:nat_plus_monoid ~measure:size_measurer f t let get t i = - if i < 0 || i >= size t then invalid_arg "Index out of bounds"; + if i < 0 || i >= size t then + invalid_arg "FingerTree.get: Index out of bounds"; lookup (fun index -> i < index) t (*$T get let n = 50 in \ @@ -1200,7 +1200,8 @@ let get t i = *) let set t i v = - if i < 0 || i >= size t then invalid_arg "Index out of bounds"; + if i < 0 || i >= size t then + invalid_arg "FingerTree.set: Index out of bounds"; let left, right = split_at t i in append (snoc left v) (tail_exn right) (*$T set diff --git a/src/batFingerTree.mli b/src/batFingerTree.mli index 8b9e09f70..bd58376b8 100644 --- a/src/batFingerTree.mli +++ b/src/batFingerTree.mli @@ -27,10 +27,10 @@ the measurement function (this is needed because sometimes the type of the measure depends on the type of the elements). - This module also contains an instanciation of a finger tree that + This module also contains an instantiation of a finger tree that implements a functional sequence with the following characteristics: - amortized constant time addition and deletions at both ends - - contant time size operation + - constant time size operation - logarithmic lookup, update or deletion of the element at a given index - logarithmic splitting and concatenation @@ -186,7 +186,7 @@ sig *) val rear_exn : (('a, 'm) fg -> (('a, 'm) fg * 'a), 'a, 'm) wrap - (** [rear t] returns [(init, last)] when [last] is the last element of + (** [rear_exn t] returns [(init, last)] when [last] is the last element of the sequence and [init] is the rest of the sequence. @raise Empty if [t] is empty. @@ -287,7 +287,7 @@ sig *) val of_backwards : ('a BatEnum.t -> ('a, 'm) fg, 'a, 'm) wrap - (** [of_backward e] is equivalent to [reverse (of_enum e)]. + (** [of_backwards e] is equivalent to [reverse (of_enum e)]. O(n). *) @@ -365,7 +365,7 @@ module Generic : sig val split : (('m -> bool) -> ('a, 'm) fg -> ('a, 'm) fg * ('a, 'm) fg, 'a, 'm) wrap (** [split p t], when [p] is monotonic, returns [(t1, t2)] where - [t1] is the longest prefix of [t] whose measure does not satifies + [t1] is the longest prefix of [t] whose measure does not satisfies [p], and [t2] is the rest of [t]. @raise Empty is there is no such element diff --git a/src/batFloat.ml b/src/batFloat.ml index cf7c77be9..d4ee43376 100644 --- a/src/batFloat.ml +++ b/src/batFloat.ml @@ -294,7 +294,7 @@ module Safe_float = struct let ceil = safe1 ceil let floor = safe1 floor let modf x = let (_, z) as result = modf x in if_safe z; result - let frexp x = let (f, _) as result = frexp x in if_safe f; result (*BISECT-VISIT*) + let frexp x = let (f, _) as result = frexp x in if_safe f; result let ldexp = safe2 ldexp type bounded = t diff --git a/src/batFloat.mli b/src/batFloat.mli index 69a27f710..5b8f338ff 100644 --- a/src/batFloat.mli +++ b/src/batFloat.mli @@ -69,7 +69,7 @@ val succ : float -> float equal to [x], due to rounding.*) val pred : float -> float -(** Substract [1.] from a floating number. Note that, as per +(** Subtract [1.] from a floating number. Note that, as per IEEE 754, if [x] is a large enough float number, [pred x] might be equal to [x], due to rounding.*) @@ -407,7 +407,7 @@ sig equal to [x], due to rounding.*) val pred : float -> float - (** Substract [1.] from a floating number. Note that, as per + (** Subtract [1.] from a floating number. Note that, as per IEEE 754, if [x] is a large enough float number, [pred x] might be equal to [x], due to rounding.*) diff --git a/src/batFormat.mlv b/src/batFormat.mlv index b1a9c244f..43e88db7c 100644 --- a/src/batFormat.mlv +++ b/src/batFormat.mlv @@ -25,13 +25,13 @@ include Format (* internal functions *) -let output_of out = fun s i o -> ignore (really_output out s i o) +let output_of out = fun s i o -> ignore (really_output_substring out s i o) let flush_of out = BatInnerIO.get_flush out let newline_of out = fun () -> BatInnerIO.write out '\n' let spaces_of out = (* Default function to output spaces. Copied from base format.ml*) - let blank_line = String.make 80 ' ' in + let blank_line = Bytes.make 80 ' ' in let rec display_blanks n = if n > 0 then if n <= 80 then ignore (really_output out blank_line 0 n) else diff --git a/src/batGc.mliv b/src/batGc.mliv index 474dd01f8..de5554e90 100644 --- a/src/batGc.mliv +++ b/src/batGc.mliv @@ -110,7 +110,7 @@ type control = Gc.control = mutable space_overhead : int; (** The major GC speed is computed from this parameter. This is the memory that will be "wasted" because the GC does not - immediatly collect unreachable blocks. It is expressed as a + immediately collect unreachable blocks. It is expressed as a percentage of the memory used for live data. The GC will work more (use more CPU time and collect blocks more eagerly) if [space_overhead] is smaller. @@ -160,6 +160,41 @@ type control = Gc.control = ##V>=4.3## 1 and 50. ##V>=4.3## Default: 1. @since 2.5.0 and OCaml 4.03.0 *) ##V>=4.3## + +##V>=4.8## custom_major_ratio : int; +##V>=4.8## (** Target ratio of floating garbage to major heap size for +##V>=4.8## out-of-heap memory held by custom values located in the major +##V>=4.8## heap. The GC speed is adjusted to try to use this much memory +##V>=4.8## for dead values that are not yet collected. Expressed as a +##V>=4.8## percentage of major heap size. The default value keeps the +##V>=4.8## out-of-heap floating garbage about the same size as the +##V>=4.8## in-heap overhead. +##V>=4.8## Note: this only applies to values allocated with +##V>=4.8## [caml_alloc_custom_mem] (e.g. bigarrays). +##V>=4.8## Default: 44. +##V>=4.8## @since 2.10.0 and OCaml 4.08.0 *) + +##V>=4.8## custom_minor_ratio : int; +##V>=4.8## (** Bound on floating garbage for out-of-heap memory held by +##V>=4.8## custom values in the minor heap. A minor GC is triggered when +##V>=4.8## this much memory is held by custom values located in the minor +##V>=4.8## heap. Expressed as a percentage of minor heap size. +##V>=4.8## Note: this only applies to values allocated with +##V>=4.8## [caml_alloc_custom_mem] (e.g. bigarrays). +##V>=4.8## Default: 100. +##V>=4.8## @since 2.10.0 and OCaml 4.08.0 *) + +##V>=4.8## custom_minor_max_size : int; +##V>=4.8## (** Maximum amount of out-of-heap memory for each custom value +##V>=4.8## allocated in the minor heap. When a custom value is allocated +##V>=4.8## on the minor heap and holds more than this many bytes, only +##V>=4.8## this value is counted against [custom_minor_ratio] and the +##V>=4.8## rest is directly counted against [custom_major_ratio]. +##V>=4.8## Note: this only applies to values allocated with +##V>=4.8## [caml_alloc_custom_mem] (e.g. bigarrays). +##V>=4.8## Default: 8192 bytes. +##V>=4.8## @since 2.10.0 and OCaml 4.08.0 *) +##V>=4.8## } (** The GC parameters are given as a [control] record. Note that these parameters can also be initialised by setting the @@ -182,7 +217,8 @@ external counters : unit -> float * float * float = "caml_gc_counters" is as fast at [quick_stat]. *) ##V>=4.4##external minor_words : unit -> (float [@unboxed]) -##V>=4.4## = "caml_gc_minor_words" "caml_gc_minor_words_unboxed" [@@noalloc] +##V>=4.4## = "caml_gc_minor_words" "caml_gc_minor_words_unboxed" +##V=4.4## [@@noalloc] ##V>=4.4##(** Number of words allocated in the minor heap since the program was ##V>=4.4## started. This number is accurate in byte-code programs, but only an ##V>=4.4## approximation in programs compiled to native code. @@ -227,7 +263,9 @@ val allocated_bytes : unit -> float started. It is returned as a [float] to avoid overflow problems with [int] on 32-bit machines. *) -##V>=4.3##external get_minor_free : unit -> int = "caml_get_minor_free" [@@noalloc] +##V>=4.3##external get_minor_free : unit -> int = "caml_get_minor_free" +##V=4.3## [@@noalloc] +##V=4.4## [@@noalloc] (** Return the current size of the free space inside the minor heap. @since 2.5.0 and OCaml 4.03.0 *) @@ -318,7 +356,7 @@ val finalise : ('a -> unit) -> 'a -> unit ##V>=4.4## finalisation function attached with `GC.finalise` are always ##V>=4.4## called before the finalisation function attached with `GC.finalise_last`. ##V>=4.4## -##V>=4.4## @since NEXT_RELASE and OCaml 4.04 +##V>=4.4## @since NEXT_RELEASE and OCaml 4.04 ##V>=4.4##*) val finalise_release : unit -> unit;; diff --git a/src/batGenlex.ml b/src/batGenlex.ml index be772401b..7fc720a02 100644 --- a/src/batGenlex.ml +++ b/src/batGenlex.ml @@ -51,16 +51,16 @@ let to_enum_filter kwd_table = let reset_buffer () = buffer := initial_buffer; bufpos := 0 in let store c = - if !bufpos >= String.length !buffer then + if !bufpos >= Bytes.length !buffer then begin let newbuffer = Bytes.create (2 * !bufpos) in - String.blit !buffer 0 newbuffer 0 !bufpos; buffer := newbuffer + Bytes.blit !buffer 0 newbuffer 0 !bufpos; buffer := newbuffer end; Bytes.set !buffer !bufpos c; incr bufpos in let get_string () = - let s = String.sub !buffer 0 !bufpos in buffer := initial_buffer; s + let s = Bytes.sub_string !buffer 0 !bufpos in buffer := initial_buffer; s in let ident_or_keyword id = try Hashtbl.find kwd_table id with diff --git a/src/batGlobal.ml b/src/batGlobal.ml index a89566087..8c7fd42a3 100644 --- a/src/batGlobal.ml +++ b/src/batGlobal.ml @@ -23,8 +23,6 @@ exception Global_not_initialized of string type 'a t = ('a option ref * string) -(*BISECT-IGNORE-BEGIN*) - let empty name = (ref None, name) @@ -45,4 +43,3 @@ let isdef (r, _) = !r <> None let get (r,_) = !r - (*BISECT-IGNORE-END*) diff --git a/src/batHashcons.ml b/src/batHashcons.ml index 191632213..9df5cb01a 100644 --- a/src/batHashcons.ml +++ b/src/batHashcons.ml @@ -27,7 +27,7 @@ module Int = BatInt module Sys = BatSys module Hashtbl = BatHashtbl -module Array = struct include Array include BatArray end +module Array = BatArray type 'a hobj = { obj : 'a ; diff --git a/src/batHashtbl.mli b/src/batHashtbl.mli index d3a9118d0..b89f6559f 100644 --- a/src/batHashtbl.mli +++ b/src/batHashtbl.mli @@ -37,7 +37,7 @@ open Hashtbl type ('a, 'b) t = ('a, 'b) Hashtbl.t -(** A Hashtable wth keys of type 'a and values 'b *) +(** A Hashtable with keys of type 'a and values 'b *) (**{6 Base operations}*) @@ -119,6 +119,19 @@ val enum : ('a, 'b) t -> ('a * 'b) BatEnum.t val of_enum : ('a * 'b) BatEnum.t -> ('a, 'b) t (** Create a hashtable from a (key,value) enumeration. *) +(**{6 Lists}*) + +val of_list : ('a * 'b) list -> ('a, 'b) t +(** Create a hashtable from a list of (key,value) pairs. + @since 2.6.0 *) + +val to_list : ('a, 'b) t -> ('a * 'b) list +(** Return the list of (key,value) pairs. + @since 2.6.0 *) + +val bindings : ('a, 'b) t -> ('a * 'b) list +(** Alias for [to_list]. + @since 2.6.0 *) (**{6 Searching}*) @@ -133,8 +146,8 @@ val find_all : ('a, 'b) t -> 'a -> 'b list bindings, in reverse order of introduction in the table. *) val find_default : ('a,'b) t -> 'a -> 'b -> 'b -(** Find a binding for the key, and return a default - value if not found *) +(** [Hashtbl.find_default tbl key default] finds a binding for [key], + or return [default] if [key] is unbound in [tbl]. *) val find_option : ('a,'b) Hashtbl.t -> 'a -> 'b option (** Find a binding for the key, or return [None] if no @@ -207,7 +220,7 @@ val filter_inplace : ('a -> bool) -> ('key,'a) t -> unit @since 2.1 *) val filteri: ('key -> 'a -> bool) -> ('key, 'a) t -> ('key, 'a) t -(** [filter f m] returns a hashtbl where only the key, values pairs +(** [filteri f m] returns a hashtbl where only the key, values pairs [key], [a] of [m] such that [f key a = true] remain. *) val filteri_inplace : ('key -> 'a -> bool) -> ('key, 'a) t -> unit @@ -228,6 +241,29 @@ val filter_map_inplace: ('key -> 'a -> 'a option) -> ('key, 'a) t -> unit (** [filter_map_inplace f m] performs like filter_map but modify [m] inplace instead of creating a new Hashtbl. *) +val merge: ('a -> 'b option -> 'c option -> 'd option) -> + ('a, 'b) t -> ('a, 'c) t -> ('a, 'd) t +(** [merge f a b] returns a new Hashtbl which is build from the bindings of + [a] and [b] according to the function [f], that is given all defined keys + one by one, along with the value from [a] (if defined) and the value from + [b] (if defined), and has to return the (optional) resulting value. + + It is assumed that each key is bound at most once in [a] and [b]. + See [merge_all] for a more general alternative if this is not the case. + @since 2.10.0 +*) + +val merge_all: ('a -> 'b list -> 'c list -> 'd list) -> + ('a, 'b) t -> ('a, 'c) t -> ('a, 'd) t +(** [merge_all f a b] is similar to [merge], but passes to [f] all bindings + for a key (most recent first, as returned by [find_all]). [f] must then + return all the new bindings of the merged hashtable (or an empty list if + that key should not be bound in the resulting hashtable). Those new + bindings will be inserted in reverse, so that the head of the list will + become the most recent binding in the merged hashtable. + @since 2.10.0 +*) + (** {6 The polymorphic hash primitive}*) val hash : 'a -> int @@ -323,6 +359,10 @@ sig val modify : key:'a -> f:('b -> 'b) -> ('a, 'b) t -> unit val modify_def : default:'b -> key:'a -> f:('b -> 'b) -> ('a, 'b) t -> unit val modify_opt : key:'a -> f:('b option -> 'b option) -> ('a, 'b) t -> unit + val merge: f:('a -> 'b option -> 'c option -> 'd option) -> + left:('a, 'b) t -> right:('a, 'c) t -> ('a, 'd) t + val merge_all: f:('a -> 'b list -> 'c list -> 'd list) -> + left:('a, 'b) t -> right:('a, 'c) t -> ('a, 'd) t end (** {6 Functorial interface} *) @@ -379,10 +419,16 @@ sig val modify : key -> ('a -> 'a) -> 'a t -> unit val modify_def : 'a -> key -> ('a -> 'a) -> 'a t -> unit val modify_opt : key -> ('a option -> 'a option) -> 'a t -> unit + val merge : (key -> 'a option -> 'b option -> 'c option) -> + 'a t -> 'b t -> 'c t + val merge_all : (key -> 'a list -> 'b list -> 'c list) -> + 'a t -> 'b t -> 'c t val keys : 'a t -> key BatEnum.t val values : 'a t -> 'a BatEnum.t val enum : 'a t -> (key * 'a) BatEnum.t + val to_list : 'a t -> (key * 'a) list val of_enum : (key * 'a) BatEnum.t -> 'a t + val of_list : (key * 'a) list -> 'a t val print : ?first:string -> ?last:string -> ?sep:string -> ('a BatInnerIO.output -> key -> unit) -> ('a BatInnerIO.output -> 'b -> unit) -> @@ -449,6 +495,10 @@ sig val modify : key:key -> f:('a -> 'a) -> 'a t -> unit val modify_def : default:'a -> key:key -> f:('a -> 'a) -> 'a t -> unit val modify_opt : key:key -> f:('a option -> 'a option) -> 'a t -> unit + val merge : f:(key -> 'a option -> 'b option -> 'c option) -> + left:'a t -> right:'b t -> 'c t + val merge_all : f:(key -> 'a list -> 'b list -> 'c list) -> + left:'a t -> right:'b t -> 'c t end end @@ -539,6 +589,10 @@ sig val filteri_inplace : ('key -> 'a -> bool) -> ('key, 'a, [>`Write]) t -> unit val filter_map : ('key -> 'a -> 'b option) -> ('key, 'a, [>`Read]) t -> ('key, 'b, _) t val filter_map_inplace : ('key -> 'a -> 'a option) -> ('key, 'a, [>`Write]) t -> unit + val merge : ('key -> 'a option -> 'b option -> 'c option) -> + ('key, 'a, [>`Read]) t -> ('key, 'b, [>`Read]) t -> ('key, 'c, _) t + val merge_all : ('key -> 'a list -> 'b list -> 'c list) -> + ('key, 'a, [>`Read]) t -> ('key, 'b, [>`Read]) t -> ('key, 'c, _) t (**{6 Conversions}*) @@ -546,6 +600,8 @@ sig val values : ('a, 'b, [>`Read]) t -> 'b BatEnum.t val enum : ('a, 'b, [>`Read]) t -> ('a * 'b) BatEnum.t val of_enum : ('a * 'b) BatEnum.t -> ('a, 'b, _) t + val to_list : ('a, 'b, [>`Read]) t -> ('a * 'b) list + val of_list : ('a * 'b) list -> ('a, 'b, _) t (** {6 Boilerplate code}*) @@ -580,6 +636,11 @@ sig val filter_map : f:(key:'key -> data:'a -> 'b option) -> ('key, 'a, [>`Read]) t -> ('key, 'b, _) t val filter_map_inplace : f:(key:'key -> data:'a -> 'a option) -> ('key, 'a, [>`Write]) t -> unit val fold : f:(key:'a -> data:'b -> 'c -> 'c) -> ('a, 'b, [>`Read]) t -> init:'c -> 'c + val merge : f:('key -> 'a option -> 'b option -> 'c option) -> + left:('key, 'a, [>`Read]) t -> right:('key, 'b, [>`Read]) t -> ('key, 'c, _) t + val merge_all : f:('key -> 'a list -> 'b list -> 'c list) -> + left:('key, 'a, [>`Read]) t -> right:('key, 'b, [>`Read]) t -> ('key, 'c, _) t + end end (* Cap module *) diff --git a/src/batHashtbl.mlv b/src/batHashtbl.mlv index ac84cfeec..858b8c9ed 100644 --- a/src/batHashtbl.mlv +++ b/src/batHashtbl.mlv @@ -121,6 +121,35 @@ let enum h = in make (-1) Empty (Obj.magic()) (-1) +let to_list ht = + fold (fun k v acc -> + (k, v) :: acc + ) ht [] +(*$T to_list + let ht = create 1 in \ + add ht 1 '2'; \ + to_list ht = [(1, '2')] +*) + +let of_list l = + let res = create 11 in + List.iter (fun (k, v) -> + add res k v + ) l; + res +(*$T of_list + let l = [(1,2);(2,3);(3,4)] in \ + List.sort compare (to_list (of_list l)) = l +*) + +let bindings ht = to_list ht +(*$T bindings + let ht = create 1 in \ + add ht 1 '2'; \ + bindings ht = [(1, '2')] +*) + + let keys h = BatEnum.map (fun (k,_) -> k) (enum h) let values h = BatEnum.map (fun (_,v) -> v) (enum h) @@ -145,10 +174,16 @@ let map_inplace f h = in BatArray.modify loop (h_conv h).data -(*$= map_inplace & ~printer:(IO.to_string (List.print Int.print)) +(* Helper functions to test hashtables which values are integers: *) +(*$inject + let (|>) x f = f x + let printer = IO.to_string (List.print Int.print) + let to_sorted_list h = values h |> List.of_enum |> List.sort Int.compare +*) +(*$= map_inplace & ~printer (let h = Enum.combine (1 -- 5, 1 -- 5) |> of_enum in \ map_inplace (fun _ x -> x+1) h ; \ - values h |> List.of_enum |> List.sort Int.compare) [2;3;4;5;6] + to_sorted_list h) [2;3;4;5;6] *) let remove_all h key = @@ -291,10 +326,10 @@ let filteri_inplace f h = ) in BatArray.modify loop hc.data -(*$= filteri_inplace & ~printer:(IO.to_string (List.print Int.print)) +(*$= filteri_inplace & ~printer (let h = Enum.combine (1 -- 5, 1 -- 5) |> of_enum in \ filteri_inplace (fun _ x -> x>3) h ; \ - values h |> List.of_enum |> List.sort Int.compare) [4; 5] + to_sorted_list h) [4; 5] *) @@ -305,7 +340,7 @@ let filter_inplace f h = filteri_inplace (fun _k a -> f a) h (*$= filter_inplace & ~printer:(IO.to_string (List.print Int.print)) (let h = Enum.combine (1 -- 5, 1 -- 5) |> of_enum in \ filter_inplace (fun x -> x>3) h ; \ - values h |> List.of_enum |> List.sort Int.compare) [4; 5] + to_sorted_list h) [4; 5] *) @@ -328,10 +363,133 @@ let filter_map_inplace f h = | Some v' -> Cons (k, v', loop next)) in BatArray.modify loop hc.data -(*$= filter_map_inplace & ~printer:(IO.to_string (List.print Int.print)) +(*$= filter_map_inplace & ~printer (let h = Enum.combine (1 -- 5, 1 -- 5) |> of_enum in \ filter_map_inplace (fun _ x -> if x>3 then Some (x+1) else None) h ; \ - values h |> List.of_enum |> List.sort Int.compare) [5; 6] + to_sorted_list h) [5; 6] +*) + + +let merge f h1 h2 = + let res = create (max (length h1) (length h2)) in + let may_add_res k v1 v2 = + BatOption.may (add res k) (f k v1 v2) in + iter (fun k v1 -> + may_add_res k (Some v1) (find_option h2 k) + ) h1 ; + iter (fun k v2 -> + if not (mem h1 k) then + may_add_res k None (Some v2) + ) h2 ; + res + +(*$inject + let union = merge (fun _ l r -> if l = None then r else l) + let inter = merge (fun _ l r -> if l = None then l else r) + let equal h1 h2 = to_sorted_list h1 = to_sorted_list h2 + let empty = create 0 + let h_1_5 = Enum.combine (1 -- 5, 1 -- 5) |> of_enum + let h_1_3 = Enum.combine (1 -- 3, 1 -- 3) |> of_enum + let h_3_5 = Enum.combine (3 -- 5, 3 -- 5) |> of_enum + let of_uniq_list l = List.unique l |> List.map (fun i -> i, i) |> of_list +*) +(*$= merge & ~printer + [] \ + (merge (fun k _ _ -> Some k) empty empty |> to_sorted_list) + [1; 2; 3; 4; 5] \ + (merge (fun _ l _ -> l) h_1_5 empty |> to_sorted_list) + [] \ + (merge (fun _ _ r -> r) h_1_5 empty |> to_sorted_list) + [] \ + (merge (fun _ l _ -> l) empty h_1_5 |> to_sorted_list) + [1; 2; 3; 4; 5] \ + (merge (fun _ _ r -> r) empty h_1_5 |> to_sorted_list) + [1; 2; 3] \ + (let h = Enum.combine (3 -- 6, 13 -- 15) |> of_enum in \ + merge (fun _ l _ -> l) h_1_3 h |> to_sorted_list) + [13; 14; 15] \ + (let h = Enum.combine (3 -- 5, 13 -- 15) |> of_enum in \ + merge (fun _ _ r -> r) h_1_3 h |> to_sorted_list) + [] \ + (merge (fun _ _ _ -> None) h_1_3 h_3_5 |> to_sorted_list) +*) +(*$= union & ~printer + [1; 2; 3; 4; 5] \ + (union h_1_3 h_3_5 |> to_sorted_list) +*) +(*$= inter & ~printer + [3] \ + (inter h_1_3 h_3_5 |> to_sorted_list) +*) +(*$Q equal + (Q.list Q.small_int) (fun l -> \ + let h = of_uniq_list l in \ + equal (inter h h) h) + (Q.list Q.small_int) (fun l -> \ + let h = of_uniq_list l in \ + equal (union h h) h) + (Q.list Q.small_int) (fun l -> \ + let h = of_uniq_list l in \ + equal (union h empty) h) + (Q.list Q.small_int) (fun l -> \ + let h = of_uniq_list l in \ + equal (inter h empty) empty) + (Q.pair (Q.list Q.small_int) (Q.list Q.small_int)) (fun (l1, l2) -> \ + let h1 = of_uniq_list l1 and h2 = of_uniq_list l2 in \ + equal (inter h1 h2) (inter h2 h1)) + (Q.pair (Q.list Q.small_int) (Q.list Q.small_int)) (fun (l1, l2) -> \ + let h1 = of_uniq_list l1 and h2 = of_uniq_list l2 in \ + equal (union h1 h2) (union h2 h1)) +*) + +let merge_all f h1 h2 = + let res = create (max (length h1) (length h2)) in + let may_add_res k v1 v2 = + List.iter (add res k) (List.rev (f k v1 v2)) in + iter (fun k _ -> + let l1 = find_all h1 k + and l2 = find_all h2 k in + may_add_res k l1 l2 + ) h1 ; + iter (fun k _ -> + match find_all h1 k with + | [] -> + let l2 = find_all h2 k in + may_add_res k [] l2 + | _ -> () (* done above *) + ) h2 ; + res + +(*$= merge_all & ~printer + [] \ + (let h1 = create 0 and h2 = create 0 in \ + merge_all (fun k _ _ -> [k]) h1 h2 |> to_sorted_list) + [1; 2; 3; 4; 5] \ + (let h = create 0 in \ + merge_all (fun _ l _ -> l) h_1_5 h |> to_sorted_list) + [] \ + (let h = create 0 in \ + merge_all (fun _ _ r -> r) h_1_5 h |> to_sorted_list) + [] \ + (let h = create 0 in \ + merge_all (fun _ l _ -> l) h h_1_5 |> to_sorted_list) + [1; 2; 3; 4; 5] \ + (let h = create 0 in \ + merge_all (fun _ _ r -> r) h h_1_5 |> to_sorted_list) + [1; 2; 3] \ + (let h = Enum.combine (3 -- 6, 13 -- 15) |> of_enum in \ + merge_all (fun _ l _ -> l) h_1_3 h |> to_sorted_list) + [13; 14; 15] \ + (let h = Enum.combine (3 -- 5, 13 -- 15) |> of_enum in \ + merge_all (fun _ _ r -> r) h_1_3 h |> to_sorted_list) + [] \ + (merge_all (fun _ _ _ -> []) h_1_3 h_3_5 |> to_sorted_list) + [2; 1] \ + (let h1 = of_list [1, 1] in \ + let h2 = copy h1 in \ + Hashtbl.add h2 1 2 ;\ + let h = merge_all (fun _ _ r -> r) h1 h2 in \ + find_all h 1) *) @@ -365,6 +523,8 @@ struct let modify ~key ~f = modify key f let modify_def ~default ~key ~f = modify_def default key f let modify_opt ~key ~f = modify_opt key f + let merge ~f ~left ~right = merge f left right + let merge_all ~f ~left ~right = merge_all f left right end module type HashedType = Hashtbl.HashedType @@ -400,10 +560,16 @@ sig val modify : key -> ('a -> 'a) -> 'a t -> unit val modify_def : 'a -> key -> ('a -> 'a) -> 'a t -> unit val modify_opt : key -> ('a option -> 'a option) -> 'a t -> unit + val merge : (key -> 'a option -> 'b option -> 'c option) -> + 'a t -> 'b t -> 'c t + val merge_all : (key -> 'a list -> 'b list -> 'c list) -> + 'a t -> 'b t -> 'c t val keys : 'a t -> key BatEnum.t val values : 'a t -> 'a BatEnum.t val enum : 'a t -> (key * 'a) BatEnum.t + val to_list: 'a t -> (key * 'a) list val of_enum : (key * 'a) BatEnum.t -> 'a t + val of_list : (key * 'a) list -> 'a t val print : ?first:string -> ?last:string -> ?sep:string -> ('a BatInnerIO.output -> key -> unit) -> ('a BatInnerIO.output -> 'b -> unit) -> @@ -458,6 +624,10 @@ sig val modify : key:key -> f:('a -> 'a) -> 'a t -> unit val modify_def : default:'a -> key:key -> f:('a -> 'a) -> 'a t -> unit val modify_opt : key:key -> f:('a option -> 'a option) -> 'a t -> unit + val merge : f:(key -> 'a option -> 'b option -> 'c option) -> + left:'a t -> right:'b t -> 'c t + val merge_all : f:(key -> 'a list -> 'b list -> 'c list) -> + left:'a t -> right:'b t -> 'c t end end @@ -562,10 +732,12 @@ struct let length = length let enum h = enum (to_hash h) + let to_list h = to_list (to_hash h) let of_enum e = of_hash (of_enum e) let values h = values (to_hash h) let keys h = keys (to_hash h) let map (f:key -> 'a -> 'b) h = of_hash (map f (to_hash h)) + let of_list l = of_hash (of_list l) (* We can use polymorphic filteri since we do not use the key at all for inline ops *) let map_inplace (f:key -> 'a -> 'b) h = map_inplace f (to_hash h) @@ -679,6 +851,38 @@ struct in modify_opt key f' h + let merge f a b = + let res = create (max (length a) (length b)) in + let may_add_res k v1 v2 = + BatOption.may (add res k) (f k v1 v2) in + iter (fun k v1 -> + may_add_res k (Some v1) (find_option b k) + ) a ; + iter (fun k v2 -> + if not (mem a k) then + may_add_res k None (Some v2) + ) b ; + res + + let merge_all f a b = + let res = create (max (length a) (length b)) in + let may_add_res k v1 v2 = + List.iter (add res k) (List.rev (f k v1 v2)) in + iter (fun k _ -> + let l1 = find_all a k + and l2 = find_all b k in + may_add_res k l1 l2 + ) a ; + iter (fun k _ -> + match find_all a k with + | [] -> + let l2 = find_all b k in + may_add_res k [] l2 + | _ -> () (* done above *) + ) b ; + res + + module Labels = struct let label f = fun key data -> f ~key ~data @@ -697,6 +901,8 @@ struct let modify ~key ~f = modify key f let modify_def ~default ~key ~f = modify_def default key f let modify_opt ~key ~f = modify_opt key f + let merge ~f ~left ~right = merge f left right + let merge_all ~f ~left ~right = merge_all f left right end module Exceptionless = @@ -751,11 +957,15 @@ struct let keys = keys let values = values let enum = enum + let to_list = to_list let of_enum = of_enum + let of_list = of_list let print = print let filter = filter let filteri = filteri let filter_map = filter_map + let merge = merge + let merge_all = merge_all module Labels = struct let label f = fun key data -> f ~key ~data @@ -774,6 +984,8 @@ struct let modify ~key ~f = modify key f let modify_def ~default ~key ~f = modify_def default key f let modify_opt ~key ~f = modify_opt key f + let merge ~f ~left ~right = merge f left right + let merge_all ~f ~left ~right = merge_all f left right end module Exceptionless = diff --git a/src/batHeap.ml b/src/batHeap.ml index 723bbb0a2..13500ebf2 100644 --- a/src/batHeap.ml +++ b/src/batHeap.ml @@ -107,35 +107,44 @@ let find_min bh = match bh.mind with *) -let rec find_min_tree ts k = match ts with - | [] -> failwith "find_min_tree" - | [t] -> k t - | t :: ts -> - find_min_tree ts begin - fun u -> - if Pervasives.compare t.root u.root <= 0 - then k t else k u - end - -let rec del_min_tree bts k = match bts with - | [] -> invalid_arg "del_min" - | [t] -> k t [] - | t :: ts -> - del_min_tree ts begin - fun u uts -> - if Pervasives.compare t.root u.root <= 0 - then k t ts - else k u (t :: uts) - end +let rec find_min_tree ts ~kfail ~ksuccess = + match ts with + | [] -> + kfail () + | [t] -> + ksuccess t + | t :: ts -> + find_min_tree ts ~kfail ~ksuccess:(fun u -> + if Pervasives.compare t.root u.root <= 0 then + ksuccess t + else + ksuccess u) + +let rec del_min_tree bts ~kfail ~ksuccess = + match bts with + | [] -> + kfail () + | [t] -> + ksuccess t [] + | t :: ts -> + del_min_tree ts ~kfail ~ksuccess:(fun u uts -> + if Pervasives.compare t.root u.root <= 0 then + ksuccess t ts + else + ksuccess u (t :: uts)) let del_min bh = - del_min_tree bh.data begin - fun bt data -> - let size = bh.size - 1 in - let data = merge_data (List.rev bt.kids) data in - let mind = if size = 0 then None else Some (find_min_tree data (fun t -> t)).root in - { size = size ; data = data ; mind = mind } - end + let kfail () = invalid_arg "del_min" in + del_min_tree bh.data ~kfail ~ksuccess:(fun bt data -> + let size = bh.size - 1 in + let data = merge_data (List.rev bt.kids) data in + let mind = + if size = 0 then + None + else + Some (find_min_tree data ~kfail ~ksuccess:(fun t -> t)).root + in + { size; data; mind }) let of_list l = List.fold_left insert empty l @@ -284,35 +293,44 @@ module Make (Ord : BatInterfaces.OrderedType) = struct | None -> invalid_arg "find_min" | Some d -> d - let rec find_min_tree ts k = match ts with - | [] -> failwith "find_min_tree" - | [t] -> k t - | t :: ts -> - find_min_tree ts begin - fun u -> - if Ord.compare t.root u.root <= 0 - then k t else k u - end - - let rec del_min_tree bts k = match bts with - | [] -> invalid_arg "del_min" - | [t] -> k t [] - | t :: ts -> - del_min_tree ts begin - fun u uts -> - if Ord.compare t.root u.root <= 0 - then k t ts - else k u (t :: uts) - end + let rec find_min_tree ts ~kfail ~ksuccess = + match ts with + | [] -> + kfail () + | [t] -> + ksuccess t + | t :: ts -> + find_min_tree ts ~kfail ~ksuccess:(fun u -> + if Ord.compare t.root u.root <= 0 then + ksuccess t + else + ksuccess u) + + let rec del_min_tree bts ~kfail ~ksuccess = + match bts with + | [] -> + kfail () + | [t] -> + ksuccess t [] + | t :: ts -> + del_min_tree ts ~kfail ~ksuccess:(fun u uts -> + if Ord.compare t.root u.root <= 0 then + ksuccess t ts + else + ksuccess u (t :: uts)) let del_min bh = - del_min_tree bh.data begin - fun bt data -> - let size = bh.size - 1 in - let data = merge_data (List.rev bt.kids) data in - let mind = if size = 0 then None else Some (find_min_tree data (fun t -> t)).root in - { size = size ; data = data ; mind = mind } - end + let kfail () = invalid_arg "del_min" in + del_min_tree bh.data ~kfail ~ksuccess:(fun bt data -> + let size = bh.size - 1 in + let data = merge_data (List.rev bt.kids) data in + let mind = + if size = 0 then + None + else + Some (find_min_tree data ~kfail ~ksuccess:(fun t -> t)).root + in + { size; data; mind }) let to_list bh = let rec aux acc bh = diff --git a/src/batIMap.mli b/src/batIMap.mli index 75ca9e8af..ab95f59eb 100644 --- a/src/batIMap.mli +++ b/src/batIMap.mli @@ -22,7 +22,7 @@ val add : int -> 'a -> 'a t -> 'a t (** [add x y t] adds a binding from [x] to [y] in [t], returning a new map. *) val add_range : int -> int -> 'a -> 'a t -> 'a t -(** [add lo hi y t] adds bindings to [y] for all values in the range +(** [add_range lo hi y t] adds bindings to [y] for all values in the range [lo,hi], returning a new map *) val find : int -> 'a t -> 'a diff --git a/src/batIO.ml b/src/batIO.ml index 65f6916df..b3fffb85f 100644 --- a/src/batIO.ml +++ b/src/batIO.ml @@ -133,7 +133,7 @@ let output_enum() = Buffer.add_char b x ) ~output:(fun s p l -> - Buffer.add_substring b s p l; + BatBytesCompat.buffer_add_subbytes b s p l; l ) ~close:(fun () -> @@ -401,7 +401,7 @@ let from_in_channel ch = let read() = try if ch#input cbuf 0 1 = 0 then raise Sys_blocked_io; - String.unsafe_get cbuf 0 + Bytes.unsafe_get cbuf 0 with End_of_file -> raise No_more_input in @@ -449,7 +449,7 @@ let from_in_chars ch = let from_out_chars ch = let output s p l = for i = p to p + l - 1 do - ch#put (String.unsafe_get s i) + ch#put (Bytes.unsafe_get s i) done; l in @@ -498,20 +498,25 @@ let lines_of2 ic = let find_eol () = let rec find_loop pos = if pos >= !end_pos then !read_pos - pos - else if buf.[pos] = '\n' then 1 + pos - !read_pos (* TODO: HANDLE CRLF *) + else if Bytes.get buf pos = '\n' + then 1 + pos - !read_pos (* TODO: HANDLE CRLF *) else find_loop (pos+1) in find_loop !read_pos in - let rec join_strings buf pos = function - | [] -> buf + let join_strings total_len accu = + let rec loop buf pos = function + | [] -> () | h::t -> - let len = String.length h in - String.blit h 0 buf (pos-len) len; - join_strings buf (pos-len) t + let len = Bytes.length h in + Bytes.blit h 0 buf (pos-len) len; + loop buf (pos-len) t in + let buf = Bytes.create total_len in + loop buf total_len accu; + Bytes.unsafe_to_string buf in let input_buf s o l = - String.blit buf !read_pos s o l; + Bytes.blit buf !read_pos s o l; read_pos := !read_pos + l; if !end_pos = !read_pos then try @@ -529,15 +534,15 @@ let lines_of2 ic = let n = find_eol () in if n = 0 then match accu with (* EOF *) | [] -> close_in ic; raise BatEnum.No_more_elements - | _ -> join_strings (Bytes.create len) len accu + | _ -> join_strings len accu else if n > 0 then (* newline found *) let res = Bytes.create (n-1) in input_buf res 0 (n-1); - input_buf " " 0 1; (* throw away EOL *) + input_buf (Bytes.of_string " ") 0 1; (* throw away EOL *) match accu with - | [] -> res + | [] -> Bytes.unsafe_to_string res | _ -> let len = len + n-1 in - join_strings (Bytes.create len) len (res :: accu) + join_strings len (res :: accu) else (* n < 0 ; no newline found *) let piece = Bytes.create (-n) in input_buf piece 0 (-n); @@ -564,17 +569,18 @@ let tab_out ?(tab=' ') n out = write out c; if is_newline c then nwrite out spaces; ) - ~output:(fun s p l -> (*Replace each newline within the segment with newline^spaces*) (*FIXME?: performance - instead output each line and a newline between each char? *) - let length = String.length s in - let buffer = Buffer.create (String.length s) in + ~output:(fun s p l -> + (*Replace each newline within the segment with newline^spaces*) + let length = Bytes.length s in + let buffer = Buffer.create length in for i = p to min (length - 1) l do - let c = String.unsafe_get s i in + let c = Bytes.unsafe_get s i in Buffer.add_char buffer c; if is_newline c then Buffer.add_string buffer spaces done; - let s' = Buffer.contents buffer in - output out s' 0 (String.length s')) + let s' = BatBytesCompat.buffer_to_bytes buffer in + really_output out s' 0 (Bytes.length s')) ~flush:noop ~close:noop ~underlying:[out] diff --git a/src/batIO.mli b/src/batIO.mli index 7270e0d83..7a9d3561c 100644 --- a/src/batIO.mli +++ b/src/batIO.mli @@ -61,8 +61,7 @@ grouped into large writing operations, as these are generally faster and induce less wear on the hardware. Occasionally, you may wish to force all waiting operations to take place {e now}. - For this purpose, you may either function {!flush} or function - I {!flush_out}. + For this purpose, you may call function {!flush}. Once you have finished using your {!type: input} or your {!type: output}, chances are that you will want to close it. This is not a @@ -189,13 +188,13 @@ val really_nread : input -> int -> string Example: [let read_md5 ch = really_nread ch 32] *) -val input : input -> string -> int -> int -> int -(** [input i s p l] reads up to [l] characters from the given input, - storing them in string [s], starting at character number [p]. It +val input : input -> Bytes.t -> int -> int -> int +(** [input i s p len] reads up to [len] characters from the given input, + storing them in byte sequence [s], starting at character number [p]. It returns the actual number of characters read (which may be 0) or raise [No_more_input] if no character can be read. It will raise - [Invalid_argument] if [p] and [l] do not designate a valid - substring of [s]. + [Invalid_argument] if [p] and [len] do not designate a valid + subsequence of [s]. Example: [let map_ch f ?(block_size=100) = let b = String.create block_size in @@ -205,16 +204,15 @@ val input : input -> string -> int -> int -> int done with No_more_input -> ()] *) -val really_input : input -> string -> int -> int -> int -(** [really_input i s p l] reads exactly [l] characters from the - given input, storing them in the string [s], starting at +val really_input : input -> Bytes.t -> int -> int -> int +(** [really_input ic s p len] reads exactly [len] characters from the + input [ic], storing them in the string [s], starting at position [p]. For consistency with {!BatIO.input} it returns - [l]. @raise No_more_input if at [l] characters are not - available. @raise Invalid_argument if [p] and [l] do not + [len]. @raise No_more_input if at [len] characters are not + available. @raise Invalid_argument if [p] and [len] do not designate a valid substring of [s]. Example: [let _ = really_input stdin b 0 3] - *) val close_in : input -> unit @@ -235,27 +233,41 @@ val nwrite : (string, _) printer Example: [nwrite stdout "Enter your name: ";] *) -val output : 'a output -> string -> int -> int -> int -(** [output o s p l] writes up to [l] characters from string [s], starting at - offset [p]. It returns the number of characters written. It will raise - [Invalid_argument] if [p] and [l] do not designate a valid substring of [s]. +val output : 'a output -> Bytes.t -> int -> int -> int +(** [output o s p len] writes up to [len] characters from byte + sequence [s], starting at offset [p]. It returns the number of + characters written. It will raise [Invalid_argument] if [p] and + [len] do not designate a valid subsequence of [s]. - Example: [let str = "Foo Bar Baz" in let written = output stdout str 2 4;] + Example: [let written = output stdout (Bytes.to_string "Foo Bar Baz") 2 4] - This writes "o Ba" to stdout. -*) + This writes "o Ba" to stdout, and returns 4. + *) -val really_output : 'a output -> string -> int -> int -> int -(** [really_output o s p l] writes exactly [l] characters from string [s] onto - the the output, starting with the character at offset [p]. For consistency with - {!BatIO.output} it returns [l]. @raise Invalid_argument if [p] and [l] do not - designate a valid substring of [s]. +val output_substring : 'a output -> string -> int -> int -> int +(** like [output] above, but outputs from a substring instead of + a subsequence of bytes + + @since 2.8.0 *) + +val really_output : 'a output -> Bytes.t -> int -> int -> int +(** [really_output o s p len] writes exactly [len] characters from + byte sequence [s] onto the the output, starting with the character + at offset [p]. For consistency with {!BatIO.output} it returns + [len]. @raise Invalid_argument if [p] and [len] do not designate + a valid subsequence of [s]. This function is useful for networking situations where the output buffer might fill resulting in not the entire substring being readied for transmission. Uses [output] internally, and will raise [Sys_blocked_io] in the case that any call returns 0. -*) + *) + +val really_output_substring : 'a output -> string -> int -> int -> int +(** like [really_output] above, but outputs from a substring instead + of a subsequence of bytes + + @since 2.8.0 *) val flush : 'a output -> unit (** Flush an output. @@ -352,7 +364,7 @@ val read_all : input -> string (** read all the contents of the input until [No_more_input] is raised. *) val pipe : unit -> input * unit output -(** Create a pipe between an input and an ouput. Data written from +(** Create a pipe between an input and an output. Data written from the output can be read from the input. *) @@ -369,7 +381,7 @@ val pos_in : input -> input * (unit -> int) val progress_in : input -> (unit -> unit) -> input (** [progress_in inp f] create an input that calls [f ()] - whenever some content is succesfully read from it.*) + whenever some content is successfully read from it.*) val pos_out : 'a output -> unit output * (unit -> int) (** Create an output that provide a count function of the number of bytes @@ -377,7 +389,7 @@ val pos_out : 'a output -> unit output * (unit -> int) val progress_out : 'a output -> (unit -> unit) -> unit output (** [progress_out out f] create an output that calls [f ()] - whenever some content is succesfully written to it.*) + whenever some content is successfully written to it.*) external cast_output : 'a output -> unit output = "%identity" (** You can safely transform any output to an unit output in a safe way @@ -593,7 +605,7 @@ val drop_bits : in_bits -> unit val create_in : read:(unit -> char) -> - input:(string -> int -> int -> int) -> + input:(Bytes.t -> int -> int -> int) -> close:(unit -> unit) -> input (** Fully create an input by giving all the needed functions. @@ -604,7 +616,7 @@ val create_in : val wrap_in : read:(unit -> char) -> - input:(string -> int -> int -> int) -> + input:(Bytes.t -> int -> int -> int) -> close:(unit -> unit) -> underlying:(input list) -> input @@ -622,7 +634,7 @@ val wrap_in : val inherit_in: ?read:(unit -> char) -> - ?input:(string -> int -> int -> int) -> + ?input:(Bytes.t -> int -> int -> int) -> ?close:(unit -> unit) -> input -> input (** Simplified and optimized version of {!wrap_in} which may be used @@ -638,7 +650,7 @@ val inherit_in: val create_out : write:(char -> unit) -> - output:(string -> int -> int -> int) -> + output:(Bytes.t -> int -> int -> int) -> flush:(unit -> unit) -> close:(unit -> 'a) -> 'a output @@ -657,7 +669,7 @@ val create_out : val wrap_out : write:(char -> unit) -> - output:(string -> int -> int -> int) -> + output:(Bytes.t -> int -> int -> int) -> flush:(unit -> unit) -> close:(unit -> 'a) -> underlying:('b output list) -> @@ -708,7 +720,7 @@ val wrap_out : val inherit_out: ?write:(char -> unit) -> - ?output:(string -> int -> int -> int) -> + ?output:(Bytes.t -> int -> int -> int) -> ?flush:(unit -> unit) -> ?close:(unit -> unit) -> 'a output -> unit output @@ -758,10 +770,10 @@ val to_input_channel : input -> in_channel (** {6 Generic BatIO Object Wrappers} - Theses OO Wrappers have been written to provide easy support of - BatIO by external librairies. If you want your library to support + These OO Wrappers have been written to provide easy support of + BatIO by external libraries. If you want your library to support BatIO without actually requiring Batteries to compile, you can - should implement the classes [in_channel], [out_channel], + implement the classes [in_channel], [out_channel], [poly_in_channel] and/or [poly_out_channel] which are the common BatIO specifications established for ExtLib, OCamlNet and Camomile. @@ -774,13 +786,13 @@ val to_input_channel : input -> in_channel class in_channel : input -> object - method input : string -> int -> int -> int + method input : Bytes.t -> int -> int -> int method close_in : unit -> unit end class out_channel : 'a output -> object - method output : string -> int -> int -> int + method output : Bytes.t -> int -> int -> int method flush : unit -> unit method close_out : unit -> unit end @@ -868,7 +880,7 @@ val synchronize_in : ?lock:BatConcurrent.lock -> input -> input wreak havoc otherwise @param lock An optional lock. If none is provided, the lock will be specific - to this [input]. Specifiying a custom lock may be useful to associate one + to this [input]. Specifying a custom lock may be useful to associate one common lock for several inputs and/or outputs, for instance in the case of pipes. *) @@ -880,7 +892,7 @@ val synchronize_out: ?lock:BatConcurrent.lock -> _ output -> unit output wreak havoc otherwise @param lock An optional lock. If none is provided, the lock will be specific - to this [output]. Specifiying a custom lock may be useful to associate one + to this [output]. Specifying a custom lock may be useful to associate one common lock for several inputs and/or outputs, for instance in the case of pipes. *) @@ -940,7 +952,7 @@ module Incubator : sig ?sep:string -> ?indent:int -> (Format.formatter -> 'a -> 'b) -> Format.formatter -> 'a array -> unit - (** Print the contents of an array, with [first] preceeding the first item + (** Print the contents of an array, with [first] preceding the first item (default: ["\[|"]), [last] following the last item (default: ["|\]"]) and [sep] separating items (default: ["; "]). A printing function must be provided to print the items in the array. The [flush] parameter @@ -961,7 +973,7 @@ module Incubator : sig ?sep:string -> ?indent:int -> (Format.formatter -> 'a -> 'b) -> Format.formatter -> 'a BatEnum.t -> unit - (** Print the contents of an enum, with [first] preceeding the first item + (** Print the contents of an enum, with [first] preceding the first item (default: [""]), [last] following the last item (default: [""]) and [sep] separating items (default: [" "]). A printing function must be provided to print the items in the enum. The [flush] parameter @@ -981,7 +993,7 @@ module Incubator : sig ?sep:string -> ?indent:int -> (Format.formatter -> 'a -> 'b) -> Format.formatter -> 'a list -> unit - (** Print the contents of a list, with [first] preceeding the first item + (** Print the contents of a list, with [first] preceding the first item (default: ["\["]), [last] following the last item (default: ["\]"]) and [sep] separating items (default: ["; "]). A printing function must be provided to print the items in the list. The [flush] parameter diff --git a/src/batISet.ml b/src/batISet.ml index 269e0fda7..c9422e398 100644 --- a/src/batISet.ml +++ b/src/batISet.ml @@ -86,7 +86,7 @@ let before n s = if n = min_int then empty else until (n - 1) s *) let add_range n1 n2 s = - if n1 > n2 then invalid_arg (Printf.sprintf "ISet.add_range - %d > %d" n1 n2) else + if n1 > n2 then Printf.ksprintf invalid_arg "ISet.add_range - %d > %d" n1 n2 else let n1, l = if n1 = min_int then n1, empty else let l = until (n1 - 1) s in diff --git a/src/batInnerIO.ml b/src/batInnerIO.ml index e67a849a7..9d447bfaa 100644 --- a/src/batInnerIO.ml +++ b/src/batInnerIO.ml @@ -28,7 +28,7 @@ let weak_iter f s = BatInnerWeaktbl.iter (fun x _ -> f x) s type input = { mutable in_read : unit -> char; - mutable in_input : string -> int -> int -> int; + mutable in_input : Bytes.t -> int -> int -> int; mutable in_close : unit -> unit; in_id: int;(**A unique identifier.*) in_upstream: input weak_set @@ -36,7 +36,7 @@ type input = { type 'a output = { mutable out_write : char -> unit; - mutable out_output: string -> int -> int -> int; + mutable out_output: Bytes.t -> int -> int -> int; mutable out_close : unit -> 'a; mutable out_flush : unit -> unit; out_id: int;(**A unique identifier.*) @@ -217,14 +217,14 @@ let nread i n = p := !p + r; l := !l - r; done; - s + Bytes.unsafe_to_string s with No_more_input as e -> if !p = 0 then raise e; - String.sub s 0 !p + Bytes.sub_string s 0 !p let really_output o s p l' = - let sl = String.length s in + let sl = Bytes.length s in if p + l' > sl || p < 0 || l' < 0 then invalid_arg "BatIO.really_output"; let l = ref l' in let p = ref p in @@ -236,8 +236,11 @@ let really_output o s p l' = done; l' +let really_output_substring o s p l' = + really_output o (Bytes.of_string s) p l' + let input i s p l = - let sl = String.length s in + let sl = Bytes.length s in if p + l > sl || p < 0 || l < 0 then invalid_arg "BatIO.input"; if l = 0 then 0 @@ -245,7 +248,7 @@ let input i s p l = i.in_input s p l let really_input i s p l' = - let sl = String.length s in + let sl = Bytes.length s in if p + l' > sl || p < 0 || l' < 0 then invalid_arg "BatIO.really_input"; let l = ref l' in let p = ref p in @@ -264,14 +267,13 @@ let really_nread i n = let s = Bytes.create n in ignore(really_input i s 0 n); - s - + Bytes.unsafe_to_string s let write o x = o.out_write x -let nwrite o s = +let nwrite_bytes o s = let p = ref 0 in - let l = ref (String.length s) in + let l = ref (Bytes.length s) in while !l > 0 do let w = o.out_output s !p !l in (* FIXME: unknown how many characters were already written *) @@ -280,11 +282,16 @@ let nwrite o s = l := !l - w; done +let nwrite o s = nwrite_bytes o (Bytes.unsafe_of_string s) + let output o s p l = - let sl = String.length s in + let sl = Bytes.length s in if p + l > sl || p < 0 || l < 0 then invalid_arg "BatIO.output"; o.out_output s p l +let output_substring o s p l = + output o (Bytes.unsafe_of_string s) p l + let flush o = o.out_flush() let flush_all () = @@ -313,9 +320,9 @@ let read_all i = | Input_closed -> let buf = Bytes.create !pos in List.iter (fun (s,p) -> - String.unsafe_blit s 0 buf p (String.length s) + Bytes.blit_string s 0 buf p (String.length s) ) !str; - buf + Bytes.unsafe_to_string buf let input_string s = let pos = ref 0 in @@ -327,7 +334,7 @@ let input_string s = ~input:(fun sout p l -> if !pos >= len then raise No_more_input; let n = (if !pos + l > len then len - !pos else l) in - String.unsafe_blit s (post pos ( (+) n ) ) sout p n; + Bytes.blit_string s (post pos ( (+) n ) ) sout p n; n ) ~close:noop @@ -349,7 +356,7 @@ let output_string() = let b = Buffer.create default_buffer_size in create_out ~write: (fun c -> Buffer.add_char b c ) - ~output: (fun s p l -> Buffer.add_substring b s p l; l ) + ~output: (fun s p l -> BatBytesCompat.buffer_add_subbytes b s p l; l ) ~close: (fun () -> Buffer.contents b) ~flush: noop @@ -416,8 +423,11 @@ let pipe() = in let input s p l = if !inpos = String.length !input then flush(); - let r = (if !inpos + l > String.length !input then String.length !input - !inpos else l) in - String.unsafe_blit !input !inpos s p r; + let r = + if !inpos + l <= String.length !input + then l + else String.length !input - !inpos in + Bytes.blit_string !input !inpos s p r; inpos := !inpos + r; r in @@ -425,7 +435,7 @@ let pipe() = Buffer.add_char output c in let output s p l = - Buffer.add_substring output s p l; + BatBytesCompat.buffer_add_subbytes output s p l; l in let input = create_in ~read ~input ~close:noop @@ -571,6 +581,9 @@ let write_string o s = nwrite o s; write o '\000' +let write_bytes o b = + nwrite o b + let write_line o s = nwrite o s; write o '\n' diff --git a/src/batInnerIO.mli b/src/batInnerIO.mli index 9130f8536..50d4f8da7 100644 --- a/src/batInnerIO.mli +++ b/src/batInnerIO.mli @@ -57,7 +57,7 @@ val read_all : input -> string (** read all the contents of the input until [No_more_input] is raised. *) val pipe : unit -> input * unit output -(** Create a pipe between an input and an ouput. Data written from +(** Create a pipe between an input and an output. Data written from the output can be read from the input. *) val nread : input -> int -> string @@ -70,19 +70,21 @@ val really_nread : input -> int -> string from the input. @raise No_more_input if at least [n] characters are not available. @raise Invalid_argument if [n] < 0. *) -val input : input -> string -> int -> int -> int -(** [input i s p l] reads up to [l] characters from the given input, storing - them in string [s], starting at character number [p]. It returns the actual - number of characters read or raise [No_more_input] if no character can be - read. It will raise [Invalid_argument] if [p] and [l] do not designate a - valid substring of [s]. *) - -val really_input : input -> string -> int -> int -> int -(** [really_input i s p l] reads exactly [l] characters from the given input, - storing them in the string [s], starting at position [p]. For consistency with - {!BatIO.input} it returns [l]. @raise No_more_input if at [l] characters are - not available. @raise Invalid_argument if [p] and [l] do not designate a - valid substring of [s]. *) +val input : input -> Bytes.t -> int -> int -> int +(** [input i s p len] reads up to [len] bytes from the given input, + storing them in byte sequence [s], starting at position [p]. It + returns the actual number of bytes read or raise + [No_more_input] if no character can be read. It will raise + [Invalid_argument] if [p] and [len] do not designate a valid + subsequence of [s]. *) + +val really_input : input -> Bytes.t -> int -> int -> int +(** [really_input i s p len] reads exactly [len] characters from the + given input, storing them in the byte sequence [s], starting at + position [p]. For consistency with {!BatIO.input} it returns + [len]. @raise No_more_input if at least [len] characters are not + available. @raise Invalid_argument if [p] and [len] do not designate + a valid subsequence of [s]. *) val close_in : input -> unit (** Close the input. It can no longer be read from. *) @@ -97,16 +99,35 @@ val write : 'a output -> char -> unit val nwrite : 'a output -> string -> unit (** Write a string to an output. *) -val output : 'a output -> string -> int -> int -> int -(** [output o s p l] writes up to [l] characters from string [s], starting at - offset [p]. It returns the number of characters written. It will raise - [Invalid_argument] if [p] and [l] do not designate a valid substring of [s]. *) +val nwrite_bytes : 'a output -> Bytes.t -> unit +(** Write a byte sequence to an output. + + @since 2.8.0 *) + +val output : 'a output -> Bytes.t -> int -> int -> int +(** [output o s p len] writes up to [len] characters from byte + sequence [len], starting at offset [p]. It returns the number of + characters written. It will raise [Invalid_argument] if [p] and + [len] do not designate a valid subsequence of [s]. *) + +val output_substring : 'a output -> string -> int -> int -> int +(** like [output] above, but outputs from a substring instead of + a subsequence of bytes + + @since 2.8.0 *) + +val really_output : 'a output -> Bytes.t -> int -> int -> int +(** [really_output o s p len] writes exactly [len] characters from + byte sequence [s] onto the the output, starting with the character + at offset [p]. For consistency with {!BatIO.output} it returns + [len]. @raise Invalid_argument if [p] and [len] do not designate + a valid subsequence of [s]. *) + +val really_output_substring : 'a output -> string -> int -> int -> int +(** like [really_output] above, but outputs from a substring instead + of a subsequence of bytes -val really_output : 'a output -> string -> int -> int -> int -(** [really_output o s p l] writes exactly [l] characters from string [s] onto - the the output, starting with the character at offset [p]. For consistency with - {!BatIO.output} it returns [l]. @raise Invalid_argument if [p] and [l] do not - designate a valid substring of [s]. *) + @since 2.8.0 *) val flush : 'a output -> unit (** Flush an output. *) @@ -136,7 +157,7 @@ val on_close_out : 'a output -> ('a output -> unit) -> unit val create_in : read:(unit -> char) -> - input:(string -> int -> int -> int) -> + input:(Bytes.t -> int -> int -> int) -> close:(unit -> unit) -> input (** Fully create an input by giving all the needed functions. @@ -147,7 +168,7 @@ val create_in : val inherit_in: ?read:(unit -> char) -> - ?input:(string -> int -> int -> int) -> + ?input:(Bytes.t -> int -> int -> int) -> ?close:(unit -> unit) -> input -> input (** @@ -158,7 +179,7 @@ val inherit_in: val wrap_in : read:(unit -> char) -> - input:(string -> int -> int -> int) -> + input:(Bytes.t -> int -> int -> int) -> close:(unit -> unit) -> underlying:(input list) -> input @@ -173,7 +194,7 @@ val wrap_in : val create_out : write:(char -> unit) -> - output:(string -> int -> int -> int) -> + output:(Bytes.t -> int -> int -> int) -> flush:(unit -> unit) -> close:(unit -> 'a) -> 'a output @@ -192,7 +213,7 @@ val create_out : val inherit_out: ?write:(char -> unit) -> - ?output:(string -> int -> int -> int) -> + ?output:(Bytes.t -> int -> int -> int) -> ?flush:(unit -> unit) -> ?close:(unit -> unit) -> _ output -> unit output @@ -204,7 +225,7 @@ val inherit_out: val wrap_out : write:(char -> unit) -> - output:(string -> int -> int -> int) -> + output:(Bytes.t -> int -> int -> int) -> flush:(unit -> unit) -> close:(unit -> 'a) -> underlying:('b output list) -> @@ -437,7 +458,7 @@ external noop : unit -> unit = "%ignore" {7 Optimized access to fields} *) -val get_output : _ output -> (string -> int -> int -> int) +val get_output : _ output -> (Bytes.t -> int -> int -> int) val get_flush : _ output -> (unit -> unit) val lock : BatConcurrent.lock ref diff --git a/src/batInnerShuffle.ml b/src/batInnerShuffle.ml new file mode 100644 index 000000000..4bcda8672 --- /dev/null +++ b/src/batInnerShuffle.ml @@ -0,0 +1,34 @@ +let array_shuffle ?state a = + let random_int state n = match state with + | None -> Random.int n + | Some s -> Random.State.int s n in + for n = Array.length a - 1 downto 1 do + let k = random_int state (n + 1) in + if k <> n then begin + let buf = Array.unsafe_get a n in + Array.unsafe_set a n (Array.unsafe_get a k); + Array.unsafe_set a k buf + end + done + +(*$Q + Q.(array_of_size Gen.(2--15) small_int) (fun a -> \ + let a' = Array.copy a in \ + array_shuffle a'; \ + (Array.to_list a' |> List.sort Pervasives.compare) = \ + (Array.to_list a |> List.sort Pervasives.compare)) +*) + +(*$R + let rec fact = function 0 -> 1 | n -> n * fact (n - 1) in + let length = 5 in + let test = Array.init length (fun i -> i) in (* all elements must be distinct *) + let permut_number = fact length in + let histogram = Hashtbl.create permut_number in + for i = 1 to 50_000 do + let a = Array.copy test in + array_shuffle a; + Hashtbl.replace histogram a (); + done; + assert_bool "all permutations occur" (Hashtbl.length histogram = permut_number) +*) diff --git a/src/batInnerWeaktbl.mli b/src/batInnerWeaktbl.mliv similarity index 84% rename from src/batInnerWeaktbl.mli rename to src/batInnerWeaktbl.mliv index 7239f0e1e..69ed66298 100644 --- a/src/batInnerWeaktbl.mli +++ b/src/batInnerWeaktbl.mliv @@ -101,8 +101,42 @@ val length : ('a, 'b) t -> int (** {6 Functorial interface} *) - -module Make (H : Hashtbl.HashedType) : Hashtbl.S with type key = H.t +module type HashedType = sig + type t + + val equal : t -> t -> bool + + val hash : t -> int +end + +module type S = sig + type key + type 'a t + val create : int -> 'a t + val clear : 'a t -> unit + val reset : 'a t -> unit + + val copy : 'a t -> 'a t + val add : 'a t -> key -> 'a -> unit + val remove : 'a t -> key -> unit + val find : 'a t -> key -> 'a + val find_opt : 'a t -> key -> 'a option + + val find_all : 'a t -> key -> 'a list + val replace : 'a t -> key -> 'a -> unit + val mem : 'a t -> key -> bool + val iter : (key -> 'a -> unit) -> 'a t -> unit + val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit + + val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + val length : 'a t -> int +##V>=4## val stats: 'a t -> Hashtbl.statistics +end + +(** This is a subset of Hashtbl.S, kept as a separate interface to + avoid compatibility issues when Hashtbl.S evolves. *) + +module Make (H : HashedType) : S with type key = H.t (** Functor building an implementation of the hashtable structure. The functor [Weaktbl.Make] returns a structure containing a type [key] of keys and a type ['a t] of hash tables diff --git a/src/batInnerWeaktbl.ml b/src/batInnerWeaktbl.mlv similarity index 87% rename from src/batInnerWeaktbl.ml rename to src/batInnerWeaktbl.mlv index e16b683b3..fff1a6d71 100644 --- a/src/batInnerWeaktbl.ml +++ b/src/batInnerWeaktbl.mlv @@ -45,7 +45,7 @@ module Stack = struct let len = length s in if len >= s.length / 3 && len < s.length * 2 / 3 then push x s else let len' = min (len * 3 / 2 + 2) (Sys.max_array_length -1) in - if len' = len then failwith "Weaktbl.Stack.push: stack cannnot grow" + if len' = len then failwith "Weaktbl.Stack.push: stack cannot grow" else let data' = Weak.create len' in Weak.blit s.data 0 data' 0 s.cursor; @@ -62,8 +62,40 @@ module Stack = struct try iter (fun _ -> raise Not_found) s; true with Not_found -> false end +module type HashedType = sig + type t + + val equal : t -> t -> bool + + val hash : t -> int +end + +module type S = sig + type key + type 'a t + val create : int -> 'a t + val clear : 'a t -> unit + val reset : 'a t -> unit + + val copy : 'a t -> 'a t + val add : 'a t -> key -> 'a -> unit + val remove : 'a t -> key -> unit + val find : 'a t -> key -> 'a + val find_opt : 'a t -> key -> 'a option + + val find_all : 'a t -> key -> 'a list + val replace : 'a t -> key -> 'a -> unit + val mem : 'a t -> key -> bool + val iter : (key -> 'a -> unit) -> 'a t -> unit + val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit + + val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + val length : 'a t -> int +##V>=4## val stats: 'a t -> Hashtbl.statistics +end + open Obj (* Recover polymorphism from standard monomorphic (Weak)Hashtbl *) -module Make (H: Hashtbl.HashedType) : Hashtbl.S with type key = H.t = struct +module Make (H: HashedType) : S with type key = H.t = struct type box = H.t Weak.t let enbox k = let w = Weak.create 1 in Weak.set w 0 (Some k); w let unbox bk = Weak.get bk 0 @@ -95,6 +127,7 @@ module Make (H: Hashtbl.HashedType) : Hashtbl.S with type key = H.t = struct let find_all tbl key = try all_value (W.find tbl (dummy key)) with Not_found-> [] let find tbl key = top_value (W.find tbl (dummy key)) + let find_opt tbl key = try Some (find tbl key) with Not_found -> None let add tbl key data = let bd = bind_new key data in let cls = diff --git a/src/batInt.ml b/src/batInt.ml index 340bea068..0a607f8f1 100644 --- a/src/batInt.ml +++ b/src/batInt.ml @@ -57,7 +57,7 @@ module BaseInt = struct let pow a b = if b < 0 - then raise (Invalid_argument "Int.pow") + then invalid_arg "Int.pow" else let div_two n = n / 2 and mod_two n = n mod 2 @@ -253,25 +253,20 @@ module BaseSafeInt = struct | 32 -> 15 (* 32 = sign bit + 15*2 + tag bit *) | _ -> 0 + (* Uses a formula taken from Hacker's Delight, chapter "Overflow Detection", + plus a fast-path check (see comment above) *) let mul (a: int) (b: int) : int = let open Pervasives in - if ((abs a) lor (abs b)) asr mul_shift_bits <> 0 - then begin match (a > 0, b > 0) with - | (true, true) when a > (max_int / b) -> - raise BatNumber.Overflow - | (true, false) when b < (min_int / a) -> - raise BatNumber.Overflow - | (false, true) when a < (min_int / b) -> - raise BatNumber.Overflow - | (false, false) when a <> 0 && (b < (max_int / a)) -> - raise BatNumber.Overflow - | _ -> () - end; - a * b + let c = a * b in + if (a lor b) asr mul_shift_bits = 0 + || not ((a = min_int && b < 0) || (b <> 0 && c / b <> a)) then + c + else + raise BatNumber.Overflow let pow a b = if b < 0 - then raise (Invalid_argument "Safe_int.pow") + then invalid_arg "Int.Safe_int.pow" else let div_two n = n / 2 and mod_two n = n mod 2 diff --git a/src/batInt.mli b/src/batInt.mli index 7f11522dc..f12e17d28 100644 --- a/src/batInt.mli +++ b/src/batInt.mli @@ -262,10 +262,10 @@ module Safe_int : sig (** Addition. *) val sub : t -> t -> t - (** Substraction. *) + (** Subtraction. *) val ( - ) : t -> t -> t - (** Substraction. *) + (** Subtraction. *) val mul : t -> t -> t (** Multiplication. *) @@ -307,23 +307,23 @@ module Safe_int : sig (** [a ** b] computes a{^b}*) val ( <> ) : t -> t -> bool - (** Comparaison: [a <> b] is true if and only if [a] and [b] have + (** Comparison: [a <> b] is true if and only if [a] and [b] have different values. *) val ( > ) : t -> t -> bool - (** Comparaison: [a > b] is true if and only if [a] is strictly greater than [b].*) + (** Comparison: [a > b] is true if and only if [a] is strictly greater than [b].*) val ( < ) : t -> t -> bool - (** Comparaison: [a < b] is true if and only if [a] is strictly smaller than [b].*) + (** Comparison: [a < b] is true if and only if [a] is strictly smaller than [b].*) val ( >= ) : t -> t -> bool - (** Comparaison: [a >= b] is true if and only if [a] is greater or equal to [b].*) + (** Comparison: [a >= b] is true if and only if [a] is greater or equal to [b].*) val ( <= ) : t -> t -> bool - (** Comparaison: [a <= b] is true if and only if [a] is smaller or equalto [b].*) + (** Comparison: [a <= b] is true if and only if [a] is smaller or equalto [b].*) val ( = ) : t -> t -> bool - (** Comparaison: [a = b] if and only if [a] and [b] have the same value.*) + (** Comparison: [a = b] if and only if [a] and [b] have the same value.*) val max_num : t (** The greatest representable integer, which is either 2{^30}-1 or 2{^62}-1. *) diff --git a/src/batInt32.mliv b/src/batInt32.mliv index ee6173558..b1f2ea618 100644 --- a/src/batInt32.mliv +++ b/src/batInt32.mliv @@ -75,12 +75,23 @@ external div : int32 -> int32 -> int32 = "%int32_div" its arguments towards zero, as specified for {!Pervasives.(/)}. @raise Division_by_zero if the second argument is zero. *) +##V>=4.08##val unsigned_div : int32 -> int32 -> int32 +##V>=4.08##(** Same as {!div}, except that arguments and result are interpreted as {e +##V>=4.08## unsigned} 32-bit integers. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + external rem : int32 -> int32 -> int32 = "%int32_mod" (** Integer remainder. If [y] is not zero, the result of [Int32.rem x y] satisfies the following property: [x = Int32.add (Int32.mul (Int32.div x y) y) (Int32.rem x y)]. @raise Division_by_zero if the second argument is zero. *) +##V>=4.08##val unsigned_rem : int32 -> int32 -> int32 +##V>=4.08##(** Same as {!rem}, except that arguments and result are interpreted as {e +##V>=4.08## unsigned} 32-bit integers. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) val modulo : int32 -> int32 -> int32 val pow : int32 -> int32 -> int32 @@ -154,6 +165,13 @@ external to_int : int32 -> int = "%int32_to_int" during the conversion. On 64-bit platforms, the conversion is exact. *) +##V>=4.08##val unsigned_to_int : int32 -> int option +##V>=4.08##(** Same as {!to_int}, but interprets the argument as an {e unsigned} integer. +##V>=4.08## Returns [None] if the unsigned value of the argument cannot fit into an +##V>=4.08## [int]. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + external of_float : float -> int32 = "caml_int32_of_float" ##V>=4.3## "caml_int32_of_float_unboxed" [@@unboxed] [@@noalloc] (** Convert the given floating-point number to a 32-bit integer, @@ -175,12 +193,12 @@ external to_int64 : int32 -> int64 = "%int64_of_int32" (** Convert the given 32-bit integer (type [int32]) to a 64-bit integer (type [int64]). *) -external of_nativeint : nativeint -> int32 = "%int32_of_nativeint" +external of_nativeint : nativeint -> int32 = "%nativeint_to_int32" (** Convert the given native integer (type [nativeint]) to a 32-bit integer (type [int32]). On 64-bits platform the top 32 bits are lost. *) -external to_nativeint : int32 -> nativeint = "%int32_to_nativeint" +external to_nativeint : int32 -> nativeint = "%nativeint_of_int32" (** Convert the given 32-bit integer (type [int32]) to a native integer. *) @@ -193,6 +211,10 @@ external of_string : string -> int32 = "caml_int32_of_string" a valid representation of an integer, or if the integer represented exceeds the range of integers representable in type [int32]. *) +val of_string_opt: string -> int32 option +(** Same as [of_string], but return [None] instead of raising. + @since 2.7.0 *) + val to_string : int32 -> string (** Return the string representation of its argument, in signed decimal. *) @@ -213,20 +235,20 @@ external float_of_bits : int32 -> float = "caml_int32_float_of_bits" val of_byte : char -> int32 val to_byte : int32 -> char -val pack : string -> int -> int32 -> unit -(** [pack str off i] writes the little endian bit representation - of [i] into string [str] at offset [off] *) +val pack : Bytes.t -> int -> int32 -> unit +(** [pack s off i] writes the little endian bit representation + of [i] into byte sequence [s] at offset [off] *) -val pack_big : string -> int -> int32 -> unit -(** [pack_big str off i] writes the big endian bit - representation of [i] into string [str] at offset [off] *) +val pack_big : Bytes.t -> int -> int32 -> unit +(** [pack_big s off i] writes the big endian bit + representation of [i] into byte sequence [s] at offset [off] *) -val unpack : string -> int -> int32 -(** [unpack str off] reads 4 bytes from string [str] starting at +val unpack : Bytes.t -> int -> int32 +(** [unpack s off] reads 4 bytes from byte sequence [str] starting at offset [off] as a little-endian int32 *) -val unpack_big : string -> int -> int32 -(** [unpack str off] reads 4 bytes from string [str] starting at +val unpack_big : Bytes.t -> int -> int32 +(** [unpack s off] reads 4 bytes from byte sequence [str] starting at offset [off] as a big-endian int32 *) val compare : t -> t -> int @@ -235,6 +257,12 @@ val compare : t -> t -> int allows the module [Int32] to be passed as argument to the functors {!Set.Make} and {!Map.Make}. *) +##V>=4.08##val unsigned_compare: t -> t -> int +##V>=4.08##(** Same as {!compare}, except that arguments are interpreted as {e unsigned} +##V>=4.08## 32-bit integers. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + val equal : t -> t -> bool (** Equality function for 32-bit integers, useful for {!HashedType}. *) diff --git a/src/batInt32.mlv b/src/batInt32.mlv index 85bcd8306..a0240b8de 100644 --- a/src/batInt32.mlv +++ b/src/batInt32.mlv @@ -37,7 +37,7 @@ let of_byte b = Char.code b |> Int32.of_int (* really need to just blit an int32 word into a string and vice versa *) let pack str pos item = - if String.length str < pos + 4 then invalid_arg "Int32.pack: pos too close to end of string"; + if Bytes.length str < pos + 4 then invalid_arg "Int32.pack: pos too close to end of string"; if pos < 0 then invalid_arg "Int32.pack: pos negative"; Bytes.set str pos (to_byte item); let item = Int32.shift_right item 8 in @@ -48,16 +48,18 @@ let pack str pos item = Bytes.set str (pos + 3) (to_byte item) (* optimize out last logand? *) (*$T pack - let str = " " in pack str 0 0l; (str = "\000\000\000\000") - let str = " " in pack str 0 0l; (str = "\000\000\000\000 ") - let str = " " in pack str 1 0l; (str = " \000\000\000\000") - let str = " " in try pack str 0 0l; false with Invalid_argument _ -> true - let str = " " in try pack str 1 0l; false with Invalid_argument _ -> true + let str = Bytes.of_string " " in pack str 0 0l; (Bytes.to_string str = "\000\000\000\000") + let str = Bytes.of_string " " in pack str 0 0l; (Bytes.to_string str = "\000\000\000\000 ") + let str = Bytes.of_string " " in pack str 1 0l; (Bytes.to_string str = " \000\000\000\000") + let str = Bytes.of_string " " in try pack str 0 0l; false with Invalid_argument _ -> true + let str = Bytes.of_string " " in try pack str 1 0l; false with Invalid_argument _ -> true *) let pack_big str pos item = - if String.length str < pos + 4 then invalid_arg "Int32.pack_big: pos too close to end of string"; - if pos < 0 then invalid_arg "Int32.pack_big: pos negative"; + if Bytes.length str < pos + 4 then + invalid_arg "Int32.pack_big: pos too close to end of string"; + if pos < 0 then + invalid_arg "Int32.pack_big: pos negative"; Bytes.set str (pos + 3) (to_byte item); let item = Int32.shift_right item 8 in Bytes.set str (pos + 2) (to_byte item); @@ -67,51 +69,58 @@ let pack_big str pos item = Bytes.set str pos (to_byte item) (* optimize out last logand? *) (*$T pack_big - let str = " " in pack_big str 0 0l; (str = "\000\000\000\000") - let str = " " in pack_big str 0 0l; (str = "\000\000\000\000 ") - let str = " " in pack_big str 1 0l; (str = " \000\000\000\000") - let str = " " in try pack_big str 0 0l; false with Invalid_argument _ -> true - let str = " " in try pack_big str 1 0l; false with Invalid_argument _ -> true + let str = Bytes.of_string " " in pack_big str 0 0l; (Bytes.to_string str = "\000\000\000\000") + let str = Bytes.of_string " " in pack_big str 0 0l; (Bytes.to_string str = "\000\000\000\000 ") + let str = Bytes.of_string " " in pack_big str 1 0l; (Bytes.to_string str = " \000\000\000\000") + let str = Bytes.of_string " " in try pack_big str 0 0l; false with Invalid_argument _ -> true + let str = Bytes.of_string " " in try pack_big str 1 0l; false with Invalid_argument _ -> true *) let unpack str pos = - if String.length str < pos + 4 then invalid_arg "Int32.unpack: pos + 4 not within string"; + if Bytes.length str < pos + 4 + then invalid_arg "Int32.unpack: pos + 4 not within string"; if pos < 0 then invalid_arg "Int32.unpack: pos negative"; let shift n = Int32.shift_left n 8 and add b n = Int32.add (of_byte b) n in - of_byte str.[pos+3] |> shift |> add str.[pos+2] |> shift - |> add str.[pos+1] |> shift |> add str.[pos] + of_byte (Bytes.unsafe_get str (pos+3)) |> shift + |> add (Bytes.unsafe_get str (pos+2)) |> shift + |> add (Bytes.unsafe_get str (pos+1)) |> shift + |> add (Bytes.unsafe_get str pos) (* TODO: improve performance of bit twiddling? will these curried functions get inlined? *) (*$T unpack - unpack "\000\000\000\000" 0 = 0l - unpack "\000\000\000\000 " 0 = 0l - unpack " \000\000\000\000" 1 = 0l - unpack "\255\000\000\000" 0 = 255l + unpack (Bytes.of_string "\000\000\000\000") 0 = 0l + unpack (Bytes.of_string "\000\000\000\000 ") 0 = 0l + unpack (Bytes.of_string " \000\000\000\000") 1 = 0l + unpack (Bytes.of_string "\255\000\000\000") 0 = 255l *) (*$Q pack; unpack - Q.int (let str = " " in fun x -> let x = Int32.of_int x in pack str 0 x; unpack str 0 = x) + Q.int (let str = Bytes.of_string " " in fun x -> let x = Int32.of_int x in pack str 0 x; unpack str 0 = x) *) let unpack_big str pos = - if String.length str < pos + 4 then invalid_arg "Int32.unpack: pos + 4 not within string"; - if pos < 0 then invalid_arg "Int32.unpack: pos negative"; + if Bytes.length str < pos + 4 then + invalid_arg "Int32.unpack_big: pos + 4 not within string"; + if pos < 0 then + invalid_arg "Int32.unpack_big: pos negative"; let shift n = Int32.shift_left n 8 and add b n = Int32.add (of_byte b) n in - of_byte str.[pos] |> shift |> add str.[pos+1] |> shift - |> add str.[pos+2] |> shift |> add str.[pos+3] + of_byte (Bytes.unsafe_get str pos) |> shift + |> add (Bytes.unsafe_get str (pos+1)) |> shift + |> add (Bytes.unsafe_get str (pos+2)) |> shift + |> add (Bytes.unsafe_get str (pos+3)) (*$T unpack_big - unpack_big "\000\000\000\000" 0 = 0l - unpack_big "\000\000\000\000 " 0 = 0l - unpack_big " \000\000\000\000 " 1 = 0l - unpack_big "\000\000\000\255" 0 = 255l + unpack_big (Bytes.of_string "\000\000\000\000") 0 = 0l + unpack_big (Bytes.of_string "\000\000\000\000 ") 0 = 0l + unpack_big (Bytes.of_string " \000\000\000\000 ") 1 = 0l + unpack_big (Bytes.of_string "\000\000\000\255") 0 = 255l *) (*$Q pack_big; unpack_big - Q.int (let str = " " in fun x -> let x = Int32.of_int x in pack_big str 0 x; unpack_big str 0 = x) + Q.int (let str = Bytes.of_string " " in fun x -> let x = Int32.of_int x in pack_big str 0 x; unpack_big str 0 = x) *) module BaseInt32 = struct @@ -146,10 +155,12 @@ external of_float : float -> int32 = "caml_int32_of_float" external to_float : int32 -> float = "caml_int32_to_float" ##V>=4.3## "caml_int32_to_float_unboxed" [@@unboxed] [@@noalloc] external of_string : string -> int32 = "caml_int32_of_string" +##V>=4.5##let of_string_opt = Int32.of_string_opt +##V<4.5##let of_string_opt n = try Some (Int32.of_string n) with _ -> None external of_int64 : int64 -> int32 = "%int64_to_int32" external to_int64 : int32 -> int64 = "%int64_of_int32" -external of_nativeint : nativeint -> int32 = "%int32_of_nativeint" -external to_nativeint : int32 -> nativeint = "%int32_to_nativeint" +external of_nativeint : nativeint -> int32 = "%nativeint_to_int32" +external to_nativeint : int32 -> nativeint = "%nativeint_of_int32" external bits_of_float : float -> int32 = "caml_int32_bits_of_float" ##V>=4.3## "caml_int32_bits_of_float_unboxed" [@@unboxed] [@@noalloc] @@ -157,8 +168,10 @@ external float_of_bits : int32 -> float = "caml_int32_float_of_bits" ##V>=4.3## "caml_int32_float_of_bits_unboxed" [@@unboxed] [@@noalloc] external format : string -> int32 -> string = "caml_int32_format" - - +##V>=4.08##let unsigned_div = Int32.unsigned_div +##V>=4.08##let unsigned_rem = Int32.unsigned_rem +##V>=4.08##let unsigned_to_int = Int32.unsigned_to_int +##V>=4.08##let unsigned_compare = Int32.unsigned_compare type bounded = t let min_num, max_num = min_int, max_int diff --git a/src/batInt64.mliv b/src/batInt64.mliv index 15c8f724d..581b8a8f6 100644 --- a/src/batInt64.mliv +++ b/src/batInt64.mliv @@ -77,12 +77,24 @@ external div : int64 -> int64 -> int64 = "%int64_div" its arguments towards zero, as specified for {!Pervasives.(/)}. @raise Division_by_zero if the second argument is zero. *) +##V>=4.08##val unsigned_div : int64 -> int64 -> int64 +##V>=4.08##(** Same as {!div}, except that arguments and result are interpreted as {e +##V>=4.08## unsigned} 64-bit integers. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + external rem : int64 -> int64 -> int64 = "%int64_mod" (** Integer remainder. If [y] is not zero, the result of [Int64.rem x y] satisfies the following property: [x = Int64.add (Int64.mul (Int64.div x y) y) (Int64.rem x y)]. @raise Division_by_zero if the second argument is zero. *) +##V>=4.08##val unsigned_rem : int64 -> int64 -> int64 +##V>=4.08##(** Same as {!rem}, except that arguments and result are interpreted as {e +##V>=4.08## unsigned} 64-bit integers. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + val succ : int64 -> int64 (** Successor. [Int64.succ x] is [Int64.add x Int64.one]. *) @@ -150,6 +162,13 @@ external to_int : int64 -> int = "%int64_to_int" is taken modulo 2{^31}, i.e. the top 33 bits are lost during the conversion. *) +##V>=4.08##val unsigned_to_int : int64 -> int option +##V>=4.08##(** Same as {!to_int}, but interprets the argument as an {e unsigned} integer. +##V>=4.08## Returns [None] if the unsigned value of the argument cannot fit into an +##V>=4.08## [int]. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + external of_float : float -> int64 = "caml_int64_of_float" ##V>=4.3## "caml_int64_of_float_unboxed" [@@unboxed] [@@noalloc] (** Convert the given floating-point number to a 64-bit integer, @@ -191,6 +210,10 @@ external of_string : string -> int64 = "caml_int64_of_string" a valid representation of an integer, or if the integer represented exceeds the range of integers representable in type [int64]. *) +val of_string_opt: string -> int64 option +(** Same as [of_string], but return [None] instead of raising. + @since 2.7.0 *) + val to_string : int64 -> string (** Return the string representation of its argument, in decimal. *) @@ -216,6 +239,12 @@ val compare : t -> t -> int allows the module [Int64] to be passed as argument to the functors {!Set.Make} and {!Map.Make}. *) +##V>=4.08##val unsigned_compare: t -> t -> int +##V>=4.08##(** Same as {!compare}, except that arguments are interpreted as {e unsigned} +##V>=4.08## 64-bit integers. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + val equal : t -> t -> bool (** Equality function for 64-bit integers, useful for {!HashedType}. *) diff --git a/src/batInt64.mlv b/src/batInt64.mlv index 93b00aec1..b6d8c5575 100644 --- a/src/batInt64.mlv +++ b/src/batInt64.mlv @@ -56,12 +56,18 @@ external to_int32 : int64 -> int32 = "%int64_to_int32" external of_nativeint : nativeint -> int64 = "%int64_of_nativeint" external to_nativeint : int64 -> nativeint = "%int64_to_nativeint" external of_string : string -> int64 = "caml_int64_of_string" +##V>=4.5##let of_string_opt = Int64.of_string_opt +##V<4.5##let of_string_opt n = try Some (Int64.of_string n) with _ -> None external bits_of_float : float -> int64 = "caml_int64_bits_of_float" ##V>=4.3## "caml_int64_bits_of_float_unboxed" [@@unboxed] [@@noalloc] external float_of_bits : int64 -> float = "caml_int64_float_of_bits" ##V>=4.3## "caml_int64_float_of_bits_unboxed" [@@unboxed] [@@noalloc] external format : string -> int64 -> string = "caml_int64_format" +##V>=4.08##let unsigned_compare = Int64.unsigned_compare +##V>=4.08##let unsigned_to_int = Int64.unsigned_to_int +##V>=4.08##let unsigned_rem = Int64.unsigned_rem +##V>=4.08##let unsigned_div = Int64.unsigned_div let print out t = BatInnerIO.nwrite out (to_string t) let print_hex out t = BatPrintf.fprintf out "%Lx" t diff --git a/src/batLazyList.ml b/src/batLazyList.ml index 688e0d09c..6c4fe715e 100644 --- a/src/batLazyList.ml +++ b/src/batLazyList.ml @@ -74,14 +74,12 @@ let seq data next cond = else Nil in lazy (aux data) - let unfold (data:'b) (next: 'b -> ('a * 'b) option) = let rec aux data = match next data with | Some(a,b) -> Cons(a, lazy (aux b)) | None -> Nil in lazy (aux data) - let from_loop (data:'b) (next:'b -> ('a * 'b)) : 'a t= let f' data = try Some (next data) @@ -92,14 +90,14 @@ let init n f = let rec aux i = if i < n then lazy (Cons (f i, aux ( i + 1 ) ) ) else nil - in if n < 0 then raise (Invalid_argument "LazyList.init") + in if n < 0 then invalid_arg "LazyList.init" else aux 0 let make n x = let rec aux i = if i < n then lazy (Cons (x, aux ( i + 1 ) ) ) else nil - in if n < 0 then raise (Invalid_argument "LazyList.make") + in if n < 0 then invalid_arg "LazyList.make" else aux 0 (** @@ -619,6 +617,21 @@ let for_all2 p l1 l2 = | (Cons _, Nil) | (Nil, Cons _) -> raise (Different_list_size "LazyList.for_all2") in aux l1 l2 +let equal eq l1 l2 = + let rec aux l1 l2 = + match (next l1, next l2) with + | (Cons (h1, t1), Cons (h2, t2)) -> eq h1 h2 && (aux t1 t2) + | (Nil, Nil) -> true + | (Cons _, Nil) | (Nil, Cons _) -> false + in aux l1 l2 + +(*$T equal + equal (equal (=)) (init 3 (range 0)) (init 3 (range 0)) + not (equal (equal (=)) (of_list [(of_list [0; 1; 2])]) (of_list [(of_list [0; 42; 2])])) + not (equal (=) (range 0 2) (range 0 3)) + not (equal (=) (range 0 3) (range 0 2)) +*) + let exists2 p l1 l2 = let rec aux l1 l2 = match (next l1, next l2) with diff --git a/src/batLazyList.mli b/src/batLazyList.mli index 31e32d221..324f038b1 100644 --- a/src/batLazyList.mli +++ b/src/batLazyList.mli @@ -105,22 +105,39 @@ val from_while: (unit -> 'a option) -> 'a t results of [next]. The list ends whenever [next] returns [None]. *) -val from_loop: 'b -> ('b -> ('a * 'b)) -> 'a t -(**[from_loop data next] creates a (possibly infinite) lazy list from - the successive results of applying [next] to [data], then to the - result, etc. The list ends whenever the function raises - {!LazyList.No_more_elements}.*) - val seq: 'a -> ('a -> 'a) -> ('a -> bool) -> 'a t -(** [seq init step cond] creates a sequence of data, which starts - from [init], extends by [step], until the condition [cond] - fails. E.g. [seq 1 ((+) 1) ((>) 100)] returns [[^1, 2, ... 99^]]. If [cond - init] is false, the result is empty. *) +(**[seq data next cond] creates a lazy list from the successive results + of applying [next] to [data], then to the result, etc. The list + continues until the condition [cond] fails. For example, + [seq 1 ((+) 1) ((>) 100)] returns [[^1, 2, ... 99^]]. If [cond init] + is false, the result is empty. To create an infinite lazy list, pass + [(fun _ -> true)] as [cond]. *) val unfold: 'b -> ('b -> ('a * 'b) option) -> 'a t (**[unfold data next] creates a (possibly infinite) lazy list from the successive results of applying [next] to [data], then to the - result, etc. The list ends whenever the function returns [None]*) + result, etc. The list ends whenever [next] returns [None]. The function + [next] should return a pair [option] whose first element will be the + current value of the sequence; the second element will be passed + (lazily) to [next] in order to compute the following element. One example + of a use of [unfold] is to make each element of the resulting sequence to + depend on the previous two elements, as in this Fibonacci sequence + definition: + {[ + let data = (1, 1) + let next (x, y) = Some (x, (y, x + y)) + let fib = unfold data next + ]} + The first element [x] of the pair within [Some] will be the current + value of the sequence; the next value of the sequence, and the one after + that, are recorded as [y] and [x + y] respectively. *) + +val from_loop: 'b -> ('b -> ('a * 'b)) -> 'a t +(**[from_loop data next] creates a (possibly infinite) lazy list from + the successive results of applying [next] to [data], then to the + result, etc. The list ends whenever the function raises + {!LazyList.No_more_elements}. (For further information see [unfold]; + ignore references to [option] and [Some].) *) val init : int -> (int -> 'a) -> 'a t (** Similar to [Array.init], [init n f] returns the lazy list @@ -253,7 +270,7 @@ val find_exn : ('a -> bool) -> exn -> 'a t -> 'a returns [true] or raises [e] if such an element has not been found. *) val rfind_exn : ('a -> bool) -> exn -> 'a t -> 'a -(** [find_exn p e l] returns the last element of [l] such as [p x] +(** [rfind_exn p e l] returns the last element of [l] such as [p x] returns [true] or raises [e] if such an element has not been found. *) val findi : (int -> 'a -> bool) -> 'a t -> (int * 'a) @@ -262,7 +279,7 @@ val findi : (int -> 'a -> bool) -> 'a t -> (int * 'a) @raise Not_found if no such element has been found. *) val rfindi : (int -> 'a -> bool) -> 'a t -> (int * 'a) -(** [findi p e l] returns the last element [ai] of [l] along with its +(** [rfindi p e l] returns the last element [ai] of [l] along with its index [i] such that [p i ai] is true. @raise Not_found if no such element has been found. *) @@ -287,7 +304,9 @@ val rindex_ofq : 'a -> 'a t -> int option *) val next : 'a t -> 'a node_t -(**Compute and return the next value of the list*) +(** Compute and return the first node from the list as a [Cons]. This + differs from [hd], which returns the first element (the first component of + the first node). *) val length : 'a t -> int (**Return the length (number of elements) of the given list. @@ -563,6 +582,28 @@ val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool @raise Different_list_size if the two lists have different lengths. *) +val equal : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool +(** [equal eq s1 s2] compares elements of [s1] and [s2] pairwise using [eq] + and returns true if all elements pass the test and the lists have the same + length; otherwise it returns false. Examples: + + {[ + equal (=) (range 0 4) (range 0 4) (* true *) + + (* Make lazy lists of lazy lists: *) + let s1 = init 5 (range 0) + let s2 = init 5 (range 0) + equal (equal (=)) s1 s2 (* true *) + ]} + + (Calling [=] directly on a pair of lazy lists may succeed but is not + guaranteed to behave consistently.) + + Note that on lists of equal length, [equal] and [for_all2] can perform + the same function; their intended uses differ, however, as signaled by + behavior on lists of different lengths. +*) + val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool (** Same as {!exists}, but for a two-argument predicate. @raise Different_list_size if the two lists have @@ -604,7 +645,7 @@ val print : ?first:string -> ?last:string -> ?sep:string ->('a BatInnerIO.output module Exceptionless : sig val find : ('a -> bool) -> 'a t -> 'a option - (** [rfind p l] returns [Some x] where [x] is the first element of [l] such + (** [find p l] returns [Some x] where [x] is the first element of [l] such that [p x] returns [true] or [None] if such element as not been found. *) val rfind : ('a -> bool) -> 'a t -> 'a option @@ -617,7 +658,7 @@ module Exceptionless : sig or [None] if no such element has been found. *) val rfindi : (int -> 'a -> bool) -> 'a t -> (int * 'a) option - (** [findi p e l] returns [Some (i, ai)] where [ai] and [i] are respectively the + (** [rfindi p e l] returns [Some (i, ai)] where [ai] and [i] are respectively the last element of [l] and its index, such that [p i ai] is true, or [None] if no such element has been found. *) diff --git a/src/batLexing.mli b/src/batLexing.mliv similarity index 66% rename from src/batLexing.mli rename to src/batLexing.mliv index 9aec16122..a0c28d29e 100644 --- a/src/batLexing.mli +++ b/src/batLexing.mliv @@ -60,7 +60,7 @@ val dummy_pos : position;; type lexbuf = Lexing.lexbuf = { refill_buff : lexbuf -> unit; - mutable lex_buffer : string; + mutable lex_buffer : Bytes.t; mutable lex_buffer_len : int; mutable lex_abs_pos : int; mutable lex_start_pos : int; @@ -85,27 +85,60 @@ type lexbuf = Lexing.lexbuf = accurate, they must be initialised before the first use of the lexbuf, and updated by the relevant lexer actions (i.e. at each end of line -- see also [new_line]). -*) -val from_input : BatIO.input -> lexbuf -(** Create a lexer buffer on the given input - [Lexing.from_input inp] returns a lexer buffer which reads - from the input [inp], at the current reading position. *) - -val from_string : string -> lexbuf -(** Create a lexer buffer which reads from - the given string. Reading starts from the first character in - the string. An end-of-input condition is generated when the - end of the string is reached. *) - -val from_function : (string -> int -> int) -> lexbuf -(** Create a lexer buffer with the given function as its reading method. - When the scanner needs more characters, it will call the given - function, giving it a character string [s] and a character - count [n]. The function should put [n] characters or less in [s], - starting at character number 0, and return the number of characters - provided. A return value of 0 means end of input. *) + Note: Batteries does not currently support the ~with_positions:false + mode available since OCaml 4.08 to disable position tracking. If you + need this, please get in touch with the Batteries maintainers. +*) +##V<4.08##val from_input : BatIO.input -> lexbuf +##V<4.08##(** Create a lexer buffer on the given input +##V<4.08## [Lexing.from_input inp] returns a lexer buffer which reads +##V<4.08## from the input [inp], at the current reading position. *) + +##V<4.08##val from_string : string -> lexbuf +##V<4.08##(** Create a lexer buffer which reads from +##V<4.08## the given string. Reading starts from the first character in +##V<4.08## the string. An end-of-input condition is generated when the +##V<4.08## end of the string is reached. *) + +##V<4.08##val from_function : (Bytes.t -> int -> int) -> lexbuf +##V<4.08##(** Create a lexer buffer with the given function as its reading method. +##V<4.08## When the scanner needs more characters, it will call the given +##V<4.08## function, giving it a byte sequence [s] and a byte +##V<4.08## count [n]. The function should put [n] bytes or less in [s], +##V<4.08## starting at byte number 0, and return the number of byte +##V<4.08## provided. A return value of 0 means end of input. *) + +##V>=4.08##val from_channel : ?with_positions:bool -> in_channel -> lexbuf +##V>=4.08##(** Create a lexer buffer on the given input channel. +##V>=4.08## [Lexing.from_channel inchan] returns a lexer buffer which reads +##V>=4.08## from the input channel [inchan], at the current reading position. *) + +##V>=4.08##val from_string : ?with_positions:bool -> string -> lexbuf +##V>=4.08##(** Create a lexer buffer which reads from +##V>=4.08## the given string. Reading starts from the first character in +##V>=4.08## the string. An end-of-input condition is generated when the +##V>=4.08## end of the string is reached. *) + +##V>=4.08##val from_function : ?with_positions:bool -> (bytes -> int -> int) -> lexbuf +##V>=4.08##(** Create a lexer buffer with the given function as its reading method. +##V>=4.08## When the scanner needs more characters, it will call the given +##V>=4.08## function, giving it a byte sequence [s] and a byte +##V>=4.08## count [n]. The function should put [n] bytes or fewer in [s], +##V>=4.08## starting at index 0, and return the number of bytes +##V>=4.08## provided. A return value of 0 means end of input. *) + +##V>=4.08##val with_positions : lexbuf -> bool +##V>=4.08##(** Tell whether the lexer buffer keeps track of position fields +##V>=4.08## [lex_curr_p] / [lex_start_p], as determined by the corresponding +##V>=4.08## optional argument for functions that create lexer buffers +##V>=4.08## (whose default value is [true]). +##V>=4.08## +##V>=4.08## When [with_positions] is [false], lexer actions should not +##V>=4.08## modify position fields. Doing it nevertheless could +##V>=4.08## re-enable the [with_position] mode and degrade performances. +##V>=4.08##*) (** {6 Functions for lexer semantic actions} *) diff --git a/src/batLexing.ml b/src/batLexing.mlv similarity index 93% rename from src/batLexing.ml rename to src/batLexing.mlv index 499e99923..1426064fd 100644 --- a/src/batLexing.ml +++ b/src/batLexing.mlv @@ -22,6 +22,10 @@ open BatIO include Lexing + +let from_string = Lexing.from_string +let from_function = Lexing.from_function + let from_input inp = from_function (fun s n -> try input inp s 0 n with No_more_input -> 0) diff --git a/src/batList.mli b/src/batList.mliv similarity index 84% rename from src/batList.mli rename to src/batList.mliv index 1d10be905..560b4db63 100644 --- a/src/batList.mli +++ b/src/batList.mliv @@ -57,7 +57,9 @@ @author David Teller *) -type 'a t = 'a list +##V<4.08##type 'a t = 'a list +##V>=4.08##type 'a t = 'a list = [] | (::) of 'a * 'a list + (**The type of lists*) include BatEnum.Enumerable with type 'a enumerable = 'a t @@ -71,36 +73,70 @@ val is_empty : 'a list -> bool (** [is_empty e] returns true if [e] does not contains any element. *) val cons : 'a -> 'a list -> 'a list -(** [cons h t] returns the list starting with [h] and continuing as [t] *) - -val first : 'a list -> 'a -(** Returns the first element of the list, or @raise Empty_list if - the list is empty (similar to [hd]). *) +(** [cons h t] returns the list starting with [h] and continuing as [t]. *) val hd : 'a list -> 'a -(** Similar to [first], but @raise Failure if the list is empty. *) +(** Returns the first element of the list, or @raise Failure if + the list is empty. *) + + +val first : 'a list -> 'a +(** Alias to hd *) val tl : 'a list -> 'a list (** Return the given list without its first element. @raise Failure if the list is empty. *) val last : 'a list -> 'a -(** Returns the last element of the list, or @raise Empty_list if +(** Returns the last element of the list, or @raise Invalid_argument if the list is empty. This function takes linear time. *) val length : 'a list -> int (** Return the length (number of elements) of the given list. *) +val compare_lengths : 'a list -> 'b list -> int +(** Compare the lengths of two lists. [compare_lengths l1 l2] is + equivalent to [compare (length l1) (length l2)], except that + the computation stops after itering on the shortest list. + @since 2.7.0 + *) + +val compare_length_with : 'a list -> int -> int +(** Compare the length of a list to an integer. [compare_length_with l n] is + equivalent to [compare (length l) n], except that + the computation stops after at most [n] iterations on the list. + @since 2.7.0 +*) + val at : 'a list -> int -> 'a (** [at l n] returns the n-th element of the list [l] or @raise Invalid_argument if the index is outside of [l] bounds. O(l) *) +val at_opt : 'a list -> int -> 'a option +(** [at_opt] returns the n-th element of the list [l] or None if the index is + beyond the length of [l]. + @since 2.7.0 + @raise Invalid_argument if the index is negative *) + val rev : 'a list -> 'a list (** List reversal. *) +val shuffle : ?state:Random.State.t -> 'a list -> 'a list +(** [shuffle ~state:rs l] randomly shuffles the elements of [l]. + The optional random state [rs] allows to control the random + numbers being used during shuffling (for reproducibility). + + Shuffling is implemented using the Fisher-Yates + algorithm on an array and works in O(n), where n is the number + of elements of [l]. + + @since 2.6.0 + *) + val append : 'a list -> 'a list -> 'a list -(** Catenate two lists. Same function as the infix operator [@]. - Tail-recursive O(length of the first argument).*) +(** [append l1 l2] is a concatenation of [l1] and [l2]. + Same function as the infix operator [@]. + Tail-recursive. This function takes O([length l1]) time. *) val rev_append : 'a list -> 'a list -> 'a list (** [List.rev_append l1 l2] reverses [l1] and concatenates it to [l2]. *) @@ -108,8 +144,7 @@ val rev_append : 'a list -> 'a list -> 'a list val concat : 'a list list -> 'a list (** Concatenate a list of lists. The elements of the argument are all concatenated together (in the same order) to give the result. - Tail-recursive - (length of the argument + length of the longest sub-list). *) + Tail-recursive. *) val flatten : 'a list list -> 'a list (** Same as [concat]. *) @@ -135,6 +170,19 @@ val range : int -> [< `To | `Downto ] -> int -> int list @raise Invalid_argument in ([range i `Downto j]) if (i < j). @since 2.2.0 *) +val frange : float -> [< `To | `Downto ] -> float -> int -> float list +(** [frange start `To stop n] generates (without accumulating + floating point errors) [n] floats in the range [[start..stop]]. + [n] must be >= 2. + At each step, floats in an increasing (resp. decreasing) range increase + (resp. decrease) by approximately (stop - start) / (n - 1). + @raise Invalid_argument in ([frange i _ j n]) if (n < 2). + @raise Invalid_argument in ([frange i `To j _]) if (i >= j). + @raise Invalid_argument in ([frange i `Downto j _]) if (i <= j). + Examples: [frange 1.0 `To 3.0 3] = [[1.0; 2.0; 3.0]]. + [frange 3.0 `Downto 1.0 3] = [[3.0; 2.0; 1.0]]. + @since 2.6.0 *) + val init : int -> (int -> 'a) -> 'a list (** Similar to [Array.init], [init n f] returns the list containing the results of (f 0),(f 1).... (f (n-1)). @@ -219,22 +267,51 @@ val reduce : ('a -> 'a -> 'a) -> 'a list -> 'a @raise Invalid_argument on empty list. *) +val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list +(** Combines [fold_left] and [map]. Tail-recursive. + + More precisely : + + {[ + fold_left_map f acc [] = (acc, []) + + fold_left_map f acc (x :: xs) = + let (acc', y) = f acc x in + let (res, ys) = fold_left_map acc' xs in + (res, y :: ys) + ]} + + @since 2.6.0 +*) + val max : 'a list -> 'a (** [max l] returns the largest value in [l] as judged by - [Pervasives.compare] *) + [Pervasives.compare]. + @raise Invalid_argument on an empty list. +*) val min : 'a list -> 'a (** [min l] returns the smallest value in [l] as judged by - [Pervasives.compare] *) + [Pervasives.compare]. + @raise Invalid_argument on an empty list. +*) val sum : int list -> int -(** [sum l] returns the sum of the integers of [l] - @raise Invalid_argument on the empty list. +(** [sum l] returns the sum of the integers of [l]. + Returns [0] on the empty list. + Note: prior to NEXT_RELEASE, used to raise Invalid_argument on the empty list. *) val fsum : float list -> float -(** [fsum l] returns the sum of the floats of [l] +(** [fsum l] returns the sum of the floats of [l]. + Returns [0.] on the empty list. + Note: prior to NEXT_RELEASE, used to raise Invalid_argument on the empty list. + *) + +val favg : float list -> float +(** [favg l] returns the average of the floats of [l] @raise Invalid_argument on the empty list. + @since 2.6.0 *) val kahan_sum : float list -> float @@ -251,7 +328,15 @@ val min_max : ?cmp:('a -> 'a -> int) -> 'a list -> 'a * 'a @raise Invalid_argument on an empty list. @since 2.1 - *) +*) + +##V>=4.07##val to_seq : 'a list -> 'a Seq.t +##V>=4.07##(** Iterate on the list +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) + +##V>=4.07##val of_seq : 'a Seq.t -> 'a list +##V>=4.07##(** Create a list from the iterator +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) (** {6 Iterators on two lists} *) @@ -259,26 +344,24 @@ val min_max : ?cmp:('a -> 'a -> int) -> 'a list -> 'a * 'a val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit (** [List.iter2 f [a0; a1; ...; an] [b0; b1; ...; bn]] calls in turn [f a0 b0; f a1 b1; ...; f an bn]. - @raise Different_list_size if the two lists have - different lengths. *) + @raise Invalid_argument if two lists have different lengths. *) val iter2i : (int -> 'a -> 'b -> unit) -> 'a list -> 'b list -> unit (** [List.iter2i f [a0; a1; ...; an] [b0; b1; ...; bn]] calls in turn [f 0 a0 b0; f 1 a1 b1; ...; f n an bn]. - @raise Different_list_size or Invalid_argument if the two lists - have different lengths. *) + @raise Invalid_argument if two lists have different lengths. *) val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list (** [List.map2 f [a0; a1; ...; an] [b0; b1; ...; bn]] is [[f a0 b0; f a1 b1; ...; f an bn]]. - @raise Different_list_size if the two lists have - different lengths. Tail-recursive. *) + @raise Invalid_argument if two lists have different lengths. + Tail-recursive. *) val map2i : (int -> 'a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list (** [List.map2i f [a0; a1; ...; an] [b0; b1; ...; bn]] is [[f 0 a0 b0; f 1 a1 b1; ...; f n an bn]]. - @raise Different_list_size or Invalid_argument if the two lists - have different lengths. Tail-recursive. *) + @raise Invalid_argument if two lists have different lengths. + Tail-recursive. *) val rev_map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list (** [List.rev_map2 f l1 l2] gives the same result as @@ -288,15 +371,13 @@ val rev_map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a (** [List.fold_left2 f a [b0; b1; ...; bn] [c0; c1; ...; cn]] is [f (... (f (f a b0 c0) b1 c1) ...) bn cn]. - @raise Different_list_size if the two lists have - different lengths. *) + @raise Invalid_argument if two lists have different lengths. *) val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c (** [List.fold_right2 f [a0; a1; ...; an] [b0; b1; ...; bn] c] is [f a0 b0 (f a1 b1 (... (f an bn c) ...))]. - - @raise Different_list_size if the two lists have - different lengths. Tail-recursive. *) + @raise Invalid_argument if two lists have different lengths. + Tail-recursive. *) (**{6 List scanning}*) @@ -306,7 +387,7 @@ val mem : 'a -> 'a list -> bool to an element of [l]. *) val mem_cmp : ('a -> 'a -> int) -> 'a -> 'a list -> bool -(** Same as {!List.mem}, but the comparator function is explicitely +(** Same as {!List.mem}, but the comparator function is explicitly provided. @since 2.2.0 *) @@ -331,14 +412,12 @@ val exists : ('a -> bool) -> 'a list -> bool val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool (** Same as {!List.for_all}, but for a two-argument predicate. - @raise Invalid_argument if the two lists have - different lengths. *) + @raise Invalid_argument if two lists have different lengths. *) val exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool (** Same as {!List.exists}, but for a two-argument predicate. - @raise Invalid_argument if the two lists have - different lengths. *) + @raise Invalid_argument if two lists have different lengths. *) val subset : ('a -> 'b -> int) -> 'a list -> 'b list -> bool (** [subset cmp l l'] check if all elements of the list [l] @@ -356,6 +435,12 @@ val find : ('a -> bool) -> 'a list -> 'a @raise Not_found if there is no value that satisfies [p] in the list [l]. *) +val find_opt: ('a -> bool) -> 'a list -> 'a option +(** [find_opt p l] returns the first element of the list [l] that + satisfies the predicate [p], or [None] if there is no value that + satisfies [p] in the list [l]. + @since 2.7.0 *) + val find_exn : ('a -> bool) -> exn -> 'a list -> 'a (** [find_exn p e l] returns the first element of [l] such as [p x] returns [true] or raises [e] if such an element has not been found. *) @@ -382,7 +467,7 @@ val filter : ('a -> bool) -> 'a list -> 'a list in the input list is preserved. *) val filteri : (int -> 'a -> bool) -> 'a list -> 'a list -(** [filter p [a0; a1; ...; an]] returns all the elements [ai] of index [i] +(** [filteri p [a0; a1; ...; an]] returns all the elements [ai] of index [i] that satisfy the predicate [p i ai]. The order of the elements in the input list is preserved. @@ -396,7 +481,7 @@ val filter_map : ('a -> 'b option) -> 'a list -> 'b list [l] is discarded). *) val filteri_map : (int -> 'a -> 'b option) -> 'a list -> 'b list -(** [filter_map f l] calls [(f 0 a0) (f 1 a1).... (f n an)] where [a0,a1..an] are +(** [filteri_map f l] calls [(f 0 a0) (f 1 a1).... (f n an)] where [a0,a1..an] are the elements of [l]. It returns the list of elements [bi] such as [f ai = Some bi] (when [f] returns [None], the corresponding element of [l] is discarded). @@ -478,6 +563,15 @@ val assoc : 'a -> ('a * 'b) list -> 'b @raise Not_found if there is no value associated with [a] in the list [l]. *) +val assoc_opt: 'a -> ('a * 'b) list -> 'b option +(** [assoc_opt a l] returns the value associated with key [a] in the list of + pairs [l]. That is, + [assoc_opt a [ ...; (a,b); ...] = b] + if [(a,b)] is the leftmost binding of [a] in list [l]. + Returns [None] if there is no value associated with [a] in the + list [l]. + @since 2.7.0 *) + val assoc_inv : 'b -> ('a * 'b) list -> 'a (** [assoc_inv b l] returns the key associated with value [b] in the list of pairs [l]. That is, [assoc b [ ...; (a,b); ...] = a] @@ -498,6 +592,11 @@ val assq : 'a -> ('a * 'b) list -> 'b (** Same as {!List.assoc}, but uses physical equality instead of structural equality to compare keys. *) +val assq_opt : 'a -> ('a * 'b) list -> 'b option +(** Same as {!List.assoc_opt}, but uses physical equality instead of structural + equality to compare keys. + @since 2.7.0 *) + val assq_inv : 'b -> ('a * 'b) list -> 'a (** Same as {!List.assoc_inv}, but uses physical equality instead of structural equality to compare keys. *) @@ -539,7 +638,7 @@ val modify_at : int -> ('a -> 'a) -> 'a list -> 'a list @since 2.3.0 *) val modify_opt_at : int -> ('a -> 'a option) -> 'a list -> 'a list -(** [modify_at_opt n f l] returns the same list as [l] but with +(** [modify_opt_at n f l] returns the same list as [l] but with nth-value [a] removed if [f a] is [None], and replaced by [v] if it is [Some v]. @@ -594,7 +693,7 @@ val drop : int -> 'a list -> 'a list list if [l] have less than [n] elements. *) val takedrop : int -> 'a list -> 'a list * 'a list -(** [take_drop n l] is equivalent to [(take n l, drop n l)] +(** [takedrop n l] is equivalent to [(take n l, drop n l)] but is done in one pass. @since 2.2.0 *) @@ -615,6 +714,14 @@ val span : ('a -> bool) -> 'a list -> 'a list * 'a list @since 2.1 *) +val fold_while : ('acc -> 'a -> bool) -> ('acc -> 'a -> 'acc) -> 'acc -> 'a list -> 'acc * 'a list +(** [fold_while p f init l], accumulates elements [x] of list [l] using + function [f], as long as predicate [p acc x] holds. + At the end, the accumulated value along with the remaining part + of the list are returned. + + @since 2.10.0 +*) val nsplit : ('a -> bool) -> 'a list -> 'a list list (** [nsplit], applied to a predicate [p] and a list [xs], returns a @@ -650,7 +757,7 @@ val group_consecutive : ('a -> 'a -> bool) -> 'a list -> 'a list list val interleave : ?first:'a -> ?last:'a -> 'a -> 'a list -> 'a list (** [interleave ~first ~last sep [a0;a1;a2;...;an]] returns - [first; a0; sep; a1; sep; a2; sep; ...; sep; an; last] *) + [first; a0; sep; a1; sep; a2; sep; ...; sep; an; last]. *) (** {6 BatEnum functions} @@ -661,7 +768,7 @@ val interleave : ?first:'a -> ?last:'a -> 'a -> 'a list -> 'a list val enum : 'a list -> 'a BatEnum.t (** Returns an enumeration of the elements of a list. This enumeration may be used to visit elements of the list in forward order (i.e. from the - first element to the last one)*) + first element to the last one). *) val of_enum : 'a BatEnum.t -> 'a list (** Build a list from an enumeration. In the result, elements appear in the @@ -670,7 +777,7 @@ val of_enum : 'a BatEnum.t -> 'a list val backwards : 'a list -> 'a BatEnum.t (** Returns an enumeration of the elements of a list. This enumeration may be used to visit elements of the list in backwards order (i.e. from the - last element to the first one)*) + last element to the first one). *) val of_backwards : 'a BatEnum.t -> 'a list (** Build a list from an enumeration. The first element of the enumeration @@ -693,8 +800,8 @@ val combine : 'a list -> 'b list -> ('a * 'b) list (** Transform a pair of lists into a list of pairs: [combine [a0; a1; ...; an] [b0; b1; ...; bn]] is [[(a0,b0); (a1,b1); ...; (an,bn)]]. - @raise Different_list_size if the two lists - have different lengths. Tail-recursive. *) + @raise Invalid_argument if two lists have different lengths. + Tail-recursive. *) (** {6 Sorting}*) @@ -733,7 +840,7 @@ val merge : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list (** Merge two lists: Assuming that [l1] and [l2] are sorted according to the comparison function [cmp], [merge cmp l1 l2] will return a - sorted list containting all the elements of [l1] and [l2]. + sorted list containing all the elements of [l1] and [l2]. If several elements compare equal, the elements of [l1] will be before the elements of [l2]. Not tail-recursive (sum of the lengths of the arguments). @@ -764,7 +871,7 @@ val group : ('a -> 'a -> int) -> 'a list -> 'a list list For example [group cmp [f;c;b;e;d;a]] can give [[[a;b];[c];[d;e;f]]] if following conditions are met: - [cmp a b = 0], [cmp b c = -1], [cmp c d = -1], [cmp d e = 0],... + [cmp a b = 0], [cmp b c = -1], [cmp c d = -1], [cmp d e = 0], ... See the note on [group_consecutive]. *) @@ -816,6 +923,14 @@ module Comp (T : Comp) : Comp with type t = T.t list val nth : 'a list -> int -> 'a (** Obsolete. As [at]. *) +val nth_opt: 'a list -> int -> 'a option +(** Return the [n]-th element of the given list. + The first element (head of the list) is at position 0. + Return [None] if the list is too short. + Raise [Invalid_argument "List.nth"] if [n] is negative. + @since 2.7.0 +*) + val takewhile : ('a -> bool) -> 'a list -> 'a list (** obsolete, as {!take_while} *) @@ -828,7 +943,7 @@ val dropwhile : ('a -> bool) -> 'a list -> 'a list The following modules replace functions defined in {!List} with functions behaving slightly differently but having the same name. This is by design: - the functions meant to override the corresponding functions of {!List}. + the functions are meant to override the corresponding functions of {!List}. *) @@ -855,7 +970,7 @@ module Exceptionless : sig `Invalid_argument of string] (** Whenever [n] is inside of [l] size bounds, [split_at n l] returns [Ok(l1,l2)], where [l1] contains the first [n] elements of [l] and [l2] - contains the others. Otherwise, returns [`Invalid_argument n] *) + contains the others. Otherwise, returns [`Invalid_argument n]. *) val at : 'a list -> int -> [`Ok of 'a | `Invalid_argument of string] (** If [n] is inside the bounds of [l], [at l n] returns [Ok x], where @@ -896,7 +1011,7 @@ module Exceptionless : sig val tl : ('a list -> 'a list option) (** [tl l] returns [Some x] such that [x] is the given list [l] without its first element. - Returns [None] if list [l] is empty *) + Returns [None] if list [l] is empty. *) val last : 'a list -> 'a option (** [last l] returns either [Some x] where [x] is the last element of the list, or [None] if @@ -962,6 +1077,5 @@ module Labels : sig end end - val ( @ ) : 'a list -> 'a list -> 'a list (** Tail recursive [List.append]. *) diff --git a/src/batList.mlv b/src/batList.mlv index 6f5fc7a95..562dcdae8 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -28,8 +28,14 @@ let fast_sort = List.fast_sort let stable_sort = List.stable_sort let sort = List.sort let assq = List.assq +##V>=4.5##let assq_opt = List.assq_opt +##V<4.5##let assq_opt k li = try Some (assq k li) with Not_found -> None let assoc = List.assoc +##V>=4.5##let assoc_opt = List.assoc_opt +##V<4.5##let assoc_opt k li = try Some (assoc k li) with Not_found -> None let find = List.find +##V>=4.5##let find_opt = List.find_opt +##V<4.5##let find_opt p li = try Some (find p li) with Not_found -> None let exists = List.exists let for_all = List.for_all let fold_left = List.fold_left @@ -38,6 +44,8 @@ let iter = List.iter let rev_append = List.rev_append let rev = List.rev let length = List.length +##V>=4.5##let compare_length_with = List.compare_length_with +##V>=4.5##let compare_lengths = List.compare_lengths let tl = List.tl let hd = List.hd let mem = List.mem @@ -45,15 +53,61 @@ let memq = List.memq let mem_assq = List.mem_assq let mem_assoc = List.mem_assoc let rev_map2 = List.rev_map2 +##V>=4.07##let to_seq = List.to_seq +##V>=4.07##let of_seq = List.of_seq (* ::VH:: END GLUE *) +let rec compare_lengths la lb = match la, lb with + | [], [] -> 0 + | [], _::_ -> -1 + | _::_, [] -> 1 + | _::la, _::lb -> compare_lengths la lb + +(*$T compare_lengths +compare_lengths [] [] = 0 +compare_lengths [] [1] = -1 +compare_lengths [1] [] = 1 +compare_lengths [1; 2] [3; 4] = 0 +compare_lengths [1; 2; 3] [3; 4] = 1 +compare_lengths [1; 2] [2; 3; 4] = -1 +*) + +(*$Q compare_lengths + (Q.pair (Q.list Q.small_int) (Q.list Q.small_int)) \ + (fun (la, lb) -> \ + BatOrd.ord0 (compare_lengths la lb) \ + = BatOrd.ord0 (Pervasives.compare (length la) (length lb))) +*) + +let rec compare_length_with li n = match li, n with + | [], n -> Pervasives.compare 0 n + | _::tl, n -> compare_length_with tl (n-1) + +(*$T compare_length_with +compare_length_with [] 0 = 0 +compare_length_with [] 1 = -1 +compare_length_with [1] 0 = 1 +compare_length_with [1; 2] 2 = 0 +compare_length_with [1; 2; 3] 2 = 1 +compare_length_with [1; 2] 3 = -1 +*) + +(*$Q compare_length_with + (Q.pair (Q.list Q.small_int) Q.small_int) \ + (fun (li, n) -> \ + BatOrd.ord0 (compare_length_with li n) \ + = BatOrd.ord0 (Pervasives.compare (length li) n)) +*) + + (* Thanks to Jacques Garrigue for suggesting the following structure *) type 'a mut_list = { hd: 'a; mutable tl: 'a list } -type 'a t = 'a list +##V<4.08##type 'a t = 'a list +##V>=4.08##type 'a t = 'a list = [] | (::) of 'a * 'a list type 'a enumerable = 'a t type 'a mappable = 'a t @@ -81,8 +135,8 @@ let is_empty = function not (is_empty [1]) *) -let at_negative_index_msg = "Negative index not allowed" -let at_after_end_msg = "Index past end of list" +let at_negative_index_msg = "List: Negative index not allowed" +let at_after_end_msg = "List: Index past end of list" let nth l index = if index < 0 then invalid_arg at_negative_index_msg; @@ -101,6 +155,15 @@ let at = nth at [1;2;3] 2 = 3 *) +let at_opt l index = + if index < 0 then invalid_arg at_negative_index_msg; + try Some (at l index) with Invalid_argument _ -> None +(*$T at_opt + at_opt [] 0 = None + try ignore (at_opt [1;2;3] (-1)); false with Invalid_argument _ -> true + at_opt [1;2;3] 2 = Some 3 +*) + let mem_cmp cmp x l = exists (fun y -> cmp x y = 0) l @@ -172,8 +235,8 @@ let map f = function loop r t; inj r (*$Q map - (Q.pair (Q.fun1 Q.int Q.int) (Q.list Q.small_int)) \ - (fun (f,l) -> map f l = List.map f l) + (Q.pair (Q.fun1 Q.Observable.int Q.int) (Q.list Q.small_int)) \ + (fun (Q.Fun (_,f),l) -> map f l = List.map f l) *) let rec drop n = function @@ -222,7 +285,7 @@ let takedrop n l = *) let ntake n l = - if n < 1 then invalid_arg "BatList.ntake"; + if n < 1 then invalid_arg "List.ntake"; let took, left = takedrop n l in let acc = Acc.create took in let rec loop dst = function @@ -288,6 +351,23 @@ let span p li = (span ((=) 2) [2; 2]) ([2; 2],[]) *) +let fold_while p f init li = + let rec loop acc = function + | [] -> (acc, []) + | (x :: xs) as l -> + if p acc x then loop (f acc x) xs + else (acc, l) in + loop init li + +(*$= fold_while + (fold_while (fun _acc x -> x = 3) (fun acc x -> acc + x) 0 [3;3;4;3;3]) (6,[4;3;3]) + (fold_while (fun acc _x -> acc < 6) (fun acc x -> acc + x) 0 [3;3;4;3;3]) (6,[4;3;3]) + (fold_while (fun _acc x -> x = 3) (fun acc x -> acc + x) 0 [3]) (3,[]) + (fold_while (fun _acc x -> x = 3) (fun acc x -> acc + x) 0 [4]) (0,[4]) + (fold_while (fun _acc x -> x = 3) (fun acc x -> acc + x) 0 []) (0,[]) + (fold_while (fun _acc x -> x = 2) (fun acc x -> acc + x) 0 [2; 2]) (4,[]) +*) + let nsplit p = function | [] -> [] (* note that returning [] on empty inputs is an arbitrary choice @@ -357,6 +437,8 @@ let group_consecutive p l = (group_consecutive (=) [2; 2]) [[2; 2]] *) +##V>=4.5##let nth_opt = List.nth_opt +##V<4.5##let nth_opt li n = try Some (nth li n) with _ -> None let takewhile = take_while let dropwhile = drop_while @@ -411,10 +493,10 @@ let unique ?(eq = ( = )) l = *) let unique_cmp ?(cmp = Pervasives.compare) l = - let set = ref (BatMap.PMap.create cmp) in + let set = ref (BatSet.PSet.create cmp) in let should_keep x = - if BatMap.PMap.mem x !set then false - else ( set := BatMap.PMap.add x true !set; true ) + if BatSet.PSet.mem x !set then false + else ( set := BatSet.PSet.add x !set; true ) in (* use a stateful filter to remove duplicate elements *) List.filter should_keep l @@ -511,7 +593,7 @@ let map2 f l1 l2 = | [], [] -> () | h1 :: t1, h2 :: t2 -> loop (Acc.accum dst (f h1 h2)) t1 t2 - | _ -> invalid_arg "map2: Different_list_size" + | _ -> invalid_arg "List.map2: list lengths differ" in let dummy = Acc.dummy () in loop dummy l1 l2; @@ -523,7 +605,7 @@ let map2i f l1 l2 = | [], [] -> () | h1 :: t1, h2 :: t2 -> loop (succ i) (Acc.accum dst (f i h1 h2)) t1 t2 - | _ -> invalid_arg "map2i: Different_list_size" + | _ -> invalid_arg "List.map2i: list lengths differ" in let dummy = Acc.dummy () in loop 0 dummy l1 l2; @@ -532,11 +614,11 @@ let map2i f l1 l2 = (*$T map2i map2i (fun i x y -> i, x, y) [] [] = [] map2i (fun i x y -> i, x, y) ['a'] ["b"] = [0, 'a', "b"] - map2i (fun i x y -> i, x, y) ['a', 'b', 'c'] ["d", "e", "f"] = \ + map2i (fun i x y -> i, x, y) ['a'; 'b'; 'c'] ["d"; "e"; "f"] = \ [(0, 'a', "d"); (1, 'b', "e"); (2, 'c', "f")] try ignore (map2i (fun i x y -> i, x, y) [] [0]); false \ with Invalid_argument _ -> true - try ignore (map2i (fun i x y -> i, x, y) [1, 2, 3] ["4"]); false \ + try ignore (map2i (fun i x y -> i, x, y) [1; 2; 3] ["4"]); false \ with Invalid_argument _ -> true *) @@ -544,14 +626,14 @@ let rec iter2 f l1 l2 = match l1, l2 with | [], [] -> () | h1 :: t1, h2 :: t2 -> f h1 h2; iter2 f t1 t2 - | _ -> invalid_arg "iter2: Different_list_size" + | _ -> invalid_arg "List.iter2: list lengths differ" let iter2i f l1 l2 = let rec loop i l1 l2 = match l1, l2 with | [], [] -> () | h1 :: t1, h2 :: t2 -> f i h1 h2; loop (succ i) t1 t2 - | _ -> invalid_arg "iter2: Different_list_size" + | _ -> invalid_arg "List.iter2i: list lengths differ" in loop 0 l1 l2 (*$T iter2i @@ -563,22 +645,22 @@ let iter2i f l1 l2 = (*$T iter2i iter2i (fun _ _ _ -> assert false) [] []; true - let r = ref 0 in iter2i (fun i x y -> r := r + i * x + y) [1] [2]; !r = 2 - let r = ref 0 in iter2i (fun i x y -> r := r + i * x + y) [1; 2] [3; 4]; !r = 9 + let r = ref 0 in iter2i (fun i x y -> r := !r + i * x + y) [1] [2]; !r = 2 + let r = ref 0 in iter2i (fun i x y -> r := !r + i * x + y) [1; 2] [3; 4]; !r = 9 *) let rec fold_left2 f accum l1 l2 = match l1, l2 with | [], [] -> accum | h1 :: t1, h2 :: t2 -> fold_left2 f (f accum h1 h2) t1 t2 - | _ -> invalid_arg "fold_left2: Different_list_size" + | _ -> invalid_arg "List.fold_left2: list lengths differ" let fold_right2 f l1 l2 init = let rec tail_loop acc l1 l2 = match l1, l2 with | [] , [] -> acc | h1 :: t1 , h2 :: t2 -> tail_loop (f h1 h2 acc) t1 t2 - | _ -> invalid_arg "fold_left2: Different_list_size" + | _ -> invalid_arg "List.fold_right2: list lengths differ" in let rec loop n l1 l2 = match l1, l2 with @@ -588,7 +670,7 @@ let fold_right2 f l1 l2 init = f h1 h2 (loop (n+1) t1 t2) else f h1 h2 (tail_loop init (rev t1) (rev t2)) - | _ -> invalid_arg "fold_right2: Different_list_size" + | _ -> invalid_arg "List.fold_right2: list lengths differ" in loop 0 l1 l2 @@ -597,7 +679,7 @@ let for_all2 p l1 l2 = match l1, l2 with | [], [] -> true | h1 :: t1, h2 :: t2 -> if p h1 h2 then loop t1 t2 else false - | _ -> invalid_arg "for_all2: Different_list_size" + | _ -> invalid_arg "List.for_all2: list lengths differ" in loop l1 l2 @@ -606,7 +688,7 @@ let exists2 p l1 l2 = match l1, l2 with | [], [] -> false | h1 :: t1, h2 :: t2 -> if p h1 h2 then true else loop t1 t2 - | _ -> invalid_arg "exists2: Different_list_size" + | _ -> invalid_arg "List.exists2: list lengths differ" in loop l1 l2 @@ -638,7 +720,7 @@ let remove_assq x lst = let remove_at i lst = let rec loop dst i = function - | [] -> invalid_arg "BatList.remove_at" + | [] -> invalid_arg "List.remove_at" | x :: xs -> if i = 0 then dst.tl <- xs @@ -646,7 +728,7 @@ let remove_at i lst = loop (Acc.accum dst x) (i - 1) xs in if i < 0 then - invalid_arg "BatList.remove_at" + invalid_arg "List.remove_at" else let dummy = Acc.dummy () in loop dummy i lst; @@ -755,7 +837,6 @@ let split lst = adummy.tl, bdummy.tl let combine l1 l2 = - let list_sizes_differ = Invalid_argument "combine: Different_list_size" in match l1, l2 with | [], [] -> [] | x :: xs, y :: ys -> @@ -763,9 +844,9 @@ let combine l1 l2 = let rec loop dst l1 l2 = match l1, l2 with | [], [] -> inj acc | h1 :: t1, h2 :: t2 -> loop (Acc.accum dst (h1, h2)) t1 t2 - | _, _ -> raise list_sizes_differ + | _, _ -> invalid_arg "List.combine: list lengths differ" in loop acc xs ys - | _, _ -> raise list_sizes_differ + | _, _ -> invalid_arg "List.combine: list lengths differ" (*$T combine combine [] [] = [] @@ -841,6 +922,49 @@ let range i dir j = try ignore(range 1 `Downto 2); true with Invalid_argument _ -> true *) +let frange start direction stop n = + if n < 2 then invalid_arg (Printf.sprintf "List.frange: %d < 2" n); + let nb_steps = float_of_int (n - 1) in + match direction with + | `To -> + begin + if start >= stop then + invalid_arg (Printf.sprintf "List.frange %f `To %f" start stop); + let span = stop -. start in + let rec loop acc i = + let x = ((span *. float_of_int (i - 1)) /. nb_steps) +. start in + let acc' = x :: acc in + if i = 1 then acc' + else loop acc' (i - 1) + in + loop [] n + end + | `Downto -> + begin + if start <= stop then + invalid_arg (Printf.sprintf "List.frange %f `Downto %f" start stop); + let span = start -. stop in + let rec loop acc i = + let x = ((span *. float_of_int (i - 1)) /. nb_steps) +. stop in + let acc' = x :: acc in + if i = n then acc' + else loop acc' (i + 1) + in + loop [] 1 + end + +(*$T frange + try ignore(frange 1. `To 2. 1); true with Invalid_argument _ -> true + try ignore(frange 2. `Downto 1. 1); true with Invalid_argument _ -> true + try ignore(frange 3. `To 1. 3); true with Invalid_argument _ -> true + try ignore(frange 1. `Downto 3. 3); true with Invalid_argument _ -> true + frange 1. `To 3. 3 = [1.; 2.; 3.] + frange 1. `To 2. 2 = [1.; 2.] + frange 3. `Downto 1. 3 = [3.; 2.; 1.] + frange 2. `Downto 1. 2 = [2.; 1.] + length (frange 0.123 `To 3.491 1000) = 1000 +*) + let mapi f = function | [] -> [] | h :: t -> @@ -891,6 +1015,25 @@ let fold_righti f l init = fold_righti (fun i x acc -> (i, x) :: acc) [0.; 1.] [] = [(0, 0.); (1, 1.)] *) +let fold_left_map f acc = function + | [] -> acc, [] + | h :: t -> + let rec loop acc dst = function + | [] -> acc + | h :: t -> + let acc', t' = f acc h in + loop acc' (Acc.accum dst t') t + in + let acc', h' = f acc h in + let r = Acc.create h' in + let res = loop acc' r t in + res, inj r + +(*$T fold_left_map + fold_left_map (fun acc x -> assert false) 0 [] = (0, []) + fold_left_map (fun acc x -> acc ^ x, int_of_string x) "0" ["1"; "2"; "3"] = ("0123", [1; 2; 3]) +*) + let first = hd let rec last = function @@ -1218,13 +1361,61 @@ let print ?(first="[") ?(last="]") ?(sep="; ") print_a out = function let t_printer a_printer _paren out x = print (a_printer false) out x -let reduce f = function [] -> invalid_arg "Empty List" - | h::t -> fold_left f h t +let reduce f = function + | [] -> + invalid_arg "List.reduce: Empty List" + | h :: t -> + fold_left f h t let min l = reduce Pervasives.min l let max l = reduce Pervasives.max l -let sum l = reduce (+) l -let fsum l = reduce (+.) l +let sum l = fold_left (+) 0 l +(*$= sum & ~printer:string_of_int + 2 (sum [1;1]) + 0 (sum []) +*) + +let fsum l = + match l with + | [] -> 0. + | x::xs -> + let acc = ref x in + let rem = ref xs in + let go = ref true in + while !go do + match !rem with + | [] -> go := false; + | x::xs -> + acc := !acc +. x; + rem := xs + done; + !acc +(*$= fsum & ~printer:string_of_float + 0. (fsum []) + 6. (fsum [1.;2.;3.]) +*) + +let favg l = + match l with + | [] -> invalid_arg "List.favg: Empty List" + | x::xs -> + let acc = ref x in + let len = ref 1 in + let rem = ref xs in + let go = ref true in + while !go do + match !rem with + | [] -> go := false; + | x::xs -> + acc := !acc +. x; + incr len; + rem := xs + done; + !acc /. float_of_int !len +(*$T favg + try let _ = favg [] in false with Invalid_argument _ -> true + favg [1.;2.;3.] = 2. +*) let kahan_sum li = (* This algorithm is written in a particularly untasteful imperative @@ -1304,6 +1495,16 @@ let subset cmp l l' = for_all (fun x -> mem_cmp cmp x l') l subset Pervasives.compare [1;2] [1;2;3] = true *) +let shuffle ?state l = + let arr = Array.of_list l in + BatInnerShuffle.array_shuffle ?state arr; + Array.to_list arr +(*$T shuffle + let s = Random.State.make [|11|] in \ + shuffle ~state:s [1;2;3;4;5;6;7;8;9] = [7; 2; 9; 5; 3; 6; 4; 1; 8] + shuffle [] = [] +*) + module Exceptionless = struct let rfind p l = try Some (rfind p l) diff --git a/src/batMap.ml b/src/batMap.ml index bb6411538..628be9c41 100644 --- a/src/batMap.ml +++ b/src/batMap.ml @@ -28,7 +28,7 @@ operations (both providing their own way to access the ordering information, and to possibly pass it along with the result). - I tried to keep the interface mininal with respect to ordering + I tried to keep the interface minimal with respect to ordering information : function that do not need the ordering (they do not need to find the position of a specific key in the map) do not have a 'cmp' parameter. @@ -175,6 +175,10 @@ module Concrete = struct try Some (find x cmp map) with Not_found -> None + let find_default def x cmp map = + try find x cmp map + with Not_found -> def + let remove x cmp map = let rec loop = function | Node (l, k, v, r, _) -> @@ -184,14 +188,30 @@ module Concrete = struct | Empty -> Empty in loop map + (* A variant of [remove] that throws [Not_found] on failure *) + let remove_exn x cmp map = + let rec loop = function + | Empty -> + raise Not_found + | Node (l, k, v, r, _) -> + let c = cmp x k in + if c = 0 then + merge l r + else if c < 0 then + bal (loop l) k v r + else + bal l k v (loop r) + in + loop map + let update k1 k2 v2 cmp map = if cmp k1 k2 <> 0 then - add k2 v2 cmp (remove k1 cmp map) + add k2 v2 cmp (remove_exn k1 cmp map) else let rec loop = function | Empty -> raise Not_found | Node(l, k, v, r, h) -> - let c = cmp k k1 in + let c = cmp k1 k in if c = 0 then Node(l, k2, v2, r, h) else if c < 0 then @@ -388,7 +408,7 @@ module Concrete = struct library's version of [Map] easier to track, even if the result is a tad slower.*) (* [filter{,i,_map} f t cmp] do not use [cmp] on [t], but only to - build the result map. The unusual parameter order was choosed to + build the result map. The unusual parameter order was chosen to reflect this. *) let filterv f t cmp = foldi (fun k a acc -> if f a then add k a cmp acc else acc) t empty @@ -399,10 +419,6 @@ module Concrete = struct | None -> acc | Some v -> add k v cmp acc) t empty - let choose = function - | Empty -> invalid_arg "PMap.choose: empty tree" - | Node (_l,k,v,_r,_h) -> (k,v) - let for_all f map = let rec loop = function | Empty -> true @@ -430,7 +446,12 @@ module Concrete = struct in loop empty empty map - let choose = function + let choose = min_binding + (*$= choose + (empty |> add 0 1 |> add 1 1 |> choose) (empty |> add 1 1 |> add 0 1 |> choose) + *) + + let any = function | Empty -> raise Not_found | Node (_, k, v, _, _) -> (k,v) @@ -678,7 +699,7 @@ module Concrete = struct let union cmp1 m1 cmp2 m2 = if compatible_cmp cmp1 m1 cmp2 m2 then let merge_fun _k a b = if a <> None then a else b in - merge merge_fun cmp2 m1 m2 + merge merge_fun cmp2 m2 m1 else foldi (fun k v m -> add k v cmp1 m) m2 m1 @@ -721,6 +742,7 @@ sig val add: key -> 'a -> 'a t -> 'a t val update: key -> key -> 'a -> 'a t -> 'a t val find: key -> 'a t -> 'a + val find_default: 'a -> key -> 'a t -> 'a val remove: key -> 'a t -> 'a t val modify: key -> ('a -> 'a) -> 'a t -> 'a t val modify_def: 'a -> key -> ('a -> 'a) -> 'a t -> 'a t @@ -744,6 +766,7 @@ sig val max_binding : 'a t -> (key * 'a) val pop_max_binding: 'a t -> (key * 'a) * 'a t val choose : 'a t -> (key * 'a) + val any : 'a t -> (key * 'a) val split : key -> 'a t -> ('a t * 'a option * 'a t) val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t val singleton : key -> 'a -> 'a t @@ -763,6 +786,8 @@ sig 'a BatInnerIO.output -> 'c t -> unit module Exceptionless : sig val find: key -> 'a t -> 'a option + val choose: 'a t -> (key * 'a) option + val any: 'a t -> (key * 'a) option end module Infix : sig @@ -815,6 +840,7 @@ struct let keys t = Concrete.keys (impl_of_t t) let values t = Concrete.values (impl_of_t t) let update k1 k2 v2 t = t_of_impl (Concrete.update k1 k2 v2 Ord.compare (impl_of_t t)) + let find_default d k t = Concrete.find_default d k Ord.compare (impl_of_t t) let of_enum e = t_of_impl (Concrete.of_enum Ord.compare e) @@ -854,6 +880,7 @@ struct (maxi, t_of_impl rest) let choose t = Concrete.choose (impl_of_t t) + let any t = Concrete.any (impl_of_t t) let split k t = let l, v, r = Concrete.split k Ord.compare (impl_of_t t) in @@ -889,6 +916,8 @@ struct module Exceptionless = struct let find k t = try Some (find k t) with Not_found -> None + let choose t = try Some (choose t) with Not_found -> None + let any t = try Some (any t) with Not_found -> None end module Infix = @@ -912,6 +941,13 @@ struct end +module Int = Make (BatInt) +module Int32 = Make (BatInt32) +module Int64 = Make (BatInt64) +module Nativeint = Make (BatNativeint) +module Float = Make (BatFloat) +module Char = Make (BatChar) +module String = Make (BatString) (** * PMap - Polymorphic maps @@ -937,6 +973,14 @@ let find x m = Concrete.find x Pervasives.compare m empty |> add 2 'y' |> add 1 'x' |> find 2 = 'y' *) +let find_default def x m = + Concrete.find_default def x Pervasives.compare m + +(*$T find_default + find_default 3 4 (add 1 2 empty) = 3 + find_default 3 1 (add 1 2 empty) = 2 +*) + (*$T pop_min_binding (empty |> add 1 true |> pop_min_binding) = ((1, true), empty) (empty |> add 1 true |> add 2 false |> pop_min_binding) = \ @@ -978,7 +1022,7 @@ let at_rank_exn = Concrete.at_rank_exn (*$Q foldi (Q.list Q.small_int) (fun xs -> \ let m = List.fold_left (fun acc x -> add x true acc) empty xs in \ - foldi (fun x _y acc -> x :: acc) m [] |> List.rev = List.sort_unique Int.compare xs) + foldi (fun x _y acc -> x :: acc) m [] |> List.rev = List.sort_unique BatInt.compare xs) *) let enum = Concrete.enum @@ -987,7 +1031,7 @@ let enum = Concrete.enum (Q.list Q.small_int) (fun xs -> \ List.fold_left (fun acc x -> add x true acc) \ empty xs |> keys |> List.of_enum \ - = List.sort_unique Int.compare xs) + = List.sort_unique BatInt.compare xs) *) let backwards = Concrete.backwards @@ -1004,6 +1048,7 @@ let filter f t = Concrete.filter f t Pervasives.compare let filter_map f t = Concrete.filter_map f t Pervasives.compare let choose = Concrete.choose +let any = Concrete.any let max_binding = Concrete.max_binding let min_binding = Concrete.min_binding let pop_min_binding = Concrete.pop_min_binding @@ -1042,7 +1087,7 @@ let split k m = Concrete.split k Pervasives.compare m (* We can't compare external primitives directly using the physical equality - operator, since two different occurences of an external primitive are two + operator, since two different occurrences of an external primitive are two different closures. So we first make a local binding of [Pervasives.compare] and only then pass it to corresponding functions from Concrete. This way the physical equality check in [compatible_cmp] will work as needed *) @@ -1051,6 +1096,12 @@ let union m1 m2 = let comp = Pervasives.compare in Concrete.union comp m1 comp m2 +(*$T union + let m1 = empty |> add 1 1 |> add 2 2 in \ + let m2 = empty |> add 2 20 |> add 3 30 in \ + (union m1 m2 |> find 2 = 20) && (union m2 m1 |> find 2 = 2) +*) + let diff m1 m2 = let comp = Pervasives.compare in Concrete.diff comp m1 comp m2 @@ -1067,11 +1118,13 @@ let bindings = Concrete.bindings let compare cmp_val m1 m2 = Concrete.compare Pervasives.compare Pervasives.compare m1 m2 -let equal eq_val m1 m2 = Concrete.equal Pervasives.compare (=) m1 m2 +let equal eq_val m1 m2 = Concrete.equal Pervasives.compare eq_val m1 m2 module Exceptionless = struct let find k m = try Some (find k m) with Not_found -> None + let choose m = try Some (choose m) with Not_found -> None + let any m = try Some (any m) with Not_found -> None end module Infix = @@ -1097,7 +1150,7 @@ module PMap = struct (*$< PMap *) let get_cmp {cmp} = cmp (*$T get_cmp - get_cmp (create Int.compare) == Int.compare + get_cmp (create BatInt.compare) == BatInt.compare *) let empty = { cmp = Pervasives.compare; map = Concrete.empty } @@ -1113,6 +1166,9 @@ module PMap = struct (*$< PMap *) let find x m = Concrete.find x m.cmp m.map + let find_default def x m = + Concrete.find_default def x m.cmp m.map + (*$T add; find empty |> add 1 true |> add 2 false |> find 1 empty |> add 1 true |> add 2 false |> find 2 |> not @@ -1122,10 +1178,18 @@ module PMap = struct (*$< PMap *) empty |> add 2 'y' |> add 1 'x' |> find 2 = 'y' *) + (*$T find_default + find_default 3 4 (add 1 2 empty) = 3 + find_default 3 1 (add 1 2 empty) = 2 + *) + (*$T update add 1 false empty |> update 1 1 true |> find 1 add 1 false empty |> update 1 2 true |> find 2 try ignore (update 1 1 false empty); false with Not_found -> true + empty |> add 1 11 |> add 2 22 |> update 2 2 222 |> find 2 = 222 + let m = empty |> add 1 11 |> add 2 22 in \ + try ignore (m |> update 3 4 555); false with Not_found -> true *) (*$Q find ; add @@ -1164,8 +1228,8 @@ module PMap = struct (*$< PMap *) (*$Q foldi (Q.list Q.small_int) (fun xs -> \ - let m = List.fold_left (fun acc x -> add x true acc) (create Int.compare) xs in \ - foldi (fun x _y acc -> x :: acc) m [] |> List.rev = List.sort_unique Int.compare xs) + let m = List.fold_left (fun acc x -> add x true acc) (create BatInt.compare) xs in \ + foldi (fun x _y acc -> x :: acc) m [] |> List.rev = List.sort_unique BatInt.compare xs) *) let at_rank_exn i m = @@ -1176,8 +1240,8 @@ module PMap = struct (*$< PMap *) (*$Q keys (Q.list Q.small_int) (fun xs -> \ List.fold_left (fun acc x -> add x true acc) \ - (create Int.compare) xs |> keys |> List.of_enum \ - = List.sort_unique Int.compare xs) + (create BatInt.compare) xs |> keys |> List.of_enum \ + = List.sort_unique BatInt.compare xs) *) let backwards t = Concrete.backwards t.map @@ -1195,14 +1259,12 @@ module PMap = struct (*$< PMap *) let filter f t = { t with map = Concrete.filter f t.map t.cmp } let filter_map f t = { t with map = Concrete.filter_map f t.map t.cmp } - let choose t = Concrete.choose t.map - let max_binding t = Concrete.max_binding t.map let min_binding t = Concrete.min_binding t.map - let pop_min_binding m = + let pop_min_binding m = let mini, rest = Concrete.pop_min_binding m.map in (mini, { m with map = rest }) - let pop_max_binding m = + let pop_max_binding m = let maxi, rest = Concrete.pop_max_binding m.map in (maxi, { m with map = rest }) @@ -1220,6 +1282,7 @@ module PMap = struct (*$< PMap *) let cardinal m = Concrete.cardinal m.map let choose m = Concrete.choose m.map + let any m = Concrete.any m.map let split k m = let (l, v, r) = Concrete.split k m.cmp m.map in @@ -1274,6 +1337,8 @@ module PMap = struct (*$< PMap *) module Exceptionless = struct let find k m = try Some (find k m) with Not_found -> None + let choose m = try Some (choose m) with Not_found -> None + let any m = try Some (any m) with Not_found -> None end module Infix = diff --git a/src/batMap.mli b/src/batMap.mli index 4d3fc259c..f03e9768d 100644 --- a/src/batMap.mli +++ b/src/batMap.mli @@ -102,6 +102,10 @@ sig (** [find x m] returns the current binding of [x] in [m], or raises [Not_found] if no such binding exists. *) + val find_default: 'a -> key -> 'a t -> 'a + (** [find_default d x m] returns the current binding of [x] in [m], + or the default value [d] if no such binding exists. *) + val remove: key -> 'a t -> 'a t (** [remove x m] returns a map containing the same bindings as [m], except for [x] which is unbound in the returned map. *) @@ -132,6 +136,7 @@ sig (** [extract k m] removes the current binding of [k] from [m], returning the value [k] was bound to and the updated [m]. + @raise Not_found if [k] is unbound in [m] @since 1.4.0 *) @@ -172,23 +177,23 @@ sig (in increasing order), and [d1 ... dN] are the associated data. *) val filterv: ('a -> bool) -> 'a t -> 'a t - (**[filterv f m] returns a map where only the values [a] of [m] - such that [f a = true] remain. The bindings are passed to [f] - in increasing order with respect to the ordering over the - type of the keys. *) + (** [filterv f m] returns a map where only the values [a] of [m] + such that [f a = true] remain. The bindings are passed to [f] + in increasing order with respect to the ordering over the + type of the keys. *) val filter: (key -> 'a -> bool) -> 'a t -> 'a t - (**[filter f m] returns a map where only the key, values pairs - [key], [a] of [m] such that [f key a = true] remain. The - bindings are passed to [f] in increasing order with respect - to the ordering over the type of the keys. *) + (** [filter f m] returns a map where only the [(key, value)] pairs of [m] + such that [f key value = true] remain. The bindings are passed to + [f] in increasing order with respect to the ordering over the type + of the keys. *) val filter_map: (key -> 'a -> 'b option) -> 'a t -> 'b t (** [filter_map f m] combines the features of [filter] and [map]. It calls calls [f key0 a0], [f key1 a1], [f keyn an] where [a0,a1..an] are the elements of [m] and [key0..keyn] the respective corresponding keys. It returns the map of - pairs [keyi],[bi] such as [f keyi ai = Some bi] (when [f] returns + pairs [(keyi, bi)] such as [f keyi ai = Some bi] (when [f] returns [None], the corresponding element of [m] is discarded). *) val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int @@ -202,37 +207,46 @@ sig the data associated with the keys. *) val keys : _ t -> key BatEnum.t - (** Return an enumeration of all the keys of a map.*) + (** Return an enumeration of all the keys of a map. + The returned enumeration is sorted in increasing key order. *) val values: 'a t -> 'a BatEnum.t - (** Return an enumeration of al the values of a map.*) + (** Return an enumeration of all the values of a map. + The returned enumeration is sorted in increasing key order. *) val min_binding : 'a t -> (key * 'a) - (** return the ([key,value]) pair with the smallest key *) + (** Return the [(key, value)] pair with the smallest key. *) val pop_min_binding : 'a t -> (key * 'a) * 'a t - (** return the ([key,value]) pair with the smallest key - along with the rest of the map *) + (** Return the [(key, value)] pair with the smallest key + along with the rest of the map. *) val max_binding : 'a t -> (key * 'a) - (** return the [(key,value)] pair with the largest key *) + (** Return the [(key, value)] pair with the largest key. *) val pop_max_binding : 'a t -> (key * 'a) * 'a t - (** return the ([key,value]) pair with the largest key - along with the rest of the map *) + (** Return the ([key, value]) pair with the largest key + along with the rest of the map. *) (* The following documentations comments are from stdlib's map.mli: - - choose - split - singleton - partition *) val choose : 'a t -> (key * 'a) - (** Return one binding of the given map, or raise [Not_found] if - the map is empty. Which binding is chosen is unspecified, - but equal bindings will be chosen for equal maps. + (** Return one binding of the given map. + Which binding is chosen is unspecified, but equal bindings will be + chosen for equal maps. + @raise Not_found if the map is empty *) + val any : 'a t -> (key * 'a) + (** Return one binding of the given map. + The difference with choose is that there is no guarantee that equals + elements will be picked for equal sets. + This merely returns the quickest binding to get (O(1)). + @raise Not_found if the map is empty. *) + val split : key -> 'a t -> ('a t * 'a option * 'a t) (** [split x m] returns a triple [(l, data, r)], where [l] is the map with all the bindings of [m] whose key @@ -251,7 +265,6 @@ sig @since 1.4.0 *) - val singleton: key -> 'a -> 'a t (** [singleton x y] returns the one-element map that contains a binding [y] for [x]. @@ -265,13 +278,13 @@ sig *) val enum : 'a t -> (key * 'a) BatEnum.t - (** Return an enumeration of (key, value) pairs of a map. + (** Return an enumeration of [(key, value)] pairs of a map. The returned enumeration is sorted in increasing order with respect to the ordering [Ord.compare], where [Ord] is the argument given to {!Map.Make}. *) val backwards : 'a t -> (key * 'a) BatEnum.t - (** Return an enumeration of (key, value) pairs of a map. + (** Return an enumeration of [(key, value)] pairs of a map. The returned enumeration is sorted in decreasing order with respect to the ordering [Ord.compare], where [Ord] is the argument given to {!Map.Make}. *) @@ -316,9 +329,11 @@ sig *) - (** Operations on {!Map} without exceptions.*) + (** Operations on {!Map} without exceptions. *) module Exceptionless : sig val find: key -> 'a t -> 'a option + val choose: 'a t -> (key * 'a) option + val any: 'a t -> (key * 'a) option end (** Infix operators over a {!BatMap} *) @@ -328,10 +343,10 @@ sig or raises [Not_found]. Equivalent to [find key map]. *) val (<--) : 'a t -> key * 'a -> 'a t - (** [map<--(key, value)] returns a map containing the same bindings as - [map], plus a binding of [key] to [value]. If [key] was already bound - in [map], its previous binding disappears. Equivalent - to [add key value map]*) + (** [map <-- (key, value)] returns a map containing the same bindings as + [map], plus a binding of [key] to [value]. If [key] was already bound + in [map], its previous binding disappears. + Equivalent to [add key value map]. *) end (** Operations on {!Map} with labels. @@ -363,6 +378,15 @@ module Make (Ord : BatInterfaces.OrderedType) : S with type key = Ord.t given a totally ordered type. *) +(** {6 Common instantiations} **) + +module Int : S with type key = int +module Int32 : S with type key = int32 +module Int64 : S with type key = int64 +module Nativeint : S with type key = nativeint +module Float : S with type key = float +module Char : S with type key = char +module String : S with type key = string (** {4 Polymorphic maps} @@ -381,10 +405,10 @@ val empty : ('a, 'b) t (** The empty map, using [compare] as key comparison function. *) val is_empty : ('a, 'b) t -> bool -(** returns true if the map is empty. *) +(** Returns [true] if the map is empty. *) val singleton : 'a -> 'b -> ('a, 'b) t -(** creates a new map with a single binding *) +(** Creates a new map with a single binding. *) val cardinal: ('a, 'b) t -> int (** Return the number of bindings of a map. *) @@ -406,6 +430,10 @@ val find : 'a -> ('a, 'b) t -> 'b (** [find x m] returns the current binding of [x] in [m], or raises [Not_found] if no such binding exists. *) +val find_default : 'b -> 'a -> ('a, 'b) t -> 'b +(** [find_default d x m] returns the current binding of [x] in [m], + or the default value [d] if no such binding exists. *) + val remove : 'a -> ('a, 'b) t -> ('a, 'b) t (** [remove x m] returns a map containing the same bindings as [m], except for [x] which is unbound in the returned map. *) @@ -460,7 +488,7 @@ val filterv: ('a -> bool) -> ('key, 'a) t -> ('key, 'a) t type of the keys. *) val filter: ('key -> 'a -> bool) -> ('key, 'a) t -> ('key, 'a) t -(**[filter f m] returns a map where only the (key, value) pairs +(**[filter f m] returns a map where only the [(key, value)] pairs [key], [a] of [m] such that [f key a = true] remain. The bindings are passed to [f] in increasing order with respect to the ordering over the type of the keys. *) @@ -470,19 +498,24 @@ val filter_map: ('key -> 'a -> 'b option) -> ('key, 'a) t -> ('key, 'b) t [map]. It calls calls [f key0 a0], [f key1 a1], [f keyn an] where [a0..an] are the elements of [m] and [key0..keyn] the respective corresponding keys. It returns the map of - pairs [keyi],[bi] such as [f keyi ai = Some bi] (when [f] returns + [(keyi, bi)] pairs such as [f keyi ai = Some bi] (when [f] returns [None], the corresponding element of [m] is discarded). *) -(* The following documentations comments are from stdlib's map.mli: - - choose - - split -*) val choose : ('key, 'a) t -> ('key * 'a) -(** Return one binding of the given map, or raise [Not_found] if - the map is empty. Which binding is chosen is unspecified, - but equal bindings will be chosen for equal maps. +(** Return one binding of the given map. + Which binding is chosen is unspecified, but equal bindings will be + chosen for equal maps. + @raise Not_found if the map is empty *) +val any : ('key, 'a) t -> ('key * 'a) +(** Return one binding of the given map. + The difference with choose is that there is no guarantee that equals + elements will be picked for equal sets. + This merely returns the quickest binding to get (O(1)). + @raise Not_found if the map is empty. *) + +(* The following documentation comment is from stdlib's map.mli: *) val split : 'key -> ('key, 'a) t -> (('key, 'a) t * 'a option * ('key, 'a) t) (** [split x m] returns a triple [(l, data, r)], where [l] is the map with all the bindings of [m] whose key @@ -494,37 +527,39 @@ val split : 'key -> ('key, 'a) t -> (('key, 'a) t * 'a option * ('key, 'a) t) *) val min_binding : ('key, 'a) t -> ('key * 'a) -(** returns the binding with the smallest key *) +(** Returns the binding with the smallest key. *) val pop_min_binding : ('key, 'a) t -> ('key * 'a) * ('key, 'a) t -(** returns the binding with the smallest key along with the rest of the map *) +(** Returns the binding with the smallest key along with the rest of the map. *) val max_binding : ('key, 'a) t -> ('key * 'a) -(** returns the binding with the largest key *) +(** Returns the binding with the largest key. *) val pop_max_binding : ('key, 'a) t -> ('key * 'a) * ('key, 'a) t -(** returns the binding with the largest key along with the rest of the map *) +(** Returns the binding with the largest key along with the rest of the map. *) val enum : ('a, 'b) t -> ('a * 'b) BatEnum.t -(** creates an enumeration for this map, enumerating key,value pairs with the keys in increasing order. *) +(** Creates an enumeration for this map, enumerating [(key, value)] pairs + with the keys in increasing order. *) val backwards : ('a,'b) t -> ('a * 'b) BatEnum.t -(** creates an enumeration for this map, enumerating key,value pairs with the keys in decreasing order. *) +(** Creates an enumeration for this map, enumerating [(key, value)] pairs + with the keys in decreasing order. *) val keys : ('a,'b) t -> 'a BatEnum.t -(** Return an enumeration of all the keys of a map.*) +(** Return an enumeration of all the keys of a map. *) val values: ('a,'b) t -> 'b BatEnum.t -(** Return an enumeration of al the values of a map.*) +(** Return an enumeration of all the values of a map. *) val of_enum : ('a * 'b) BatEnum.t -> ('a, 'b) t -(** Creates a map from an enumeration *) +(** Creates a map from an enumeration. *) val for_all : ('a -> 'b -> bool) -> ('a, 'b) t -> bool -(** Tests whether all key value pairs satisfy some predicate function *) +(** Tests whether all [(key, value)] pairs satisfy a predicate function. *) val exists : ('a -> 'b -> bool) -> ('a, 'b) t -> bool -(** Tests whether some key value pair satisfies some predicate function *) +(** Tests whether some [(key, value)] pair satisfies a predicate function. *) (* documentation comment from INRIA's stdlib *) val partition : ('a -> 'b -> bool) -> ('a, 'b) t -> ('a, 'b) t * ('a, 'b) t @@ -534,7 +569,8 @@ val partition : ('a -> 'b -> bool) -> ('a, 'b) t -> ('a, 'b) t * ('a, 'b) t not satisfy [p]. *) val add_carry : 'a -> 'b -> ('a, 'b) t -> ('a, 'b) t * 'b option -(** [add_carry k v m] adds the binding [(k,v)] to [m], returning the new map and optionally the previous value bound to [k]. *) +(** [add_carry k v m] adds the binding [(k, v)] to [m], returning the new + map and optionally the previous value bound to [k]. *) val modify : 'a -> ('b -> 'b) -> ('a, 'b) t -> ('a, 'b) t (** [modify k f m] replaces the previous binding for [k] with [f] @@ -576,8 +612,8 @@ val union : ('a, 'b) t -> ('a, 'b) t -> ('a, 'b) t val diff : ('a, 'b) t -> ('a, 'b) t -> ('a, 'b) t (** [diff m1 m2] removes all bindings of keys found in [m2] from [m1], using the comparison function of [m1]. Equivalent to - [foldi (fun k _v m -> remove k m) m2 m1] - The resulting map uses the comparison function of [m1].*) + [foldi (fun k _v m -> remove k m) m2 m1]. + The resulting map uses the comparison function of [m1]. *) val intersect : ('b -> 'c -> 'd) -> ('a, 'b) t -> ('a, 'c) t -> ('a, 'd) t (** [intersect merge_f m1 m2] returns a map with bindings only for @@ -603,6 +639,8 @@ val equal : ('b -> 'b -> bool) -> ('a,'b) t -> ('a, 'b) t -> bool (** Exceptionless versions of functions *) module Exceptionless : sig val find: 'a -> ('a,'b) t -> 'b option + val choose: ('a, 'b) t -> ('a * 'b) option + val any: ('a, 'b) t -> ('a * 'b) option end @@ -610,14 +648,14 @@ end (** Infix operators over a {!BatPMap} *) module Infix : sig val (-->) : ('a, 'b) t -> 'a -> 'b - (** [map-->key] returns the current binding of [key] in [map], + (** [map --> key] returns the current binding of [key] in [map], or raises [Not_found]. Equivalent to [find key map]. *) val (<--) : ('a, 'b) t -> 'a * 'b -> ('a, 'b) t - (** [map<--(key, value)] returns a map containing the same bindings as - [map], plus a binding of [key] to [value]. If [key] was already bound - in [map], its previous binding disappears. Equivalent - to [add key value map]*) + (** [map <-- (key, value)] returns a map containing the same bindings as + [map], plus a binding of [key] to [value]. If [key] was already bound + in [map], its previous binding disappears. + Equivalent to [add key value map]. *) end (** Map find and insert from Infix *) @@ -671,16 +709,16 @@ module PMap : sig (** The empty map, using [compare] as key comparison function. *) val is_empty : ('a, 'b) t -> bool - (** returns true if the map is empty. *) + (** Returns [true] if the map is empty. *) val create : ('a -> 'a -> int) -> ('a, 'b) t - (** creates a new empty map, using the provided function for key comparison.*) + (** Creates a new empty map, using the provided function for key comparison. *) val get_cmp : ('a, 'b) t -> ('a -> 'a -> int) - (** returns the comparison function of the given map *) + (** Returns the comparison function of the given map. *) val singleton : ?cmp:('a -> 'a -> int) -> 'a -> 'b -> ('a, 'b) t - (** creates a new map with a single binding *) + (** Creates a new map with a single binding. *) val cardinal: ('a, 'b) t -> int (** Return the number of bindings of a map. *) @@ -702,6 +740,10 @@ module PMap : sig (** [find x m] returns the current binding of [x] in [m], or raises [Not_found] if no such binding exists. *) + val find_default : 'b -> 'a -> ('a, 'b) t -> 'b + (** [find_default d x m] returns the current binding of [x] in [m], + or the default value [d] if no such binding exists. *) + val remove : 'a -> ('a, 'b) t -> ('a, 'b) t (** [remove x m] returns a map containing the same bindings as [m], except for [x] which is unbound in the returned map. *) @@ -756,7 +798,7 @@ module PMap : sig type of the keys. *) val filter: ('key -> 'a -> bool) -> ('key, 'a) t -> ('key, 'a) t - (**[filter f m] returns a map where only the (key, value) pairs + (**[filter f m] returns a map where only the [(key, value)] pairs [key], [a] of [m] such that [f key a = true] remain. The bindings are passed to [f] in increasing order with respect to the ordering over the type of the keys. *) @@ -766,18 +808,24 @@ module PMap : sig [map]. It calls calls [f key0 a0], [f key1 a1], [f keyn an] where [a0..an] are the elements of [m] and [key0..keyn] the respective corresponding keys. It returns the map of - pairs [keyi],[bi] such as [f keyi ai = Some bi] (when [f] returns + ([keyi], [bi]) pairs such as [f keyi ai = Some bi] (when [f] returns [None], the corresponding element of [m] is discarded). *) - (* The following documentations comments are from stdlib's map.mli: - - choose - - split - *) val choose : ('key, 'a) t -> ('key * 'a) - (** Return one binding of the given map, or raise [Not_found] if - the map is empty. Which binding is chosen is unspecified, - but equal bindings will be chosen for equal maps. *) + (** Return one binding of the given map. + Which binding is chosen is unspecified, but equal bindings will be chosen + for equal maps. + @raise Not_found if the map is empty. *) + + val any : ('key, 'a) t -> ('key * 'a) + (** Return one binding of the given map. + The difference with choose is that there is no guarantee that equals + elements will be picked for equal sets. + This merely returns the quickest binding to get (O(1)). + @raise Not_found if the map is empty. *) + + (* The following documentation comment is from stdlib's map.mli: *) val split : 'key -> ('key, 'a) t -> (('key, 'a) t * 'a option * ('key, 'a) t) (** [split x m] returns a triple [(l, data, r)], where [l] is the map with all the bindings of [m] whose key @@ -788,38 +836,40 @@ module PMap : sig or [Some v] if [m] binds [v] to [x]. *) val min_binding : ('key, 'a) t -> ('key * 'a) - (** returns the binding with the smallest key *) + (** Returns the binding with the smallest key. *) val pop_min_binding : ('key, 'a) t -> ('key * 'a) * ('key, 'a) t - (** return the binding with the smallest key along with the rest of the map *) + (** Return the binding with the smallest key along with the rest of the map. *) val max_binding : ('key, 'a) t -> ('key * 'a) - (** returns the binding with the largest key *) + (** Returns the binding with the largest key. *) val pop_max_binding : ('key, 'a) t -> ('key * 'a) * ('key, 'a) t - (** return the binding with the largest key along with the rest of the map *) + (** Return the binding with the largest key along with the rest of the map. *) val enum : ('a, 'b) t -> ('a * 'b) BatEnum.t - (** creates an enumeration for this map, enumerating key,value pairs with the keys in increasing order. *) + (** Creates an enumeration for this map, enumerating [(key, value)] pairs + with the keys in increasing order. *) val backwards : ('a,'b) t -> ('a * 'b) BatEnum.t - (** creates an enumeration for this map, enumerating key,value pairs with the keys in decreasing order. *) + (** Creates an enumeration for this map, enumerating [(key, value)] pairs + with the keys in decreasing order. *) val keys : ('a,'b) t -> 'a BatEnum.t - (** Return an enumeration of all the keys of a map.*) + (** Return an enumeration of all the keys of a map. *) val values: ('a,'b) t -> 'b BatEnum.t - (** Return an enumeration of al the values of a map.*) + (** Return an enumeration of all the values of a map. *) val of_enum : ?cmp:('a -> 'a -> int) -> ('a * 'b) BatEnum.t -> ('a, 'b) t (** creates a map from an enumeration, using the specified function for key comparison or [compare] by default. *) val for_all : ('a -> 'b -> bool) -> ('a, 'b) t -> bool - (** Tests whether all key value pairs satisfy some predicate function *) + (** Tests whether all [(key, value)] pairs satisfy a predicate function. *) val exists : ('a -> 'b -> bool) -> ('a, 'b) t -> bool - (** Tests whether some key value pair satisfies some predicate function *) + (** Tests whether some [(key, value)] pair satisfies a predicate function. *) (* documentation comment from INRIA's stdlib *) val partition : ('a -> 'b -> bool) -> ('a, 'b) t -> ('a, 'b) t * ('a, 'b) t @@ -829,12 +879,13 @@ module PMap : sig not satisfy [p]. *) val add_carry : 'a -> 'b -> ('a, 'b) t -> ('a, 'b) t * 'b option - (** [add_carry k v m] adds the binding [(k,v)] to [m], returning the new map and optionally the previous value bound to [k]. *) + (** [add_carry k v m] adds the binding [(k, v)] to [m], returning the new + map and optionally the previous value bound to [k]. *) val modify : 'a -> ('b -> 'b) -> ('a, 'b) t -> ('a, 'b) t (** [modify k f m] replaces the previous binding for [k] with [f] - applied to that value. If [k] is unbound in [m] or [Not_found] is - raised during the search, [Not_found] is raised. + applied to that value. If [k] is unbound in [m] or [Not_found] is + raised during the search, [Not_found] is raised. @since 1.2.0 @raise Not_found if [k] is unbound in [m] (or [f] raises [Not_found]) *) @@ -842,8 +893,8 @@ module PMap : sig val modify_def: 'b -> 'a -> ('b -> 'b) -> ('a,'b) t -> ('a,'b) t (** [modify_def v0 k f m] replaces the previous binding for [k] with [f] applied to that value. If [k] is unbound in [m] or - [Not_found] is raised during the search, [f v0] is - inserted (as if the value found were [v0]). + [Not_found] is raised during the search, [f v0] is inserted + (as if the value found were [v0]). @since 1.3.0 *) @@ -870,8 +921,8 @@ module PMap : sig val diff : ('a, 'b) t -> ('a, 'b) t -> ('a, 'b) t (** [diff m1 m2] removes all bindings of keys found in [m2] from [m1], using the comparison function of [m1]. Equivalent to - [foldi (fun k _v m -> remove k m) m2 m1] - The resulting map uses the comparison function of [m1].*) + [foldi (fun k _v m -> remove k m) m2 m1]. + The resulting map uses the comparison function of [m1]. *) val intersect : ('b -> 'c -> 'd) -> ('a, 'b) t -> ('a, 'c) t -> ('a, 'd) t (** [intersect merge_f m1 m2] returns a map with bindings only for @@ -899,12 +950,14 @@ module PMap : sig val equal : ('b -> 'b -> bool) -> ('a,'b) t -> ('a, 'b) t -> bool (** Construct a comparison or equality function for maps based on a value comparison or equality function. Uses the key comparison - function to compare keys *) + function to compare keys. *) (** Exceptionless versions of functions *) module Exceptionless : sig val find: 'a -> ('a,'b) t -> 'b option + val choose: ('a, 'b) t -> ('a * 'b) option + val any: ('a, 'b) t -> ('a * 'b) option end @@ -915,10 +968,10 @@ module PMap : sig or raises [Not_found]. Equivalent to [find key map]. *) val (<--) : ('a, 'b) t -> 'a * 'b -> ('a, 'b) t - (** [map<--(key, value)] returns a map containing the same bindings as - [map], plus a binding of [key] to [value]. If [key] was already bound - in [map], its previous binding disappears. Equivalent - to [add key value map]*) + (** [map <-- (key, value)] returns a map containing the same bindings as + [map], plus a binding of [key] to [value]. If [key] was already bound + in [map], its previous binding disappears. + Equivalent to [add key value map]. *) end (** Map find and insert from Infix *) @@ -946,4 +999,3 @@ module PMap : sig val get_cmp : ('a, 'b) t -> ('a -> 'a -> int) end (* PMap module *) - diff --git a/src/batMarshal.mliv b/src/batMarshal.mliv index 84038ae7f..a9599475c 100644 --- a/src/batMarshal.mliv +++ b/src/batMarshal.mliv @@ -88,8 +88,10 @@ val output: _ BatInnerIO.output -> ?sharing:bool -> ?closures:bool -> 'a -> unit un-marshaling time, using an MD5 digest of the code transmitted along with the code position.) *) -external to_bytes : - 'a -> extern_flags list -> Bytes.t = "caml_output_value_to_string" +##V<4.7##external to_bytes : +##V<4.7## 'a -> extern_flags list -> Bytes.t = "caml_output_value_to_string" +##V>=4.7##external to_bytes : +##V>=4.7## 'a -> extern_flags list -> Bytes.t = "caml_output_value_to_bytes" (** [Marshal.to_bytes v flags] returns a byte sequence containing the representation of [v]. The [flags] argument has the same meaning as for diff --git a/src/batMarshal.mlv b/src/batMarshal.mlv index da728a03d..493aee62c 100644 --- a/src/batMarshal.mlv +++ b/src/batMarshal.mlv @@ -22,6 +22,10 @@ include Marshal +##V<4.2##let from_bytes = from_string +##V<4.2##external to_bytes : +##V<4.2## 'a -> extern_flags list -> Bytes.t = "caml_output_value_to_string" + let output out ?(sharing=true) ?(closures=false) v = let flags = match sharing, closures with | true, false -> [] @@ -33,15 +37,18 @@ let output out ?(sharing=true) ?(closures=false) v = BatInnerIO.nwrite out buf let input inp = - let header = BatInnerIO.really_nread inp header_size in - let size = data_size header 0 in - from_string (header ^ (BatInnerIO.really_nread inp size)) 0 + let header = Bytes.create header_size in + let read = BatInnerIO.really_input inp header 0 header_size in + assert (read = header_size); + let data_size = data_size header 0 in + let buf = Bytes.extend header 0 data_size in + let read = BatInnerIO.really_input inp buf header_size data_size in + assert (read = data_size); + from_bytes buf 0 + +let from_channel = input let to_channel out v flags = BatInnerIO.nwrite out (to_string v flags) -let from_channel = input -##V<4.2##let from_bytes = from_string -##V<4.2##external to_bytes : -##V<4.2## 'a -> extern_flags list -> Bytes.t = "caml_output_value_to_string" diff --git a/src/batMultiPMap.mli b/src/batMultiPMap.mli index 261b68e79..0569ebd1f 100644 --- a/src/batMultiPMap.mli +++ b/src/batMultiPMap.mli @@ -33,13 +33,14 @@ type ('a, 'b) t val empty : ('a, 'b) t -(** The empty map, using [compare] as key comparison function. *) +(** The empty map, using [compare] as comparison function for both keys and values. *) val is_empty : ('a, 'b) t -> bool (** returns true if the map is empty. *) val create : ('a -> 'a -> int) -> ('b -> 'b -> int) -> ('a, 'b) t -(** creates a new empty map, using the provided function for key comparison.*) +(** [create kcomp vcomp] creates a new empty map, + using kcomp for key comparison and vcomp for value comparison.*) val add : 'a -> 'b -> ('a, 'b) t -> ('a, 'b) t (** [add x y m] returns a map containing the same bindings as @@ -71,11 +72,14 @@ val iter : ('a -> 'b BatSet.PSet.t-> unit) -> ('a, 'b) t -> unit bindings hidden by more recent bindings are not passed to [f]. *) val map : ('b BatSet.PSet.t -> 'c BatSet.PSet.t) -> (('b -> 'b -> int) -> ('c -> 'c -> int)) -> ('a, 'b) t -> ('a, 'c) t -(** [map f m] returns a map with same domain as [m], where the +(** [map f vcompgen m] returns a map with same domain as [m], where the associated value [a] of all bindings of [m] has been replaced by the result of the application of [f] to [a]. The order in which the associated values are passed to [f] - is unspecified. *) + is unspecified. + [vcompgen] will use the vcomp function provided to [m] as an + argument to generate a new value comparison function. + *) val mapi : ('a -> 'b BatSet.PSet.t -> 'c BatSet.PSet.t) -> (('b -> 'b -> int) -> ('c -> 'c -> int)) -> ('a, 'b) t -> ('a, 'c) t (** Same as [map], but the function receives as arguments both the diff --git a/src/batNativeint.mliv b/src/batNativeint.mliv index b37545f5c..2a29bbb23 100644 --- a/src/batNativeint.mliv +++ b/src/batNativeint.mliv @@ -78,6 +78,12 @@ external div : nativeint -> nativeint -> nativeint = "%nativeint_div" argument is zero. This division rounds the real quotient of its arguments towards zero, as specified for {!Pervasives.(/)}. *) +##V>=4.08##val unsigned_div : nativeint -> nativeint -> nativeint +##V>=4.08##(** Same as {!div}, except that arguments and result are interpreted as {e +##V>=4.08## unsigned} native integers. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + external rem : nativeint -> nativeint -> nativeint = "%nativeint_mod" (** Integer remainder. If [y] is not zero, the result of [Nativeint.rem x y] satisfies the following properties: @@ -85,6 +91,12 @@ external rem : nativeint -> nativeint -> nativeint = "%nativeint_mod" [x = Nativeint.add (Nativeint.mul (Nativeint.div x y) y) (Nativeint.rem x y)]. If [y = 0], [Nativeint.rem x y] raises [Division_by_zero]. *) +##V>=4.08##val unsigned_rem : nativeint -> nativeint -> nativeint +##V>=4.08##(** Same as {!rem}, except that arguments and result are interpreted as {e +##V>=4.08## unsigned} native integers. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + val succ : nativeint -> nativeint (** Successor. [Nativeint.succ x] is [Nativeint.add x Nativeint.one]. *) @@ -163,6 +175,13 @@ external to_int : nativeint -> int = "%nativeint_to_int" integer (type [int]). The high-order bit is lost during the conversion. *) +##V>=4.08##val unsigned_to_int : nativeint -> int option +##V>=4.08##(** Same as {!to_int}, but interprets the argument as an {e unsigned} integer. +##V>=4.08## Returns [None] if the unsigned value of the argument cannot fit into an +##V>=4.08## [int]. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + external of_float : float -> nativeint = "caml_nativeint_of_float" ##V>=4.3## "caml_nativeint_of_float_unboxed" [@@unboxed] [@@noalloc] (** Convert the given floating-point number to a native integer, @@ -204,6 +223,10 @@ external of_string : string -> nativeint = "caml_nativeint_of_string" a valid representation of an integer, or if the integer represented exceeds the range of integers representable in type [nativeint]. *) +val of_string_opt: string -> nativeint option +(** Same as [of_string], but return [None] instead of raising. + @since 2.7.0 *) + val to_string : nativeint -> string (** Return the string representation of its argument, in decimal. *) @@ -215,6 +238,12 @@ val compare : t -> t -> int allows the module [Nativeint] to be passed as argument to the functors {!Set.Make} and {!Map.Make}. *) +##V>=4.08##val unsigned_compare: t -> t -> int +##V>=4.08##(** Same as {!compare}, except that arguments are interpreted as {e unsigned} +##V>=4.08## native integers. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + val equal : t -> t -> bool (** Equality function for 64-bit integers, useful for {!HashedType}. *) diff --git a/src/batNativeint.mlv b/src/batNativeint.mlv index fd8ea6852..6771ffe79 100644 --- a/src/batNativeint.mlv +++ b/src/batNativeint.mlv @@ -73,8 +73,14 @@ external to_int64 : nativeint -> int64 = "%int64_of_nativeint" *) external of_string : string -> nativeint = "caml_nativeint_of_string" +##V>=4.5##let of_string_opt = Nativeint.of_string_opt +##V<4.5##let of_string_opt s = try Some (Nativeint.of_string s) with _ -> None external format : string -> nativeint -> string = "caml_nativeint_format" +##V>=4.08##let unsigned_compare = Nativeint.unsigned_compare +##V>=4.08##let unsigned_to_int = Nativeint.unsigned_to_int +##V>=4.08##let unsigned_rem = Nativeint.unsigned_rem +##V>=4.08##let unsigned_div = Nativeint.unsigned_div type bounded = t let min_num, max_num = min_int, max_int diff --git a/src/batNum.ml b/src/batNum.ml index e6de91add..ee2dfebd2 100644 --- a/src/batNum.ml +++ b/src/batNum.ml @@ -95,20 +95,19 @@ let print out t = BatInnerIO.nwrite out (to_string t) let of_float_string a = try let ipart_s,fpart_s = BatString.split a ~by:"." in - let ipart = if ipart_s = "" then zero else of_string ipart_s in - let fpart = - if fpart_s = "" then zero - else - let fpart = of_string fpart_s in - let num10 = of_int 10 in - let frac = pow num10 (of_int (String.length fpart_s)) in - Infix.(fpart/frac) - in - add ipart fpart + if fpart_s = "" + then of_string ipart_s + else + let frac = pow (of_int 10) (of_int (String.length fpart_s)) in + div (of_string (ipart_s ^ fpart_s)) frac with Not_found -> of_string a - (**T - of_float_string "2.5" = of_string "5/2" - of_float_string "2." = of_string "2" - of_float_string ".5" = of_string "1/2" - *) +(*$T + equal (of_float_string "2.5") (of_string "5/2") + equal (of_float_string "-2.5") (of_string "-5/2") + equal (of_float_string "-2.1") (of_string "-21/10") + equal (of_float_string "2.") (of_string "2") + equal (of_float_string ".5") (of_string "1/2") + equal (of_float_string "-0.5") (of_string "-1/2") + equal (of_float_string "-.5") (of_string "-1/2") +*) diff --git a/src/batOo.mli b/src/batOo.mli deleted file mode 100644 index 7512ddbde..000000000 --- a/src/batOo.mli +++ /dev/null @@ -1,190 +0,0 @@ -(* - * BatOO - Extended operations on objects - * Copyright (C) 1996 Jerome Vouillon, INRIA - * 2008 David Teller, LIFO, Universite d'Orleans - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version, - * with the special exception on linking described in file LICENSE. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - *) - -(** Operations on objects - - @author Jerome Vouillon (Base module) - @author David Teller (integration to Batteries) -*) - -val copy : (< .. > as 'a) -> 'a -(** [Oo.copy o] returns a copy of object [o], that is a fresh - object with the same methods and instance variables as [o] *) - -external id : < .. > -> int = "%field1" -(** Return an integer identifying this object, unique for - the current execution of the program. *) - -(**/**) -(** For internal use (CamlIDL) *) - -val new_method : string -> CamlinternalOO.tag(**As {!Internal.public_method_label}*) -val public_method_label : string -> CamlinternalOO.tag(**As {!Internal.public_method_label}*) - -(**/**) - -module Internal: -sig - - (** Run-time support for objects and classes. - All functions in this module are for system use only, not for the - casual user. - - @documents CamlinternalOO - *) - - (** {6 Classes} *) - - type tag = CamlinternalOO.tag - type label = CamlinternalOO.label - type table = CamlinternalOO.table (**Internal representation of the vtable, i.e. the table of virtual methods.*) - type meth = CamlinternalOO.meth - type t = CamlinternalOO.t - type obj = CamlinternalOO.obj (**Internal representation of an object.*) - type closure = CamlinternalOO.closure(**Internal representation of a method.*) - - val public_method_label : string -> tag - val new_method : table -> label - val new_variable : table -> string -> int - val new_methods_variables : - table -> string array -> string array -> label array - val get_variable : table -> string -> int - val get_variables : table -> string array -> int array - val get_method_label : table -> string -> label - val get_method_labels : table -> string array -> label array - val get_method : table -> label -> meth - val set_method : table -> label -> meth -> unit - val set_methods : table -> label array -> unit - val narrow : table -> string array -> string array -> string array -> unit - val widen : table -> unit - val add_initializer : table -> (obj -> unit) -> unit - val dummy_table : table - val create_table : string array -> table - val init_class : table -> unit - val inherits : - table -> string array -> string array -> string array -> - (t * (table -> obj -> Obj.t) * t * obj) -> bool -> Obj.t array - val make_class : - string array -> (table -> Obj.t -> t) -> - (t * (table -> Obj.t -> t) * (Obj.t -> t) * Obj.t) - type init_table = CamlinternalOO.init_table - val make_class_store : - string array -> (table -> t) -> init_table -> unit - val dummy_class : - string * int * int -> - (t * (table -> Obj.t -> t) * (Obj.t -> t) * Obj.t) - - (** {6 Objects} *) - - val copy : (< .. > as 'a) -> 'a - val create_object : table -> obj - val create_object_opt : obj -> table -> obj - val run_initializers : obj -> table -> unit - val run_initializers_opt : obj -> obj -> table -> obj - val create_object_and_run_initializers : obj -> table -> obj - external send : obj -> tag -> t = "%send" - external sendcache : obj -> tag -> t -> int -> t = "%sendcache" - external sendself : obj -> label -> t = "%sendself" - external get_public_method : obj -> tag -> closure - = "caml_get_public_method" "noalloc" - - (** {6 Table cache} *) - - type tables = CamlinternalOO.tables - val lookup_tables : tables -> closure array -> tables - - (** {6 Builtins to reduce code size} *) - - (* - val get_const : t -> closure - val get_var : int -> closure - val get_env : int -> int -> closure - val get_meth : label -> closure - val set_var : int -> closure - val app_const : (t -> t) -> t -> closure - val app_var : (t -> t) -> int -> closure - val app_env : (t -> t) -> int -> int -> closure - val app_meth : (t -> t) -> label -> closure - val app_const_const : (t -> t -> t) -> t -> t -> closure - val app_const_var : (t -> t -> t) -> t -> int -> closure - val app_const_env : (t -> t -> t) -> t -> int -> int -> closure - val app_const_meth : (t -> t -> t) -> t -> label -> closure - val app_var_const : (t -> t -> t) -> int -> t -> closure - val app_env_const : (t -> t -> t) -> int -> int -> t -> closure - val app_meth_const : (t -> t -> t) -> label -> t -> closure - val meth_app_const : label -> t -> closure - val meth_app_var : label -> int -> closure - val meth_app_env : label -> int -> int -> closure - val meth_app_meth : label -> label -> closure - val send_const : tag -> obj -> int -> closure - val send_var : tag -> int -> int -> closure - val send_env : tag -> int -> int -> int -> closure - val send_meth : tag -> label -> int -> closure - *) - - type impl = CamlinternalOO.impl = - GetConst - | GetVar - | GetEnv - | GetMeth - | SetVar - | AppConst - | AppVar - | AppEnv - | AppMeth - | AppConstConst - | AppConstVar - | AppConstEnv - | AppConstMeth - | AppVarConst - | AppEnvConst - | AppMethConst - | MethAppConst - | MethAppVar - | MethAppEnv - | MethAppMeth - | SendConst - | SendVar - | SendEnv - | SendMeth - | Closure of closure - - (** {6 Parameters} *) - - (** currently disabled *) - type params = CamlinternalOO.params = - { mutable compact_table : bool; - mutable copy_parent : bool; - mutable clean_when_copying : bool; - mutable retry_count : int; - mutable bucket_small_size : int } - - val params : params - - (** {6 Statistics} *) - - type stats = CamlinternalOO.stats = - { classes : int; - methods : int; - inst_vars : int } - val stats : unit -> stats - -end diff --git a/src/batOptParse.mli b/src/batOptParse.mli index f28577e47..5e0c74879 100644 --- a/src/batOptParse.mli +++ b/src/batOptParse.mli @@ -419,7 +419,7 @@ sig (** Add an option to the option parser. @raise Option_conflict if the short name(s) or long name(s) - have alread been used for some other option. + have already been used for some other option. @param help Short help message describing the option (for the usage message). diff --git a/src/batOption.ml b/src/batOption.ml index 14d6e4ae2..5a151f1f5 100644 --- a/src/batOption.ml +++ b/src/batOption.ml @@ -19,7 +19,6 @@ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) -exception No_value type 'a t = 'a option diff --git a/src/batOrd.mli b/src/batOrd.mli index 719b53a95..2b363bc23 100644 --- a/src/batOrd.mli +++ b/src/batOrd.mli @@ -118,7 +118,7 @@ val bin_comp : 'a comp -> 'a -> 'a -> 'b comp -> 'b -> 'b -> int val bin_ord : 'a ord -> 'a -> 'a -> 'b ord -> 'b -> 'b -> order (** binary lifting of the comparison function, using lexicographic order: [bin_ord ord1 v1 v1' ord2 v2 v2'] is [ord2 v2 v2'] if [ord1 v1 v1' = Eq], - and [ord1 v1 v1'] otherwhise. + and [ord1 v1 v1'] otherwise. *) val bin_eq : 'a eq -> 'a -> 'a -> 'b eq -> 'b -> 'b -> bool diff --git a/src/batParserCo.mli b/src/batParserCo.mli index 1fbe15af1..bfede519f 100644 --- a/src/batParserCo.mli +++ b/src/batParserCo.mli @@ -42,7 +42,7 @@ (**The current state of the parser. The actual set of states is defined by the user. States are - typically used to convey informations, such as position in the file + typically used to convey information, such as position in the file (i.e. line number and character). *) @@ -132,7 +132,7 @@ val any: ('a, 'a, _) t (**Accept any singleton value.*) val return: 'b -> (_, 'b, _) t -(**A parser which always succeds*) +(**A parser which always succeeds*) val satisfy: ('a -> bool) -> ('a, 'a, _) t (**[satisfy p] accepts one value [p x] such that [p x = true]*) diff --git a/src/batPathGen.ml b/src/batPathGen.ml index 46a97ba31..647989b6d 100644 --- a/src/batPathGen.ml +++ b/src/batPathGen.ml @@ -1,6 +1,6 @@ (* * Path - Path and directory manipulation - * Copyright (C) 2008 Dawid Towon + * Copyright (C) 2008 Dawid Toton * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public @@ -316,7 +316,7 @@ module type PathType = sig (** = {!of_string} *) (** {6 Name related functions} - These funtions do not accept empty paths, i.e. [\[\]], [\[""\]] or [\["C:"\]]. + These functions do not accept empty paths, i.e. [\[\]], [\[""\]] or [\["C:"\]]. *) val name : t -> ustring @@ -547,7 +547,7 @@ module Make = functor (S : StringType) -> struct let _, result = List.fold_left fold (S.length ss, []) !rev_separators in result - (* Returns true if windows and the arugment is letter-colon, false otherwise *) + (* Returns true if windows and the argument is letter-colon, false otherwise *) let is_win_disk_letter = if windows then let pars = BatParserCo.(>>>) S.Parse.letter (BatParserCo.exactly (S.lift_char ':')) in @@ -597,7 +597,7 @@ module Make = functor (S : StringType) -> struct let concat basepath relpath = let simple_concat () = if is_relative relpath then relpath @ basepath - else raise (Invalid_argument "Path.concat") + else invalid_arg "PathGen.concat" in if windows then begin @@ -606,7 +606,7 @@ module Make = functor (S : StringType) -> struct (* special rules *) begin match relpath with - | nm :: _ when isnul nm -> raise (Invalid_argument "Path.concat") + | nm :: _ when isnul nm -> invalid_arg "PathGen.concat" | _ -> relpath @ basepath (* allow drive-letter inside the path *) end | _ -> simple_concat () @@ -650,8 +650,8 @@ module Make = functor (S : StringType) -> struct let parent path = match path with - | [] -> raise (Invalid_argument "Path.parent") - | [rt] when isroot rt -> raise (Invalid_argument "Path.parent") + | [] -> invalid_arg "PathGen.parent" + | [rt] when isroot rt -> invalid_arg "PathGen.parent" | _ :: par -> par let belongs base sub = @@ -670,8 +670,8 @@ module Make = functor (S : StringType) -> struct match rbase, rsub with | hb::_, hs::_ when hb = hs -> fold rbase rsub | hb::_, hs::_ -> false - | rt::_, _ when isroot rt -> raise (Invalid_argument "Path.belongs") - | _, rt::_ when isroot rt -> raise (Invalid_argument "Path.belongs") + | rt::_, _ when isroot rt -> invalid_arg "PathGen.belongs" + | _, rt::_ when isroot rt -> invalid_arg "PathGen.belongs" | _, _ -> fold rbase rsub let gen_relative_to parent_only base sub = @@ -688,8 +688,8 @@ module Make = functor (S : StringType) -> struct let rsub = List.rev sub in let rrel = match rbase, rsub with | hb::_, hs::_ when hb = hs -> fold rbase rsub - | rt::_, _ when isroot rt -> raise (Invalid_argument "Path.relative_to_*") - | _, rt::_ when isroot rt -> raise (Invalid_argument "Path.relative_to_*") + | rt::_, _ when isroot rt -> invalid_arg "PathGen.relative_to_*" + | _, rt::_ when isroot rt -> invalid_arg "PathGen.relative_to_*" | _, _ -> fold rbase rsub in List.rev rrel @@ -745,8 +745,8 @@ module Make = functor (S : StringType) -> struct let with_nonempty path fu = match path with - | [] -> raise (Invalid_argument "Path.parent") - | [rt] when isroot rt -> raise (Invalid_argument "Path.parent") + | [] -> invalid_arg "PathGen.name" + | [rt] when isroot rt -> invalid_arg "PathGen.name" | name :: parent -> (fu name parent) let name path = with_nonempty path @@ -811,7 +811,7 @@ module Make = functor (S : StringType) -> struct match List.rev abs with | nul :: _ when isnul nul -> None | drv :: _ when is_win_disk_letter drv -> Some (S.get drv 0) - | _ -> raise (Invalid_argument "Path.drive_letter") + | _ -> invalid_arg "PathGen.drive_letter" end diff --git a/src/batPathGen.mli b/src/batPathGen.mli index 176da60ab..6c98c9b71 100644 --- a/src/batPathGen.mli +++ b/src/batPathGen.mli @@ -317,7 +317,7 @@ module type PathType = sig (** = {!of_string} *) (** {6 Name related functions} - These funtions do not accept empty paths, i.e. [\[\]], [\[""\]] or [\["C:"\]]. + These functions do not accept empty paths, i.e. [\[\]], [\[""\]] or [\["C:"\]]. *) val name : t -> ustring diff --git a/src/batPervasives.ml b/src/batPervasives.ml index 578e1d32b..c2a829451 100644 --- a/src/batPervasives.ml +++ b/src/batPervasives.ml @@ -58,13 +58,13 @@ let input_all ic = if n = 0 then let res = Bytes.create total in let pos = total - ofs in - let _ = String.blit buf 0 res pos ofs in + let _ = Bytes.blit buf 0 res pos ofs in let coll pos buf = let new_pos = pos - buf_len in - String.blit buf 0 res new_pos buf_len; + Bytes.blit buf 0 res new_pos buf_len; new_pos in let _ = List.fold_left coll pos acc in - res + Bytes.unsafe_to_string res else let new_ofs = ofs + n in let new_total = total + n in @@ -213,6 +213,8 @@ let output_char = BatChar.print let output_string = BatString.print let output oc buf pos len = ignore (BatIO.output oc buf pos len) +let output_substring oc buf pos len = + ignore (BatIO.output_substring oc buf pos len) let output_byte = BatIO.write_byte let output_binary_int = BatIO.write_i32 let output_binary_float out v= BatIO.write_i64 out (BatInt64.bits_of_float v) diff --git a/src/batPervasives.mliv b/src/batPervasives.mliv index 635321421..9bb1aee09 100644 --- a/src/batPervasives.mliv +++ b/src/batPervasives.mliv @@ -221,8 +221,14 @@ val output_char : unit BatIO.output -> char -> unit val output_string : unit BatIO.output -> string -> unit (** Write the string on the given output channel. *) -val output : unit BatIO.output -> string -> int -> int -> unit -(** [output oc buf pos len] writes [len] characters from string [buf], +val output : unit BatIO.output -> Bytes.t -> int -> int -> unit +(** [output oc buf pos len] writes [len] characters from byte sequence [buf], + starting at offset [pos], to the given output channel [oc]. + @raise Invalid_argument if [pos] and [len] do not + designate a valid subsequence of [buf]. *) + +val output_substring : unit BatIO.output -> string -> int -> int -> unit +(** [output_substring oc buf pos len] writes [len] characters from string [buf], starting at offset [pos], to the given output channel [oc]. @raise Invalid_argument if [pos] and [len] do not designate a valid substring of [buf]. *) @@ -300,7 +306,7 @@ val open_in_bin : string -> BatIO.input mode, this function behaves like {!Pervasives.open_in}. *) val open_in_gen : open_flag list -> int -> string -> BatIO.input -(** [open_in mode perm filename] opens the named file for reading, +(** [open_in_gen mode perm filename] opens the named file for reading, as described above. The extra arguments [mode] and [perm] specify the opening mode and file permissions. {!Pervasives.open_in} and {!Pervasives.open_in_bin} are special @@ -319,9 +325,9 @@ val input_line : BatIO.input -> string @raise End_of_file if the end of the file is reached at the beginning of line. *) -val input : BatIO.input -> string -> int -> int -> int -(** [input ic buf pos len] reads up to [len] characters from - the given channel [ic], storing them in string [buf], starting at +val input : BatIO.input -> Bytes.t -> int -> int -> int +(** [input ic buf pos len] reads up to [len] characters from the given + channel [ic], storing them in byte sequence [buf], starting at character number [pos]. It returns the actual number of characters read, between 0 and [len] (inclusive). @@ -334,15 +340,15 @@ val input : BatIO.input -> string -> int -> int -> int if desired. (See also {!Pervasives.really_input} for reading exactly [len] characters.) @raise Invalid_argument if [pos] and [len] - do not designate a valid substring of [buf]. *) + do not designate a valid subsequence of [buf]. *) -val really_input : BatIO.input -> string -> int -> int -> unit -(** [really_input ic buf pos len] reads [len] characters from channel [ic], - storing them in string [buf], starting at character number [pos]. - @raise End_of_file if the end of file is reached before [len] - characters have been read. +val really_input : BatIO.input -> Bytes.t -> int -> int -> unit +(** [really_input ic buf pos len] reads [len] characters from channel + [ic], storing them in byte sequence [buf], starting at character + number [pos]. @raise End_of_file if the end of file is reached + before [len] characters have been read. @raise Invalid_argument if - [pos] and [len] do not designate a valid substring of [buf]. *) + [pos] and [len] do not designate a valid subsequence of [buf]. *) val input_byte : BatIO.input -> int (** Same as {!Pervasives.input_char}, but return the 8-bit integer representing @@ -748,7 +754,7 @@ val exists: ('a -> bool) -> 'a BatEnum.t -> bool that [f x]*) val for_all: ('a -> bool) -> 'a BatEnum.t -> bool -(** [exists f e] returns [true] if for every [x] in [e], [f x] is true*) +(** [for_all f e] returns [true] if for every [x] in [e], [f x] is true*) diff --git a/src/batPrintexc.mliv b/src/batPrintexc.mliv index 83bb7ea48..2ea7f3bf8 100644 --- a/src/batPrintexc.mliv +++ b/src/batPrintexc.mliv @@ -106,8 +106,15 @@ val print : _ BatInnerIO.output -> exn -> unit ##V=4.1##val get_raw_backtrace: unit -> raw_backtrace ##V=4.1##val print_raw_backtrace: out_channel -> raw_backtrace -> unit ##V=4.1##val raw_backtrace_to_string: raw_backtrace -> string -##V=4.1## -##V=4.1## + +##V>=4.5##external raise_with_backtrace: exn -> Printexc.raw_backtrace -> 'a +##V>=4.5## = "%raise_with_backtrace" +##V>=4.5##(** Reraise the exception using the given raw_backtrace for the +##V>=4.5## origin of the exception +##V>=4.5## +##V>=4.5## @since 2.7.0 and OCaml 4.05.0 +##V>=4.5##*) + ##V=4.1##(** {6 Current call stack} *) ##V=4.1## ##V=4.1##val get_callstack: int -> raw_backtrace @@ -301,7 +308,7 @@ val print : _ BatInnerIO.output -> exn -> unit ##V>=4.2##*) ##V>=4.2## ##V>=4.2##val get_raw_backtrace_slot : raw_backtrace -> int -> raw_backtrace_slot -##V>=4.2##(** [get_slot bckt pos] returns the slot in position [pos] in the +##V>=4.2##(** [get_raw_backtrace_slot bckt pos] returns the slot in position [pos] in the ##V>=4.2## backtrace [bckt]. ##V>=4.2## ##V>=4.2## @since 2.3.0 and OCaml 4.02 @@ -318,7 +325,7 @@ val print : _ BatInnerIO.output -> exn -> unit ##V>=4.4## raw_backtrace_slot -> raw_backtrace_slot option ##V>=4.4##(** [get_raw_backtrace_next_slot slot] returns the next slot inlined, if any. ##V>=4.4## -##V>=4.4## @since NEXT_RELASE and OCaml 4.04 +##V>=4.4## @since NEXT_RELEASE and OCaml 4.04 ##V>=4.4##*) @@ -333,8 +340,11 @@ val print : _ BatInnerIO.output -> exn -> unit ##V>=4.2##*) ##V>=4.2## ##V>=4.2##val exn_slot_name: exn -> string -##V>=4.2##(** [Printexc.exn_slot_id exn] returns the internal name of the constructor +##V>=4.2##(** [Printexc.exn_slot_name exn] returns the internal name of the constructor ##V>=4.2## used to create the exception value [exn]. ##V>=4.2## ##V>=4.2## @since 2.3.0 and OCaml 4.02.0 ##V>=4.2##*) + +##V>=4.08##type t = exn = .. +##V>=4.08##(** The type of exception values. *) diff --git a/src/batPrintf.mlv b/src/batPrintf.mlv index 268317927..2d70fd828 100644 --- a/src/batPrintf.mlv +++ b/src/batPrintf.mlv @@ -97,11 +97,11 @@ let parse_string_conversion sfmt = let pad_string pad_char p neg s i len = if p = len && i = 0 then s else if p <= len then String.sub s i len else - let res = String.make p pad_char in + let res = Bytes.make p pad_char in if neg - then String.blit s i res 0 len - else String.blit s i res (p - len) len; - res + then Bytes.blit_string s i res 0 len + else Bytes.blit_string s i res (p - len) len; + Bytes.unsafe_to_string res (* Format a string given a %s format, e.g. %40s or %-20s. To do: ignore other flags (#, +, etc)? *) @@ -134,8 +134,9 @@ let extract_format_int conv fmt start stop widths = let sfmt = extract_format fmt start stop widths in match conv with | 'n' | 'N' -> - Bytes.set sfmt (String.length sfmt - 1) 'u'; - sfmt + let sfmt = Bytes.of_string sfmt in + Bytes.set sfmt (Bytes.length sfmt - 1) 'u'; + Bytes.unsafe_to_string sfmt | _ -> sfmt;; (* Returns the position of the next character following the meta format diff --git a/src/batQueue.mli b/src/batQueue.mliv similarity index 81% rename from src/batQueue.mli rename to src/batQueue.mliv index a471b2eb9..90ce161c0 100644 --- a/src/batQueue.mli +++ b/src/batQueue.mliv @@ -48,6 +48,11 @@ val take : 'a t -> 'a (** [take q] removes and returns the first element in queue [q], or raises [Empty] if the queue is empty. *) +##V>=4.08##val take_opt : 'a t -> 'a option +##V>=4.08##(** [take_opt q] removes and returns the first element in queue [q], +##V>=4.08## or returns [None] if the queue is empty. +##V>=4.08## @since 2.10.0 and OCaml 4.08 *) + val pop : 'a t -> 'a (** [pop] is a synonym for [take]. *) @@ -55,6 +60,11 @@ val peek : 'a t -> 'a (** [peek q] returns the first element in queue [q], without removing it from the queue, or raises [Empty] if the queue is empty. *) +##V>=4.08##val peek_opt : 'a t -> 'a option +##V>=4.08##(** [peek_opt q] returns the first element in queue [q], without removing +##V>=4.08## it from the queue, or returns [None] if the queue is empty. +##V>=4.08## @since 2.10.0 and OCaml 4.08 *) + val top : 'a t -> 'a (** [top] is a synonym for [peek]. *) @@ -131,6 +141,22 @@ val of_enum : 'a BatEnum.t -> 'a t This is equivalent to calling [push] with the first element of the enumeration, then with the second, etc.*) +##V>=4.07##(** {1 Iterators} *) + +##V>=4.07##val to_seq : 'a t -> 'a Seq.t +##V>=4.07##(** Iterate on the queue, in front-to-back order. +##V>=4.07## The behavior is not defined if the queue is modified +##V>=4.07## during the iteration. +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) + +##V>=4.07##val add_seq : 'a t -> 'a Seq.t -> unit +##V>=4.07##(** Add the elements from the generator to the end of the queue +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) + +##V>=4.07##val of_seq : 'a Seq.t -> 'a t +##V>=4.07##(** Create a queue from the generator +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) + (** {6 Boilerplate code}*) (** {7 Printing}*) diff --git a/src/batRandom.ml b/src/batRandom.ml index 355425640..11e02fe7e 100644 --- a/src/batRandom.ml +++ b/src/batRandom.ml @@ -106,13 +106,7 @@ let multi_choice n e = let shuffle e = let a = BatArray.of_enum e in - for n = Array.length a - 1 downto 1 do - let k = int ( n + 1 ) in - if k <> n then - let buf = Array.get a n in - Array.set a n (Array.get a k); - Array.set a k buf - done; + BatInnerShuffle.array_shuffle a; a let get_state = Random.get_state diff --git a/src/batRefList.ml b/src/batRefList.ml index 8b8c36c02..36bb5446e 100644 --- a/src/batRefList.ml +++ b/src/batRefList.ml @@ -115,7 +115,7 @@ module Index = struct let p = ref (-1) in let rec del_aux = function | x::l -> incr p; if !p = pos then l else x::(del_aux l) - | [] -> invalid_arg "remove_at: index not found" + | [] -> invalid_arg "RefList.Index.remove_at: index not found" in rl := del_aux !rl @@ -134,7 +134,7 @@ module Index = struct let set rl pos newitem = let p = ref (-1) in rl := List.map (fun item -> incr p; if !p = pos then newitem else item) !rl; - if !p < pos || pos < 0 then invalid_arg "Index out of range" + if !p < pos || pos < 0 then invalid_arg "RefList.Index.set: Index out of range" end diff --git a/src/batResult.mli b/src/batResult.mli index 0cc56d845..802ebeb53 100644 --- a/src/batResult.mli +++ b/src/batResult.mli @@ -15,12 +15,12 @@ type ('a, 'b) t = ('a, 'b) BatPervasives.result = Ok of 'a | Bad of 'b *) val catch: ('a -> 'b) -> 'a -> ('b, exn) t -(** As [catch] but two paramaters. This saves a closure construction +(** As [catch] but two parameters. This saves a closure construction @since 2.0 *) val catch2: ('a -> 'b -> 'c) -> 'a -> 'b -> ('c, exn) t -(** As [catch] but three paramaters. This saves a closure construction +(** As [catch] but three parameters. This saves a closure construction @since 2.0 *) val catch3: ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> ('d, exn) t @@ -39,12 +39,12 @@ val get : ('a, exn) t -> 'a val default: 'a -> ('a, _) t -> 'a (** [map f (Ok x)] returns [Ok (f x)] and [map f (Bad e)] returns [Bad e]. - @since NEXT_RELEASE + @since 2.6.0 *) val map : ('a -> 'b) -> ('a, 'c) t -> ('b, 'c) t (** [map_both f g (Ok x)] returns [Ok (f x)] and [map_both f g (Bad e)] returns [Bad (g e)]. - @since NEXT_RELEASE + @since 2.6.0 *) val map_both : ('a1 -> 'a2) -> ('b1 -> 'b2) -> ('a1, 'b1) t -> ('a2, 'b2) t diff --git a/src/batScanf.mli b/src/batScanf.mli index 2f8b70379..c6e485d81 100644 --- a/src/batScanf.mli +++ b/src/batScanf.mli @@ -79,7 +79,7 @@ However, it is also largely different, simpler, and yet more powerful: the formatted input functions are higher-order functionals and the parameter passing mechanism is just the regular function application not - the variable assigment based mechanism which is typical for formatted + the variable assignment based mechanism which is typical for formatted input in imperative languages; the OCaml format strings also feature useful additions to easily define complex tokens; as expected within a functional programming language, the formatted input functions also @@ -137,7 +137,7 @@ module Scanning : sig end-of-input condition by raising the exception [End_of_file]. *) val from_input : BatIO.input -> scanbuf;; - (** [Scanning.from_channel ic] returns a scanning buffer which reads from the + (** [Scanning.from_input ic] returns a scanning buffer which reads from the input channel [ic], starting at the current reading position. *) val end_of_input : scanbuf -> bool;; @@ -149,7 +149,7 @@ module Scanning : sig the given scanning buffer. *) val name_of_input : scanbuf -> string;; - (** [Scanning.file_name_of_input ib] returns the name of the character source + (** [Scanning.name_of_input ib] returns the name of the character source for the scanning buffer [ib]. *) (** @@ -224,7 +224,7 @@ val bscanf : Scanning.scanbuf -> ('a, 'b, 'c, 'd) scanner;; Matching {e any} amount of whitespace, a space in the format string also matches no amount of whitespace at all; hence, the call [bscanf ib - "Price = %d $" (fun p -> p)] succeds and returns [1] when reading an + "Price = %d $" (fun p -> p)] succeeds and returns [1] when reading an input with various whitespace in it, such as [Price = 1 $], [Price = 1 $], or even [Price=1$]. *) @@ -321,7 +321,7 @@ val bscanf : Scanning.scanbuf -> ('a, 'b, 'c, 'd) scanner;; Notes: - - as mentioned above, a [%s] convertion always succeeds, even if there is + - as mentioned above, a [%s] conversion always succeeds, even if there is nothing to read in the input: it simply returns [""]. - in addition to the relevant digits, ['_'] characters may appear @@ -415,7 +415,7 @@ val kscanf : val bscanf_format : Scanning.scanbuf -> ('a, 'b, 'c, 'd, 'e, 'f) format6 -> (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g;; -(** [bscanf_format ib fmt f] reads a format string token from the scannning +(** [bscanf_format ib fmt f] reads a format string token from the scanning buffer [ib], according to the given format string [fmt], and applies [f] to the resulting format string value. @raise Scan_failure if the format string value read does not have the diff --git a/src/batSeq.ml b/src/batSeq.ml index 8d872ee14..2687521d4 100644 --- a/src/batSeq.ml +++ b/src/batSeq.ml @@ -49,15 +49,15 @@ let rec enum_of_ref r = let enum s = enum_of_ref (ref s) let hd s = match s () with - | Nil -> raise (Invalid_argument "Seq.hd") + | Nil -> invalid_arg "Seq.hd" | Cons(e, _s) -> e let tl s = match s () with - | Nil -> raise (Invalid_argument "Seq.tl") + | Nil -> invalid_arg "Seq.tl" | Cons(_e, s) -> s let first s = match s () with - | Nil -> raise (Invalid_argument "Seq.first") + | Nil -> invalid_arg "Seq.first" | Cons(e, _s) -> e let last s = @@ -66,7 +66,7 @@ let last s = | Cons(e, s) -> aux e s in match s () with - | Nil -> raise (Invalid_argument "Seq.last") + | Nil -> invalid_arg "Seq.last" | Cons(e, s) -> aux e s let is_empty s = s () = Nil @@ -74,7 +74,7 @@ let is_empty s = s () = Nil let at s n = let rec aux s n = match s () with - | Nil -> raise (Invalid_argument "Seq.at") + | Nil -> invalid_arg "Seq.at" | Cons(e, s) -> if n = 0 then e @@ -197,15 +197,15 @@ let rec fold_right f s acc = match s () with | Cons(e, s) -> f e (fold_right f s acc) let reduce f s = match s () with - | Nil -> raise (Invalid_argument "Seq.reduce") + | Nil -> invalid_arg "Seq.reduce" | Cons(e, s) -> fold_left f e s let max s = match s () with - | Nil -> raise (Invalid_argument "Seq.max") + | Nil -> invalid_arg "Seq.max" | Cons(e, s) -> fold_left Pervasives.max e s let min s = match s () with - | Nil -> raise (Invalid_argument "Seq.min") + | Nil -> invalid_arg "Seq.min" | Cons(e, s) -> fold_left Pervasives.min e s let equal ?(eq=(=)) s1 s2 = @@ -318,7 +318,7 @@ let rec combine s1 s2 () = match s1 (), s2 () with | Cons(e1, s1), Cons(e2, s2) -> Cons((e1, e2), combine s1 s2) | _ -> - raise (Invalid_argument "Seq.combine") + invalid_arg "Seq.combine" let print ?(first="[") ?(last="]") ?(sep="; ") print_a out s = match s () with | Nil -> @@ -334,6 +334,61 @@ let print ?(first="[") ?(last="]") ?(sep="; ") print_a out s = match s () with iter (BatPrintf.fprintf out "%s%a" sep print_a) s; BatInnerIO.nwrite out last +let to_buffer ?(first="[") ?(last="]") ?(sep=";") to_str buff s = + match s () with + | Nil -> (Buffer.add_string buff first; + Buffer.add_string buff last) + | Cons(e, s) -> + match s () with + | Nil -> (Buffer.add_string buff first; + Buffer.add_string buff (to_str e); + Buffer.add_string buff last) + | _ -> + Buffer.add_string buff first; + Buffer.add_string buff (to_str e); + iter (fun e -> + Buffer.add_string buff sep; + Buffer.add_string buff (to_str e) + ) s; + Buffer.add_string buff last + +let to_string ?(first="[") ?(last="]") ?(sep=";") to_str s = + let buff = Buffer.create 80 in + to_buffer ~first ~last ~sep to_str buff s; + Buffer.contents buff + +(*$T to_string + to_string string_of_int (of_list [1;2;3]) = "[1;2;3]" + to_string ~first:"{" ~sep:"," ~last:"}" string_of_int (of_list [1;2;3]) = "{1,2,3}" + to_string string_of_int (of_list []) = "[]" +*) + +let of_string ?(first="[") ?(last="]") ?(sep=";") of_str s = + if not (BatString.starts_with s first) then + raise + (Invalid_argument + ("Seq.of_string: wrong prefix: " ^ first ^ " not prefix of " ^ s)); + if not (BatString.ends_with s last) then + raise + (Invalid_argument + ("Seq.of_string: wrong suffix: " ^ last ^ " not suffix of " ^ s)); + let prfx_len = String.length first in + let sufx_len = String.length last in + let n = String.length s in + if n = prfx_len + sufx_len then nil + else + let body = BatString.chop ~l:prfx_len ~r:sufx_len s in + let strings = BatString.nsplit ~by:sep body in + of_list (BatList.map of_str strings) + +(*$T of_string + equal (of_string int_of_string "[1;2;3]") (of_list [1;2;3]) + equal (of_string int_of_string "[]") (of_list []) + equal (of_string ~first:"{" ~sep:"," ~last:"}" int_of_string "{1,2,3}") (of_list [1;2;3]) + try equal (of_string ~first:"{" int_of_string "[1;2;3]") (of_list []) with (Invalid_argument _) -> true + try equal (of_string ~last:"}" int_of_string "[1;2;3]") (of_list []) with (Invalid_argument _) -> true +*) + module Infix = struct (** Infix operators matching those provided by {!BatEnum.Infix} *) @@ -374,6 +429,7 @@ end include Infix module Exceptionless = struct + (*$< Exceptionless *) (* This function could be used to eliminate a lot of duplicate code below... let exceptionless_arg f s e = try Some (f s) @@ -422,11 +478,18 @@ module Exceptionless = struct try Some (min s) with Invalid_argument _ -> None - let combine s1 s2 = - try Some (combine s1 s2) - with Invalid_argument _ -> None + let rec combine s1 s2 () = match s1 (), s2 () with + | Nil, Nil -> + Nil + | Cons(e1, s1), Cons(e2, s2) -> + Cons((e1, e2), combine s1 s2) + | _ -> + Nil (*$T combine - equal (combine (of_list [1;2]) (of_list ["a";"b"])) (of_list [1,"a"; 2,"b"]) + equal (combine (of_list [1;2]) (of_list ["a";"b"])) (of_list [1,"a"; 2,"b"]) + equal (combine (of_list [1;2]) (of_list ["a";"b";"c"])) (of_list [1,"a"; 2,"b"]) + equal (combine (of_list [1;2;3]) (of_list ["a";"b"])) (of_list [1,"a"; 2,"b"]) *) + (*$>*) end diff --git a/src/batSeq.mli b/src/batSeq.mli index 0ba41c04c..fca06637c 100644 --- a/src/batSeq.mli +++ b/src/batSeq.mli @@ -275,6 +275,23 @@ val combine : 'a t -> 'b t -> ('a * 'b) t val print : ?first:string -> ?last:string -> ?sep:string -> ('a BatInnerIO.output -> 'b -> unit) -> 'a BatInnerIO.output -> 'b t -> unit (**Print the contents of a sequence*) +val to_buffer : ?first:string -> ?last:string -> ?sep:string -> ('a -> string) -> Buffer.t -> (unit -> 'a node) -> unit +(** Convert a sequence to a string in the given buffer; eager. + @since 2.10.0 +*) + +val to_string : ?first:string -> ?last:string -> ?sep:string -> ('a -> string) -> 'a t -> string +(** Convert the sequence to a string; eager. + @since 2.10.0 +*) + +val of_string : ?first:string -> ?last:string -> ?sep:string -> (string -> 'a) -> string -> 'a t +(** Create a sequence by parsing a string. + @raise Invalid_argument if the string is not prefixed by [first]. + @raise Invalid_argument if the string is not suffixed by [last]. + @since 2.10.0 +*) + module Infix : sig (** Infix operators matching those provided by {!BatEnum.Infix} *) @@ -305,5 +322,5 @@ module Exceptionless : sig val reduce : ('a -> 'a -> 'a) -> 'a t -> 'a option val max : 'a t -> 'a option val min : 'a t -> 'a option - val combine : 'a t -> 'b t -> ('a * 'b) t option + val combine : 'a t -> 'b t -> ('a * 'b) t end diff --git a/src/batSet.ml b/src/batSet.ml index 685910101..97d022086 100644 --- a/src/batSet.ml +++ b/src/batSet.ml @@ -119,7 +119,7 @@ module Concrete = struct Empty -> invalid_arg "Set.remove_min_elt" | Node(Empty, v, r, _) -> r | Node(l, v, r, _) -> bal (remove_min_elt l) v r - + (* Merge two trees l and r into one. All elements of l must precede the elements of r. Assume | height l - height r | <= 2. *) @@ -150,9 +150,22 @@ module Concrete = struct if c = 0 then merge l r else if c < 0 then bal (remove cmp x l) v r else bal l v (remove cmp x r) + (* A variant of [remove] that throws [Not_found] on failure *) + let rec remove_exn cmp x = function + | Empty -> + raise Not_found + | Node (l, v, r, _) -> + let c = cmp x v in + if c = 0 then + merge l r + else if c < 0 then + bal (remove_exn cmp x l) v r + else + bal l v (remove_exn cmp x r) + let update cmp x y s = if cmp x y <> 0 then - add cmp y (remove cmp x s) + add cmp y (remove_exn cmp x s) else let rec loop = function | Empty -> raise Not_found @@ -183,10 +196,6 @@ module Concrete = struct Empty -> () | Node(l, v, r, _) -> iter f l; f v; iter f r - let get_root = function - | Empty -> raise Not_found - | Node(l, v, r, _) -> v - let rec fold f s accu = match s with Empty -> accu @@ -332,9 +341,13 @@ module Concrete = struct let to_list = elements let to_array s = - let acc = BatDynArray.create () in - iter (BatDynArray.add acc) s; - BatDynArray.to_array acc + match s with + | Empty -> [||] + | Node (_, e, _, _) -> + let arr = Array.make (cardinal s) e in + let i = ref 0 in + iter (fun x -> Array.unsafe_set arr (!i) x; incr i) s; + arr let rec cons_iter s t = match s with Empty -> t @@ -387,6 +400,16 @@ module Concrete = struct let filter_map cmp f e = fold (fun x acc -> match f x with Some v -> add cmp v acc | _ -> acc) e empty let choose = min_elt (* I'd rather this chose the root, but okay *) + (*$= choose + 42 (empty |> add 42 |> choose) + (empty |> add 0 |> add 1 |> choose) (empty |> add 1 |> add 0 |> choose) + *) + + let any = get_root + (*$T any + empty |> add 42 |> any = 42 + try empty |> any |> ignore ; false with Not_found -> true + *) let rec for_all p = function Empty -> true @@ -409,16 +432,15 @@ module Concrete = struct | (t, Empty) -> t | (_, _) -> join t1 (min_elt t2) (remove_min_elt t2) - let cartesian_product a b = - let rec product a b = match a with - | Empty -> Empty + let rec cartesian_product a b = + match a with + | Empty -> + Empty | Node (la, xa, ra, _) -> - let lab = product la b in - let xab = op_map (fun xb -> (xa,xb)) b in - let rab = product ra b in - concat lab (concat xab rab) - in - product a b + let lab = cartesian_product la b in + let xab = op_map (fun xb -> (xa, xb)) b in + let rab = cartesian_product ra b in + concat lab (concat xab rab) let rec union cmp12 s1 s2 = match (s1, s2) with @@ -554,6 +576,7 @@ sig val pop_max: t -> elt * t val max_elt: t -> elt val choose: t -> elt + val any: t -> elt val pop: t -> elt * t val enum: t -> elt BatEnum.t val backwards: t -> elt BatEnum.t @@ -563,21 +586,12 @@ sig val print : ?first:string -> ?last:string -> ?sep:string -> ('a BatInnerIO.output -> elt -> unit) -> 'a BatInnerIO.output -> t -> unit - module Infix : sig - val (<--) : t -> elt -> t (** insertion *) - val (<.) : t -> t -> bool (** strict subset *) - val (>.) : t -> t -> bool (** strict superset *) - val (<=.) : t -> t -> bool (** subset *) - val (>=.) : t -> t -> bool (** superset *) - val (-.) : t -> t -> t (** difference *) - val (&&.) : t -> t -> t (** intersection *) - val (||.) : t -> t -> t (** union *) - end (** Operations on {!Set} without exceptions.*) module Exceptionless : sig val min_elt: t -> elt option val max_elt: t -> elt option val choose: t -> elt option + val any: t -> elt option val find: elt -> t -> elt option end (** Operations on {!Set} with labels. *) @@ -624,7 +638,7 @@ struct let find x t = Concrete.find Ord.compare x (impl_of_t t) let exists f t = Concrete.exists f (impl_of_t t) let for_all f t = Concrete.for_all f (impl_of_t t) - let paritition f t = + let partition f t = let l, r = Concrete.partition Ord.compare f (impl_of_t t) in (t_of_impl l, t_of_impl r) @@ -638,6 +652,7 @@ struct let max_elt t = Concrete.max_elt (impl_of_t t) let choose t = Concrete.choose (impl_of_t t) + let any t = Concrete.any (impl_of_t t) let pop t = let e, t = Concrete.pop (impl_of_t t) in e, t_of_impl t @@ -702,22 +717,12 @@ struct let print ?first ?last ?sep print_elt out t = Concrete.print ?first ?last ?sep print_elt out (impl_of_t t) - module Infix = struct - let (<--) s x = add x s - let (<.) a b = not (equal a b) && subset a b - let (>.) a b = not (equal a b) && subset b a - let (<=.) = subset - let (>=.) a b = subset b a - let (-.) = diff - let (&&.) = inter - let (||.) = union - end - module Exceptionless = struct let min_elt t = try Some (min_elt t) with Not_found -> None let max_elt t = try Some (max_elt t) with Not_found -> None let choose t = try Some (choose t) with Not_found -> None + let any t = try Some (any t) with Not_found -> None let find e t = try Some (find e t) with Not_found -> None end @@ -734,6 +739,14 @@ struct end end +module Int = Make (BatInt) +module Int32 = Make (BatInt32) +module Int64 = Make (BatInt64) +module Nativeint = Make (BatNativeint) +module Float = Make (BatFloat) +module Char = Make (BatChar) +module String = Make (BatString) + module Make2(O1 : OrderedType)(O2 : OrderedType) = struct module Set1 = Make(O1) module Set2 = Make(O2) @@ -751,9 +764,9 @@ module Make2(O1 : OrderedType)(O2 : OrderedType) = struct end (*$T - let module S1 = Make(Int) in \ - let module S2 = Make(String) in \ - let module P = Make2(Int)(String) in \ + let module S1 = Make(BatInt) in \ + let module S2 = Make(BatString) in \ + let module P = Make2(BatInt)(BatString) in \ P.cartesian_product \ (List.fold_right S1.add [1;2;3] S1.empty) \ (List.fold_right S2.add ["a";"b"] S2.empty) \ @@ -775,7 +788,7 @@ module PSet = struct (*$< PSet *) let get_cmp {cmp} = cmp (*$T get_cmp - get_cmp (create Int.compare) == Int.compare + get_cmp (create BatInt.compare) == BatInt.compare *) @@ -800,6 +813,7 @@ module PSet = struct (*$< PSet *) let to_list = elements let to_array s = Concrete.to_array s.set let choose s = Concrete.choose s.set + let any s = Concrete.any s.set let min_elt s = Concrete.min_elt s.set let pop_min s = let mini, others = Concrete.pop_min s.set in @@ -847,17 +861,6 @@ module PSet = struct (*$< PSet *) let equal s1 s2 = Concrete.equal s1.cmp s1.set s2.set let subset s1 s2 = Concrete.subset s1.cmp s1.set s2.set let disjoint s1 s2 = Concrete.disjoint s1.cmp s1.set s2.set - - module Infix = struct - let (<--) s x = add x s - let (<.) a b = not (equal a b) && subset a b - let (>.) a b = not (equal a b) && subset b a - let (<=.) = subset - let (>=.) a b = subset b a - let (-.) = diff - let (&&.) = intersect - let (||.) = union - end end (*$>*) type 'a t = 'a Concrete.set @@ -927,6 +930,7 @@ let to_list = elements let to_array s = Concrete.to_array s let choose s = Concrete.choose s +let any s = Concrete.any s let min_elt s = Concrete.min_elt s @@ -1043,18 +1047,9 @@ let disjoint s1 s2 = Concrete.disjoint Pervasives.compare s1 s2 TestSet.update (2,0) (2,1) ts = TestSet.of_list [(1,0);(2,1);(3,0)] TestSet.update (3,0) (3,1) ts = TestSet.of_list [(1,0);(2,0);(3,1)] TestSet.update (3,0) (-1,0) ts = TestSet.of_list [(1,0);(2,0);(-1,0)] -*) + try ignore (TestSet.update (4,0) (44,00) ts); false with Not_found -> true -module Infix = struct - let (<--) s x = add x s - let (<.) a b = not (equal a b) && subset a b - let (>.) a b = not (equal a b) && subset b a - let (<=.) = subset - let (>=.) a b = subset b a - let (-.) = diff - let (&&.) = intersect - let (||.) = union -end +*) module Incubator = struct (*$< Incubator *) let op_map f s = Concrete.op_map f s diff --git a/src/batSet.mli b/src/batSet.mli index 283257644..64c50c9e3 100644 --- a/src/batSet.mli +++ b/src/batSet.mli @@ -250,9 +250,17 @@ sig given set. *) val choose: t -> elt - (** Return one element of the given set, or raise [Not_found] if - the set is empty. Which element is chosen is unspecified, - but equal elements will be chosen for equal sets. *) + (** Return one element of the given set. + Which element is chosen is unspecified, but equal elements will be + chosen for equal sets. + @raise Not_found if the set is empty. *) + + val any: t -> elt + (** Return one element of the given set. + The difference with choose is that there is no guarantee that equals + elements will be picked for equal sets. + This merely returns the quickest element to get (O(1)). + @raise Not_found if the set is empty. *) val pop : t -> elt * t (** returns one element of the set and the set without that element. @@ -293,19 +301,6 @@ sig ('a BatInnerIO.output -> elt -> unit) -> 'a BatInnerIO.output -> t -> unit - (** {7 Infix operators} *) - - module Infix : sig - val (<--) : t -> elt -> t (** insertion *) - val (<.) : t -> t -> bool (** strict subset *) - val (>.) : t -> t -> bool (** strict superset *) - val (<=.) : t -> t -> bool (** subset *) - val (>=.) : t -> t -> bool (** superset *) - val (-.) : t -> t -> t (** difference *) - val (&&.) : t -> t -> t (** intersection *) - val (||.) : t -> t -> t (** union *) - end - (** {6 Override modules}*) (** @@ -319,6 +314,7 @@ sig val min_elt: t -> elt option val max_elt: t -> elt option val choose: t -> elt option + val any: t -> elt option val find: elt -> t -> elt option end @@ -375,7 +371,17 @@ module Make2(O1 : OrderedType) (O2 : OrderedType) : sig (** cartesian product of the two sets *) end -(** {6 Polymorphic sets} +(** {6 Common instantiations} *) + +module Int : S with type elt = int +module Int32 : S with type elt = int32 +module Int64 : S with type elt = int64 +module Nativeint : S with type elt = nativeint +module Float : S with type elt = float +module Char : S with type elt = char +module String : S with type elt = string + +(** {4 Polymorphic sets} The definitions below describe the polymorphic set interface. @@ -573,7 +579,7 @@ val to_array: 'a t -> 'a array val min_elt : 'a t -> 'a (** returns the smallest element of the set. - @raise Invalid_argument if given an empty set. *) + @raise Not_found if given an empty set. *) val pop_min: 'a t -> 'a * 'a t (** Returns the smallest element of the given set @@ -597,11 +603,18 @@ val pop_max: 'a t -> 'a * 'a t val max_elt : 'a t -> 'a (** returns the largest element of the set. - @raise Invalid_argument if given an empty set.*) + @raise Not_found if given an empty set.*) val choose : 'a t -> 'a (** returns an arbitrary (but deterministic) element of the given set. - @raise Invalid_argument if given an empty set. *) + @raise Not_found if given an empty set. *) + +val any: 'a t -> 'a +(** Return one element of the given set. + The difference with choose is that there is no guarantee that equals + elements will be picked for equal sets. + This merely returns the quickest element to get (O(1)). + @raise Not_found if the set is empty. *) val pop : 'a t -> 'a * 'a t (** returns one element of the set and the set without that element. @@ -641,19 +654,6 @@ val print : ?first:string -> ?last:string -> ?sep:string -> ('a BatInnerIO.output -> 'c -> unit) -> 'a BatInnerIO.output -> 'c t -> unit -(** {7 Infix operators} *) - -module Infix : sig - val (<--) : 'a t -> 'a -> 'a t (** insertion *) - val (<.) : 'a t -> 'a t -> bool (** strict subset *) - val (>.) : 'a t -> 'a t -> bool (** strict superset *) - val (<=.) : 'a t -> 'a t -> bool (** subset *) - val (>=.) : 'a t -> 'a t -> bool (** superset *) - val (-.) : 'a t -> 'a t -> 'a t (** difference *) - val (&&.) : 'a t -> 'a t -> 'a t (** intersection *) - val (||.) : 'a t -> 'a t -> 'a t (** union *) -end - (** {6 Incubator} *) module Incubator : sig @@ -864,7 +864,7 @@ module PSet : sig val min_elt : 'a t -> 'a (** returns the smallest element of the set. - @raise Invalid_argument if given an empty set. *) + @raise Not_found if given an empty set. *) val pop_min: 'a t -> 'a * 'a t (** Returns the smallest element of the given set @@ -888,11 +888,19 @@ module PSet : sig val max_elt : 'a t -> 'a (** returns the largest element of the set. - @raise Invalid_argument if given an empty set.*) + @raise Not_found if given an empty set.*) val choose : 'a t -> 'a (** returns an arbitrary (but deterministic) element of the given set. - @raise Invalid_argument if given an empty set. *) + @raise Not_found if given an empty set. *) + + val any: 'a t -> 'a + (** Return one element of the given set. + The difference with choose is that there is no guarantee that equals + elements will be picked for equal sets. + This merely returns the quickest element to get (O(1)). + @raise Not_found if the set is empty. *) + val pop : 'a t -> 'a * 'a t (** returns one element of the set and the set without that element. @@ -923,19 +931,6 @@ module PSet : sig ('a BatInnerIO.output -> 'c -> unit) -> 'a BatInnerIO.output -> 'c t -> unit - (** {7 Infix operators} *) - - module Infix : sig - val (<--) : 'a t -> 'a -> 'a t (** insertion *) - val (<.) : 'a t -> 'a t -> bool (** strict subset *) - val (>.) : 'a t -> 'a t -> bool (** strict superset *) - val (<=.) : 'a t -> 'a t -> bool (** subset *) - val (>=.) : 'a t -> 'a t -> bool (** superset *) - val (-.) : 'a t -> 'a t -> 'a t (** difference *) - val (&&.) : 'a t -> 'a t -> 'a t (** intersection *) - val (||.) : 'a t -> 'a t -> 'a t (** union *) - end - (** get the comparison function used for a polymorphic map *) val get_cmp : 'a t -> ('a -> 'a -> int) diff --git a/src/batSplay.ml b/src/batSplay.ml index 3595d5dae..950b6ea76 100644 --- a/src/batSplay.ml +++ b/src/batSplay.ml @@ -222,6 +222,11 @@ end module Map (Ord : BatInterfaces.OrderedType) = struct + (*$inject + module TestMap = Splay.Map (Int) + *) + (*$< TestMap *) + type key = Ord.t type 'a map = (key * 'a) bst @@ -301,6 +306,10 @@ struct v | _ -> raise Not_found + let find_default def k m = + try find k m + with Not_found -> def + let cchange fn (C (cx, t)) = C (cx, fn t) let remove k tr = @@ -350,10 +359,6 @@ struct in visit acc tr - let choose tr = match sget tr with - | Empty -> raise Not_found - | Node (_, kv, _) -> kv - let min_binding tr = let tr = sget tr in let rec bfind = function @@ -363,6 +368,22 @@ struct in bfind tr + let choose = min_binding + (*$= choose + (empty |> add 0 1 |> add 1 1 |> choose) \ + (empty |> add 1 1 |> add 0 1 |> choose) + *) + (*$T choose + try ignore (choose empty) ; false with Not_found -> true + *) + + let any tr = match sget tr with + | Empty -> raise Not_found + | Node (_, kv, _) -> kv + (*$T any + try ignore (any empty) ; false with Not_found -> true + *) + let pop_min_binding tr = let mini = ref (choose tr) in let rec bfind = function @@ -532,8 +553,9 @@ struct end module Exceptionless = struct - let find k m = - try Some (find k m) with Not_found -> None + let find k m = try Some (find k m) with Not_found -> None + let choose m = try Some (choose m) with Not_found -> None + let any m = try Some (any m) with Not_found -> None end module Infix = struct @@ -654,4 +676,5 @@ struct match !maybe_v with | None -> raise Not_found | Some v -> v, sref tr + (*$>*) end diff --git a/src/batStack.mli b/src/batStack.mli index 9ad78bb75..b0e641feb 100644 --- a/src/batStack.mli +++ b/src/batStack.mli @@ -75,7 +75,7 @@ val enum : 'a t -> 'a BatEnum.t it will not affect [s]. *) val enum_destruct : 'a t -> 'a BatEnum.t -(** [enum s] returns a destructive enumeration of the elements of +(** [enum_destruct s] returns a destructive enumeration of the elements of stack [s], from the most recently entered to the least recently entered. Reading the enumeration will progressively empty [s].*) diff --git a/src/batStream.mli b/src/batStream.mli index 1256cfff5..5ecba2a5e 100644 --- a/src/batStream.mli +++ b/src/batStream.mli @@ -117,7 +117,7 @@ val foldr : ('a -> 'b lazy_t -> 'b) -> 'b -> 'a t -> 'b (** [foldr f init stream] is a lazy fold_right. Unlike the normal fold_right, the accumulation parameter of [f elt accu] is lazy, hence it can decide not to force the evaluation of [accu] if the current element [elt] can - determin the result by itself. *) + determine the result by itself. *) val fold : ('a -> 'a -> 'a * bool option) -> 'a t -> 'a (** [fold] is [foldl] without initialization value, where the first diff --git a/src/batString.mliv b/src/batString.mliv index 116b97772..623abb84b 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -102,14 +102,14 @@ external get : string -> int -> char = "%string_safe_get" @raise Invalid_argument if [n] not a valid character number in [s]. *) -external set : string -> int -> char -> unit = "%string_safe_set" +external set : Bytes.t -> int -> char -> unit = "%string_safe_set" (** [String.set s n c] modifies string [s] in place, replacing the character number [n] by [c]. You can also write [s.[n] <- c] instead of [String.set s n c]. @raise Invalid_argument if [n] is not a valid character number in [s]. *) -external create : int -> string = "caml_create_string" +external create : int -> Bytes.t = "caml_create_string" (** [String.create n] returns a fresh string of length [n]. The string initially contains arbitrary characters. @@ -132,19 +132,17 @@ val sub : string -> int -> int -> string @raise Invalid_argument if [start] and [len] do not designate a valid substring of [s]. *) -val fill : string -> int -> int -> char -> unit -(** [String.fill s start len c] modifies string [s] in place, - replacing [len] characters by [c], starting at [start]. +val fill : Bytes.t -> int -> int -> char -> unit +(** [String.fill s start len c] modifies the byte sequence [s] in + place, replacing [len] characters by [c], starting at [start]. @raise Invalid_argument if [start] and [len] do not designate a valid substring of [s]. *) -val blit : string -> int -> string -> int -> int -> unit +val blit : string -> int -> Bytes.t -> int -> int -> unit (** [String.blit src srcoff dst dstoff len] copies [len] characters - from string [src], starting at character number [srcoff], to - string [dst], starting at character number [dstoff]. It works - correctly even if [src] and [dst] are the same string, - and the source and destination intervals overlap. + from string [src], starting at character number [srcoff], to the + byte sequence [dst], starting at character number [dstoff]. @raise Invalid_argument if [srcoff] and [len] do not designate a valid substring of [src], or if [dstoff] and [len] @@ -199,20 +197,43 @@ val index : string -> char -> int @raise Not_found if [c] does not occur in [s]. *) +val index_opt: string -> char -> int option +(** [String.index_opt s c] returns the index of the first + occurrence of character [c] in string [s], or + [None] if [c] does not occur in [s]. + @since 2.7.0 *) + val rindex : string -> char -> int (** [String.rindex s c] returns the character number of the last occurrence of character [c] in string [s]. @raise Not_found if [c] does not occur in [s]. *) +val rindex_opt: string -> char -> int option +(** [String.rindex_opt s c] returns the index of the last occurrence + of character [c] in string [s], or [None] if [c] does not occur in + [s]. + @since 2.7.0 *) + val index_from : string -> int -> char -> int (** [String.index_from s i c] returns the character number of the - first occurrence of character [c] in string [s] after position [i]. + first occurrence of character [c] in string [s] after or at position [i]. [String.index s c] is equivalent to [String.index_from s 0 c]. @raise Invalid_argument if [i] is not a valid position in [s]. @raise Not_found if [c] does not occur in [s] after position [i]. *) +val index_from_opt: string -> int -> char -> int option +(** [String.index_from_opt s i c] returns the index of the + first occurrence of character [c] in string [s] after position [i] + or [None] if [c] does not occur in [s] after position [i]. + + [String.index_opt s c] is equivalent to [String.index_from_opt s 0 c]. + Raise [Invalid_argument] if [i] is not a valid position in [s]. + + @since 2.7.0 +*) + val rindex_from : string -> int -> char -> int (** [String.rindex_from s i c] returns the character number of the last occurrence of character [c] in string [s] before position [i+1]. @@ -222,6 +243,37 @@ val rindex_from : string -> int -> char -> int @raise Invalid_argument if [i+1] is not a valid position in [s]. @raise Not_found if [c] does not occur in [s] before position [i+1]. *) +val rindex_from_opt: string -> int -> char -> int option +(** [String.rindex_from_opt s i c] returns the index of the + last occurrence of character [c] in string [s] before position [i+1] + or [None] if [c] does not occur in [s] before position [i+1]. + + [String.rindex_opt s c] is equivalent to + [String.rindex_from_opt s (String.length s - 1) c]. + + Raise [Invalid_argument] if [i+1] is not a valid position in [s]. + + @since 2.7.0 +*) + +val index_after_n : char -> int -> string -> int +(** [index_after_n chr n str] returns the index of the character that + comes immediately after the [n]-th occurrence of [chr] in [str]. + + - {b Occurrences are numbered from 1}: [n] = 1 returns the index of + the character located immediately after the first occurrence of + [chr]. + - [n] = 0 always returns [0]. + - If the [n]-th occurrence of [chr] is the last character of + [str], returns the length of [str]. + + @raise Invalid_argument if [n < 0]. + @raise Not_found if there are strictly less than [n] occurrences of [chr] + in [str]. + + @since 2.9.0 +*) + val contains : string -> char -> bool (** [String.contains s c] tests if character [c] appears in the string [s]. *) @@ -506,6 +558,10 @@ val find_all : string -> string -> int BatEnum.t the list [[1; 4]]. @since 2.2.0 *) +val count_string : string -> string -> int +(** [count_string s x] count how many times [x] is found in [s]. + @since 2.9.0 *) + val ends_with : string -> string -> bool (** [ends_with s x] returns [true] if the string [s] is ending with [x], [false] otherwise. @@ -525,6 +581,11 @@ val exists : string -> string -> bool Example: [String.exists "foobarbaz" "obar" = true] *) +val count_char : string -> char -> int +(** [count_char str c] returns the number of times [c] is used in [str]. + *) + + (** {6 Transformations}*) val lchop : ?n:int -> string -> string @@ -551,6 +612,20 @@ val rchop : ?n:int -> string -> string [String.rchop ~n:1000 "Weeble" = ""] *) +val chop : ?l:int -> ?r:int -> string -> string +(** Returns the same string but with the first [l] characters + on the left and the first [r] characters on the right removed. + By default, [l] and [r] are both 1. + + [chop ~l ~r s] is equivalent to [lchop ~n:l (rchop ~n:r s)]. + + @raise Invalid_argument if either [l] or [r] is less than zero. + + Examples: + [String.chop "\"Weeble\"" = "Weeble"] + [String.chop ~l:2 ~r:3 "01234567" = "234"] +*) + val trim : string -> string (** Returns the same string but without the leading and trailing whitespaces (according to {!BatChar.is_whitespace}). @@ -586,7 +661,7 @@ val left : string -> int -> string *) val right : string -> int -> string -(**[left r len] returns the string containing the [len] last characters of [r]. +(**[right r len] returns the string containing the [len] last characters of [r]. If [r] contains less than [len] characters, it returns [r]. Example: [String.right "Weeble" 4 = "eble"] @@ -621,7 +696,7 @@ val replace : str:string -> sub:string -> by:string -> bool * string (** [replace ~str ~sub ~by] returns a tuple consisting of a boolean and a string where the first occurrence of the string [sub] within [str] has been replaced by the string [by]. The boolean - is true if a subtitution has taken place. + is true if a substitution has taken place. Example: [String.replace "foobarbaz" "bar" "rab" = (true, "foorabbaz")] *) @@ -641,19 +716,19 @@ val repeat: string -> int -> string *) val rev : string -> string -(** [string s] returns the reverse of string [s] +(** [rev s] returns the reverse of string [s] @since 2.1 *) (** {6 In-Place Transformations}*) -val rev_in_place : string -> unit -(** [rev_in_place s] mutates the string [s], so that its new value is +val rev_in_place : Bytes.t -> unit +(** [rev_in_place s] mutates the byte sequence [s], so that its new value is the mirror of its old one: for instance if s contained ["Example!"], after the mutation it will contain ["!elpmaxE"]. *) -val in_place_mirror : string -> unit +val in_place_mirror : Bytes.t -> unit (** @deprecated Use {!String.rev_in_place} instead *) (** {6 Splitting around}*) @@ -670,13 +745,29 @@ val split_on_char: char -> string -> string list (String.split_on_char sep s) = s]). - No string in the result contains the [sep] character. + Note: prior to NEXT_RELEASE [split_on_char _ ""] used to return an empty list. @since 2.5.3 *) +##V>=4.07##(** {1 Iterators} *) + +##V>=4.07##val to_seq : t -> char Seq.t +##V>=4.07##(** Iterate on the string, in increasing index order. Modifications of the +##V>=4.07## string during iteration will be reflected in the iterator. +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) + +##V>=4.07##val to_seqi : t -> (int * char) Seq.t +##V>=4.07##(** Iterate on the string, in increasing order, yielding indices along chars +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) + +##V>=4.07##val of_seq : char Seq.t -> t +##V>=4.07##(** Create a string from the generator +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) + val split : string -> by:string -> string * string (** [split s sep] splits the string [s] between the first occurrence of [sep], and returns the two parts before - and after the occurence (excluded). + and after the occurrence (excluded). @raise Not_found if the separator is not found. @@ -688,7 +779,7 @@ val split : string -> by:string -> string * string val rsplit : string -> by:string -> string * string (** [rsplit s sep] splits the string [s] between the last occurrence of [sep], and returns the two parts before and after the - occurence (excluded). + occurrence (excluded). @raise Not_found if the separator is not found. @@ -698,11 +789,35 @@ val rsplit : string -> by:string -> string * string val nsplit : string -> by:string -> string list (** [nsplit s sep] splits the string [s] into a list of strings which are separated by [sep] (excluded). - [nsplit "" _] returns the empty list. + [nsplit "" _] returns a single empty string. + Note: prior to NEXT_RELEASE [nsplit "" _] used to return an empty list. Example: [String.nsplit "abcabcabc" "bc" = ["a"; "a"; "a"; ""]] *) +val cut_on_char : char -> int -> string -> string +(** + Similar to Unix [cut]. [cut_on_char chr n str] returns the substring of + [str] located strictly between the [n]-th occurrence of [chr] and + the [n+1]-th one. + + - {b Occurrences of [chr] are numbered from 1}. + - If [n = 0], returns the substring from the beginning of + [str] to the first occurrence of [chr]. + - If there are exactly [n] occurrences of [chr] in [str], returns the + substring between the last occurrence of [chr] and the end of [str]. + - These behaviours cumulate: if [n] equals [0] and [chr] is + absent from [str], returns the full string [str]. + + {b Remark:} [cut_on_char] can return the empty string. Examples of this + behaviour are [cut_on_char ',' 1 "foo,,bar"] and [cut_on_char ',' 0 ",foo"]. + + @raise Not_found if there are strictly less than [n] occurrences of [chr] in str. + @raise Invalid_argument if [n < 0]. + + @since 2.9.0 +*) + val join : string -> string list -> string (** Same as {!concat} *) @@ -907,7 +1022,15 @@ end (* String.Exceptionless *) with the added twist that strings can be made read-only or write-only. Read-only strings may then be safely shared and distributed. - There is no loss of performance involved. *) + @since 2.8.0 the interface and implementation of the Cap + module changed to accommodate the -safe-string transition. OCaml + now uses two distinct types for mutable and immutable string, + which is a good design but is not as expressive as the present Cap + interface, and actually makes implementing Cap harder than it + previously was. We are aware that current state is not optimal for + heavy Cap users; if you are one of them, please get in touch (on + the Batteries issue tracker for example) so that we can discuss + code refactoring and improvements for this sub-module. *) module Cap: sig @@ -938,11 +1061,66 @@ sig (** {6 Constructors}*) - external of_string : string -> _ t = "%identity" - (**Adopt a regular string.*) + external of_string : Bytes.t -> _ t = "%identity" +##V>=4.2## [@@ocaml.deprecated "Use Cap.of_bytes instead"] + (**Adopt a regular byte sequence. + + One could give a perfectly safe semantics to + an [of_string : string -> _ t] function, but this + requires making a copy of the string. Previous + versions of this interface advertised the absence + of performance overhead, so it's better to warn + the user and let them decide (through the use of + either Bytes.of_string or Bytes.unsafe_of_string) + whether they can safely avoid a copy or need to + insert one. + *) + + val of_bytes : Bytes.t -> _ t + (** Adopt a regular byte sequence. + + Note that adopting a byte sequence, even at the restrictive + [`Read] type, does not make a copy. Having a [`Read] string + prevents you (and anyone you pass it to) from writing it, but + your parent may have knowledge of the string at a more permissive + type and perform writes on it. + + If you want to use a [`Read] string and assume it will not get + written to, you should either properly "adopt" it by ensuring + unique ownership (this cannot be guaranteed by the type system), + or make a copy of it at adoption time: [Cap.of_bytes + (Bytes.copy buf)]. + + @since 2.8.0 + *) - external to_string : [`Read | `Write] t -> string = "%identity" - (** Return a capability string as a regular string.*) + external to_string : [`Read | `Write] t -> Bytes.t = "%identity" +##V>=4.2## [@@ocaml.deprecated "Use Cap.to_bytes instead"] + (** Return a capability string as a regular byte sequence. + + We cannot return a [string] here, and it would be incorrect to + do so even if we required [[< `Read] t] as input. Indeed, one + can start from a writeable byte sequence, and then use the + [read_only] function below to cast it into a [[`Read] + t]. Capabilities are used to enforce local protocol (only reads, + only writes, both reads and writes...), they don't guarantee + that other users of the same (shared) value all follow the same + protocol. To safely reason about mutability one needs stronger + ownership guarantees. + + If you want to obtain an immutable [string] out of a capability + string, you should first convert it to a mutable byte sequence + and then copy it into an immutable string. If you have extra + knowledge about the ownership of the value, you may use unsafe + conversion functions to avoid the copy, see the documentation of + unsafe conversion functions. + *) + + external to_bytes : [`Read | `Write] t -> Bytes.t = "%identity" + (** Return a capability string as a regular byte sequence. + + @since 2.8.0 + *) external read_only : [> `Read] t -> [`Read] t = "%identity" (** Drop capabilities to read only.*) @@ -1026,12 +1204,16 @@ sig val exists : [> `Read] t -> [> `Read] t -> bool + val count_char : [> `Read] t -> char -> int + (** {6 Transformations}*) val lchop : ?n:int -> [> `Read] t -> _ t val rchop : ?n:int -> [> `Read] t -> _ t + val chop : ?l:int -> ?r:int -> [> `Read] t -> _ t + val trim : [> `Read] t -> _ t val quote : [> `Read] t -> string @@ -1077,11 +1259,11 @@ sig (** {6 Splitting around}*) val split : [> `Read] t -> by:[> `Read] t -> _ t * _ t - val rsplit : [> `Read] t -> by:string -> string * string + val rsplit : [> `Read] t -> by:[> `Read] t -> _ t * _ t val nsplit : [> `Read] t -> by:[> `Read] t -> _ t list - val splice: [ `Read | `Write] t -> int -> int -> [> `Read] t -> string + val splice: [ `Read | `Write] t -> int -> int -> [> `Read] t -> _ t val join : [> `Read] t -> [> `Read] t list -> _ t @@ -1140,10 +1322,8 @@ sig val rfind_from: [> `Read] t -> int -> [> `Read] t -> int option - (* val split : string -> string -> (string * string) option TODO *) val split : [> `Read] t -> by:[> `Read] t -> (_ t * _ t) option - (* val rsplit : string -> string -> (string * string) option TODO *) val rsplit : [> `Read] t -> by:[> `Read] t -> (_ t * _ t) option end (* String.Cap.Exceptionless *) @@ -1155,9 +1335,10 @@ end (* The following is for system use only. Do not call directly. *) external unsafe_get : string -> int -> char = "%string_unsafe_get" -external unsafe_set : string -> int -> char -> unit = "%string_unsafe_set" +external unsafe_set : Bytes.t -> int -> char -> unit = "%string_unsafe_set" external unsafe_blit : - string -> int -> string -> int -> int -> unit = "caml_blit_string" "noalloc" -external unsafe_fill : string -> int -> int -> char -> unit = "caml_fill_string" "noalloc" + string -> int -> Bytes.t -> int -> int -> unit = "caml_blit_string" "noalloc" +external unsafe_fill : + Bytes.t -> int -> int -> char -> unit = "caml_fill_string" "noalloc" (**/**) diff --git a/src/batString.mlv b/src/batString.mlv index 44bb91757..3779d3a2d 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -31,12 +31,7 @@ let equal a b = String.compare a b = 0 let ord = BatOrd.ord String.compare -let init len f = - let s = Bytes.create len in - for i = 0 to len - 1 do - Bytes.unsafe_set s i (f i) - done; - s +let init = BatBytesCompat.string_init (*$T init init 5 (fun i -> BatChar.chr (i + int_of_char '0')) = "01234"; @@ -46,13 +41,14 @@ let starts_with str p = let len = length p in if length str < len then false else - BatReturn.label - (fun label -> - for i = 0 to len - 1 do - if unsafe_get str i <> unsafe_get p i then - BatReturn.return label false - done; - true) + (* length str >= length p *) + let rec loop str p i = + if i = len then true + else + (* 0 <= i < length p *) + if unsafe_get str i <> unsafe_get p i then false + else loop str p (i + 1) + in loop str p 0 (*$T starts_with starts_with "foobarbaz" "foob" starts_with "foobarbaz" "" @@ -69,15 +65,18 @@ let ends_with str p = let el = length p and sl = length str in let diff = sl - el in + (* diff = length str - length p *) if diff < 0 then false (*string is too short*) else - BatReturn.label - (fun label -> - for i = 0 to el - 1 do - if get str (diff + i) <> get p i then - BatReturn.return label false - done; - true) + (* diff >= 0 *) + let rec loop str p diff i = + if i = el then true + else + (* 0 <= i < length p *) + (* diff = length str - length p ==> diff <= i + diff < length str *) + if unsafe_get str (diff + i) <> unsafe_get p i then false + else loop str p diff (i + 1) + in loop str p diff 0 (*$T ends_with ends_with "foobarbaz" "rbaz" ends_with "foobarbaz" "" @@ -92,18 +91,22 @@ let ends_with str p = let find_from str pos sub = let len = length str in let sublen = length sub in - if pos < 0 || pos > len then raise (Invalid_argument "String.find_from"); + if pos < 0 || pos > len then invalid_arg "String.find_from"; if sublen = 0 then pos else - BatReturn.label (fun label -> - for i = pos to len - sublen do - let j = ref 0 in - while unsafe_get str (i + !j) = unsafe_get sub !j do - incr j; - if !j = sublen then BatReturn.return label i - done; - done; - raise Not_found - ) + let rec find ~str ~sub i = + if i > len - sublen then raise Not_found + else + (* 0 <= i <= length str - length sub *) + let rec loop ~str ~sub i j = + if j = sublen then i + else + (* 0 <= j < length sub *) + (* ==> 0 <= i + j < length str *) + if unsafe_get str (i + j) <> unsafe_get sub j + then find ~str ~sub (i + 1) + else loop ~str ~sub i (j + 1) + in loop ~str ~sub i 0 + in find ~str ~sub pos (*$Q find_from (Q.triple Q.string Q.char Q.small_int) ~count:1000 (fun (s, c, ofs) -> \ let v1 = try `res (find_from s ofs (String.make 1 c)) with Not_found -> `nf | Invalid_argument _ -> `inv in \ @@ -135,18 +138,25 @@ let find str sub = find_from str 0 sub let rfind_from str pos sub = let sublen = length sub and len = length str in - if pos + 1 < 0 || pos + 1 > len then raise (Invalid_argument "String.rfind_from"); + if pos + 1 < 0 || pos + 1 > len then invalid_arg "String.rfind_from"; + (* 0 <= pos + 1 <= length str *) if sublen = 0 then pos + 1 else - BatReturn.label (fun label -> - for i = pos - sublen + 1 downto 0 do - let j = ref 0 in - while unsafe_get str (i + !j) = unsafe_get sub !j do - incr j; - if !j = sublen then BatReturn.return label i - done; - done; - raise Not_found - ) + (* length sub > 0 *) + (* (pos + 1 - sublen) <= length str - length sub < length str *) + let rec find ~str ~sub i = + if i < 0 then raise Not_found + else + (* 0 <= i <= length str - length sub < length str *) + let rec loop ~str ~sub i j = + if j = sublen then i + else + (* 0 <= j < length sub *) + (* ==> 0 <= i + j < length str *) + if unsafe_get str (i + j) <> unsafe_get sub j + then find ~str ~sub (i - 1) + else loop ~str ~sub i (j + 1) + in loop ~str ~sub i 0 + in find ~str ~sub (pos - sublen + 1) (*$Q rfind_from (Q.triple Q.string Q.char Q.small_int) ~count:1000 (fun (s, c, ofs) -> \ let v1 = try `res (rfind_from s ofs (String.make 1 c)) with Not_found -> `nf | Invalid_argument _ -> `inv in \ @@ -177,6 +187,33 @@ let rfind str sub = rfind_from str (String.length str - 1) sub try ignore (rfind "foo" "barr"); false with Not_found -> true *) +let index_after_n chr n str = + if n < 0 then raise (Invalid_argument "String.index_after_n: n < 0") + else + let rec loop n i = + if n = 0 then i + else + let i = String.index_from str i chr in + loop (n - 1) (i + 1) + in + loop n 0 + +(*$T index_after_n + index_after_n ',' 0 "aa,bb,cc" = 0 + index_after_n ',' 1 "aa,bb,cc" = 3 + index_after_n ',' 2 "aa,bb,cc" = 6 + index_after_n ',' 0 "" = 0 + index_after_n '-' 0 "aa,bb,cc" = 0 + try ignore (index_after_n ',' (-1) "aa,bb,cc"); false with Invalid_argument _ -> true + try ignore (index_after_n ',' 3 "aa,bb,cc"); false with Not_found -> true + try ignore (index_after_n '-' 1 "aa,bb,cc"); false with Not_found -> true + index_after_n ',' 0 ",ab" = 0 + index_after_n ',' 1 ",ab" = 1 + index_after_n ',' 1 "a,,b" = 2 + index_after_n ',' 2 "a,,b" = 3 + index_after_n ',' 1 "a," = 2 +*) + let find_all str sub = (* enumerator *) let rec next r () = @@ -211,7 +248,28 @@ let find_all str sub = let e = find_all "aaabbaabaaa" "aa" in \ Enum.drop 2 e; let e' = Enum.clone e in \ (List.of_enum e = [5;8;9]) && (Enum.skip 1 e' |> List.of_enum = [8;9]) - *) +*) + +let count_string str sub = + if sub = "" then invalid_arg "String.count_string"; + let m = length str in + let n = length sub in + let rec loop acc i = + if i >= m then + acc + else + try + let j = find_from str i sub in + loop (acc + 1) (j + n) + with Not_found -> acc + in + loop 0 0 +(*$T count_string + try let _ = count_string "abc" "" in false with Invalid_argument _ -> true + count_string "aaa" "a" = 3 + count_string "aaa" "aa" = 1 + count_string "coucou" "cou" = 2 +*) let exists str sub = try @@ -233,7 +291,8 @@ let exists str sub = not (exists "ab" "c") *) -let strip ?(chars = " \t\r\n") s = +let strip_default = " \t\r\n" +let strip ?(chars = strip_default) s = let p = ref 0 in let l = length s in while !p < l && contains chars (unsafe_get s !p) do @@ -324,8 +383,8 @@ let rsplit str ~by:sep = of substrings from the end to the beginning, so as to avoid a call to [List.rev]. *) let nsplit str ~by:sep = - if str = "" then [] - else if sep = "" then invalid_arg "nsplit: empty sep not allowed" + if str = "" then [""] + else if sep = "" then invalid_arg "String.nsplit: empty sep not allowed" else (* str is non empty *) let seplen = String.length sep in @@ -353,7 +412,7 @@ let nsplit str ~by:sep = (*$T nsplit nsplit "a;b;c" ~by:";" = ["a"; "b"; "c"] - nsplit "" ~by:"x" = [] + nsplit "" ~by:"x" = [""] try nsplit "abc" ~by:"" = ["a"; "b"; "c"] with Invalid_argument _ -> true nsplit "a/b/c" ~by:"/" = ["a"; "b"; "c"] nsplit "/a/b/c//" ~by:"/" = [""; "a"; "b"; "c"; ""; ""] @@ -361,28 +420,48 @@ let nsplit str ~by:sep = *) let split_on_char sep str = - if str = "" then [] + if str = "" then [""] else (* str is non empty *) let rec loop acc ofs limit = if ofs < 0 then sub str 0 limit :: acc - else if str.[ofs] <> sep then loop acc (ofs - 1) limit + (* ofs >= 0 && ofs < length str *) + else if unsafe_get str ofs <> sep then loop acc (ofs - 1) limit else loop (sub str (ofs + 1) (limit - ofs - 1) :: acc) (ofs - 1) ofs in let len = length str in loop [] (len - 1) len (*$T split_on_char split_on_char ';' "a;b;c" = ["a"; "b"; "c"] - split_on_char 'x' "" = [] + split_on_char 'x' "" = [""] split_on_char '/' "a/b/c" = ["a"; "b"; "c"] split_on_char '/' "/a/b/c//" = [""; "a"; "b"; "c"; ""; ""] *) +let cut_on_char chr pos str = + let i = index_after_n chr pos str in + let j = try index_from str i chr with Not_found -> length str in + sub str i (j - i) + +(*$T cut_on_char + cut_on_char ',' 0 "aa,bb,cc" = "aa" + cut_on_char ',' 1 "aa,bb,cc" = "bb" + cut_on_char ',' 2 "aa,bb,cc" = "cc" + cut_on_char '-' 0 "aa,bb,cc" = "aa,bb,cc" + cut_on_char ',' 0 "" = "" + try ignore (cut_on_char ',' (-1) "aa,bb,cc"); false with Invalid_argument _ -> true + try ignore (cut_on_char ',' 3 "aa,bb,cc"); false with Not_found -> true + try ignore (cut_on_char '-' 1 "aa,bb,cc"); false with Not_found -> true + cut_on_char ',' 0 ",ab" = "" + cut_on_char ',' 1 "a,,b" = "" + cut_on_char ',' 1 "a," = "" +*) + let join = concat let unsafe_slice i j s = if i >= j || i = length s then - Bytes.create 0 + "" else sub s i (j-i) @@ -406,7 +485,7 @@ let slice ?(first = 0) ?(last = Sys.max_string_length) s = let lchop ?(n = 1) s = if n < 0 then - invalid_arg "lchop: number of characters to chop is negative" + invalid_arg "String.lchop: number of characters to chop is negative" else let slen = length s in if slen <= n then "" else sub s n (slen - n) @@ -421,7 +500,7 @@ let lchop ?(n = 1) s = let rchop ?(n = 1) s = if n < 0 then - invalid_arg "rchop: number of characters to chop is negative" + invalid_arg "String.rchop: number of characters to chop is negative" else let slen = length s in if slen <= n then "" else sub s 0 (slen - n) @@ -433,6 +512,24 @@ let rchop ?(n = 1) s = try ignore (rchop ~n:(-1) "Weeble"); false with Invalid_argument _ -> true *) +let chop ?(l = 1) ?(r = 1) s = + if l < 0 then + invalid_arg "String.chop: number of characters to chop on the left is negative"; + if r < 0 then + invalid_arg "String.chop: number of characters to chop on the right is negative"; + let slen = length s in + if slen < l + r then "" + else sub s l (slen - l - r) +(*$T chop + chop "\"Weeble\"" = "Weeble" + chop "" = "" + chop ~l:2 ~r:3 "01234567" = "234" + chop ~l:1000 "Weeble" = "" + chop ~r:1000 "Weeble" = "" + try ignore (chop ~l:(-1) "Weeble"); false with Invalid_argument _ -> true + try ignore (chop ~r:(-1) "Weeble"); false with Invalid_argument _ -> true +*) + let of_int = string_of_int (*$T of_int of_int 56 = "56" @@ -512,7 +609,7 @@ let of_enum e = let s = Bytes.create l in let i = ref 0 in BatEnum.iter (fun c -> Bytes.unsafe_set s (BatRef.post_incr i) c) e; - s + Bytes.unsafe_to_string s (*$T of_enum Enum.init 3 (fun i -> char_of_int (i + int_of_char '0')) |> of_enum = "012" Enum.init 0 (fun _i -> ' ') |> of_enum = "" @@ -524,7 +621,8 @@ let of_backwards e = let s = Bytes.create l in let i = ref (l - 1) in BatEnum.iter (fun c -> Bytes.unsafe_set s (BatRef.post_decr i) c) e; - s + Bytes.unsafe_to_string s + (*$T of_backwards "" |> enum |> of_backwards = "" "foo" |> enum |> of_backwards = "oof" @@ -537,7 +635,7 @@ let map f s = for i = 0 to len - 1 do Bytes.unsafe_set sc i (f (unsafe_get s i)) done; - sc + Bytes.unsafe_to_string sc (*$T map map Char.uppercase "Five" = "FIVE" map Char.uppercase "" = "" @@ -550,7 +648,7 @@ let mapi f s = for i = 0 to len - 1 do Bytes.unsafe_set sc i (f i (unsafe_get s i)) done; - sc + Bytes.unsafe_to_string sc (*$T mapi mapi (fun _ -> Char.uppercase) "Five" = "FIVE" mapi (fun _ -> Char.uppercase) "" = "" @@ -589,7 +687,7 @@ let fold_left f init str = let n = String.length str in let rec loop i result = if i = n then result - else loop (i + 1) (f result str.[i]) + else loop (i + 1) (f result (unsafe_get str i)) in loop 0 init (*$T fold_left @@ -597,11 +695,26 @@ let fold_left f init str = fold_left max 'a' "apples" = 's' *) +let count_char str char = + let count = ref 0 in + let n = length str in + for i = 0 to n - 1 do + if (unsafe_get str i) = char then + incr count + done; + !count +(*$T count_char + count_char "abc" 'd' = 0 + count_char "" 'd' = 0 + count_char "dad" 'd' = 2 +*) + let fold_lefti f init str = let n = String.length str in let rec loop i result = if i = n then result - else loop (i + 1) (f result i str.[i]) + (* i >= 0 && i < len str *) + else loop (i + 1) (f result i (unsafe_get str i)) in loop 0 init (*$T fold_lefti fold_lefti (fun a i c->(i,c)::a) [] "foo"=[(2,'o');(1,'o');(0,'f')] @@ -614,8 +727,10 @@ let fold_right f str init = let rec loop i result = if i = 0 then result else + (* i > 0 && i <= len str *) let i' = i - 1 in - loop i' (f str.[i'] result) + (* i' >= 0 && i' < len str *) + loop i' (f (unsafe_get str i') result) in loop n init (*$T fold_right @@ -628,8 +743,10 @@ let fold_righti f str init = let rec loop i result = if i = 0 then result else + (* i > 0 && i <= len str *) let i' = i - 1 in - loop i' (f i' str.[i'] result) + (* i' >= 0 && i' < len str *) + loop i' (f i' (unsafe_get str i') result) in loop n init (*$T fold_righti fold_righti (fun i c a->(i,c)::a) "foo" []=[(0,'f');(1,'o');(2,'o')] @@ -637,8 +754,9 @@ let fold_righti f str init = *) let iteri f str = - for i = 0 to (String.length str) - 1 do f i str.[i] done - + for i = 0 to String.length str - 1 do + f i (unsafe_get str i) + done (*$R iteri let letter_positions word = let positions = Array.make 256 [] in @@ -656,9 +774,14 @@ let iteri f str = (* explode and implode from the OCaml Expert FAQ. *) let explode s = - let rec exp i l = - if i < 0 then l else exp (i - 1) (s.[i] :: l) in - exp (String.length s - 1) [] + let rec loop i l = + if i < 0 then + l + else + (* i >= 0 && i < length s *) + loop (i - 1) (unsafe_get s i :: l) + in + loop (String.length s - 1) [] (*$T explode explode "foo" = ['f'; 'o'; 'o'] explode "" = [] @@ -673,9 +796,10 @@ let to_list = explode let implode l = let res = Bytes.create (List.length l) in let rec imp i = function - | [] -> res + | [] -> () | c :: l -> Bytes.set res i c; imp (i + 1) l in - imp 0 l + imp 0 l; + Bytes.unsafe_to_string res (*$T implode implode ['b';'a';'r'] = "bar" implode [] = "" @@ -707,11 +831,11 @@ let replace_chars f s = | s :: acc -> let len = length s in pos := !pos - len; - blit s 0 sbuf !pos len; + Bytes.blit_string s 0 sbuf !pos len; loop2 acc in loop2 strs; - sbuf + Bytes.unsafe_to_string sbuf (*$T replace_chars replace_chars (function ' ' -> "(space)" | c -> of_char c) "foo bar" = "foo(space)bar" replace_chars (fun _ -> "") "foo" = "" @@ -728,7 +852,7 @@ let replace ~str ~sub ~by = blit str 0 newstr 0 subpos ; blit by 0 newstr subpos bylen ; blit str (subpos + sublen) newstr (subpos + bylen) (strlen - subpos - sublen) ; - (true, newstr) + (true, Bytes.unsafe_to_string newstr) with Not_found -> (* find failed *) (false, str) (*$T replace @@ -738,7 +862,8 @@ let replace ~str ~sub ~by = let nreplace ~str ~sub ~by = - if sub = "" then invalid_arg "nreplace: cannot replace all empty substrings" ; + if sub = "" then + invalid_arg "String.nreplace: cannot replace all empty substrings" ; let strlen = length str in let sublen = length sub in let bylen = length by in @@ -753,14 +878,14 @@ let nreplace ~str ~sub ~by = match idxes with | [] -> (* still need the last chunk *) - unsafe_blit str i newstr j (strlen-i) + Bytes.blit_string str i newstr j (strlen-i) | i'::rest -> let di = i' - i in - unsafe_blit str i newstr j di ; - unsafe_blit by 0 newstr (j + di) bylen ; + Bytes.blit_string str i newstr j di ; + Bytes.blit_string by 0 newstr (j + di) bylen ; loop_copy (i + di + sublen) (j + di + bylen) rest in loop_copy 0 0 idxes ; - newstr + Bytes.unsafe_to_string newstr (*$T nreplace nreplace ~str:"bar foo aaa bar" ~sub:"aa" ~by:"foo" = "bar foo afoo bar" nreplace ~str:"bar foo bar" ~sub:"bar" ~by:"foo" = "foo foo foo" @@ -768,21 +893,21 @@ let nreplace ~str ~sub ~by = nreplace ~str:"" ~sub:"aa" ~by:"bb" = "" nreplace ~str:"foo bar baz" ~sub:"foo bar baz" ~by:"" = "" nreplace ~str:"abc" ~sub:"abc" ~by:"def" = "def" - let s1 = "foo" in let s2 = nreplace ~str:s1 ~sub:"X" ~by:"X" in set s2 0 'F' ; s1.[0] = 'f' *) let rev_in_place s = - let len = String.length s in + let len = Bytes.length s in if len > 0 then for k = 0 to (len - 1)/2 do - let old = s.[k] and mirror = len - 1 - k in - Bytes.set s k s.[mirror]; Bytes.set s mirror old; + let old = Bytes.get s k and mirror = len - 1 - k in + Bytes.set s k (Bytes.get s mirror); + Bytes.set s mirror old; done (*$= rev_in_place as f & ~printer:identity - (let s="" in f s; s) "" - (let s="1" in f s; s) "1" - (let s="12" in f s; s) "21" - (let s="Example!" in f s; s) "!elpmaxE" + (let s=Bytes.of_string "" in f s; Bytes.to_string s) "" + (let s=Bytes.of_string "1" in f s; Bytes.to_string s) "1" + (let s=Bytes.of_string "12" in f s; Bytes.to_string s) "21" + (let s=Bytes.of_string "Example!" in f s; Bytes.to_string s) "!elpmaxE" *) let in_place_mirror = rev_in_place @@ -801,9 +926,9 @@ let rev s = let len = String.length s in let reversed = Bytes.create len in for i = 0 to len - 1 do - Bytes.unsafe_set reversed (len - i - 1) (String.unsafe_get s i) + Bytes.unsafe_set reversed (len - i - 1) (unsafe_get s i) done; - reversed + Bytes.unsafe_to_string reversed (*$T rev rev "" = "" @@ -840,10 +965,11 @@ let splice s1 off len s2 = let len = clip ~lo:0 ~hi:(len1 - off) len in let out_len = len1 - len + len2 in let s = Bytes.create out_len in - blit s1 0 s 0 off; (* s1 before splice point *) - blit s2 0 s off len2; (* s2 at splice point *) - blit s1 (off+len) s (off+len2) (len1 - (off+len)); (* s1 after off+len *) - s + Bytes.blit_string s1 0 s 0 off; (* s1 before splice point *) + Bytes.blit_string s2 0 s off len2; (* s2 at splice point *) + Bytes.blit_string (* s1 after off+len *) + s1 (off+len) s (off+len2) (len1 - (off+len)); + Bytes.unsafe_to_string s (*$T splice splice "foo bar baz" 3 5 "XXX" = "fooXXXbaz" splice "foo bar baz" 5 0 "XXX" = "foo bXXXar baz" @@ -910,32 +1036,32 @@ let numeric_compare s1 s2 = ##V<4.3##let lowercase_ascii s = map BatChar.lowercase_ascii s (*$T uppercase_ascii - equal ("five" |> of_string |> capitalize_ascii |> to_string) "FIVE" - equal ("école" |> of_string |> captialize_ascii |> to_string) "éCOLE" + equal ("five" |> uppercase_ascii) "FIVE" + equal ("école" |> uppercase_ascii) "éCOLE" *) (*$T lowercase_ascii - equal ("FIVE" |> of_string |> capitalize_ascii |> to_string) "five" - equal ("ÉCOLE" |> of_string |> captialize_ascii |> to_string) "École" + equal ("FIVE" |> lowercase_ascii) "five" + equal ("ÉCOLE" |> lowercase_ascii) "École" *) ##V<4.3##let map_first_char f s = -##V<4.3## let r = copy s in -##V<4.3## if length s > 0 then -##V<4.3## unsafe_set r 0 (f(unsafe_get s 0)); -##V<4.3## r +##V<4.3## let r = Bytes.of_string s in +##V<4.3## if Bytes.length r > 0 then +##V<4.3## Bytes.unsafe_set r 0 (f (unsafe_get s 0)); +##V<4.3## Bytes.unsafe_to_string r ##V<4.3##let capitalize_ascii s = map_first_char BatChar.uppercase_ascii s ##V<4.3##let uncapitalize_ascii s = map_first_char BatChar.lowercase_ascii s (*$T capitalize_ascii equal ("five" |> capitalize_ascii) "Five" - equal ("école" |> captialize_ascii) "école" + equal ("école" |> capitalize_ascii) "école" *) (*$T uncapitalize_ascii - equal ("Five" |> capitalize_ascii) "Five" - equal ("école" |> captialize_ascii) "école" + equal ("Five" |> uncapitalize_ascii) "five" + equal ("École" |> uncapitalize_ascii) "École" *) module NumString = @@ -966,7 +1092,9 @@ let edit_distance s1 s2 = (* try add/delete/replace operations *) for j = 0 to String.length s2 - 1 do - let cost = if s1.[i] = s2.[j] then 0 else 1 in + (* i >= 0 && i < length s1 *) + (* j >= 0 && j < length s2 *) + let cost = if unsafe_get s1 i = unsafe_get s2 j then 0 else 1 in v1.(j+1) <- min (v1.(j) + 1) (min (v0.(j+1) + 1) (v0.(j) + cost)); done; @@ -1068,89 +1196,107 @@ struct *) end (* String.Exceptionless *) +##V<4.5##let index_opt = Exceptionless.index +##V<4.5##let rindex_opt = Exceptionless.rindex +##V<4.5##let index_from_opt = Exceptionless.index_from +##V<4.5##let rindex_from_opt = Exceptionless.rindex_from + module Cap = struct - type 'a t = string - - let make = make - let is_empty = is_empty - let init = init - let enum = enum - let of_enum = of_enum - let backwards = backwards - let of_backwards = of_backwards - - let of_int = of_int - let of_float = of_float - let of_char = of_char - let to_int = to_int - let to_float = to_float - let map = map - let mapi = mapi - let fold_left = fold_left - let fold_right = fold_right - let fold_lefti = fold_lefti - let fold_righti = fold_righti - let iter = iter - let index = index - let rindex = rindex - let index_from = index_from - let rindex_from = rindex_from - let contains = contains - let contains_from = contains_from - let rcontains_from= rcontains_from - let find = find - let find_from = find_from - let rfind = rfind - let rfind_from = rfind_from - let ends_with = ends_with - let starts_with = starts_with - let exists = exists - let lchop = lchop - let rchop = rchop - let strip = strip - let uppercase = uppercase - let lowercase = lowercase - let capitalize = capitalize - let uncapitalize = uncapitalize - let copy = copy - let sub = sub + type 'a t = Bytes.t + let ubos = Bytes.unsafe_of_string + let usob = Bytes.unsafe_to_string + + let make = Bytes.make + let is_empty b = is_empty (usob b) + let init n f = ubos (init n f) + let enum b = enum (usob b) + let of_enum e = ubos (of_enum e) + let backwards b = backwards (usob b) + let of_backwards e = ubos (of_backwards e) + + let of_int n = ubos (of_int n) + let of_float x = ubos (of_float x) + let of_char c = ubos (of_char c) + let to_int b = to_int (usob b) + let to_float b = to_float (usob b) + let map f b = ubos (map f (usob b)) + let mapi f b = ubos (mapi f (usob b)) + let fold_left f v b = fold_left f v (usob b) + let fold_right f b v = fold_right f (usob b) v + let fold_lefti f v b = fold_lefti f v (usob b) + let fold_righti f b v = fold_righti f (usob b) v + let iter f b = iter f (usob b) + let index b c = index (usob b) c + let rindex b c = rindex (usob b) c + let index_from b i c = index_from (usob b) i c + let rindex_from b i c = rindex_from (usob b) i c + let contains b c = contains (usob b) c + let contains_from b i c = contains_from (usob b) i c + let rcontains_from b i c = rcontains_from (usob b) i c + let find b1 b2 = find (usob b1) (usob b2) + let find_from b1 i b2 = find_from (usob b1) i (usob b2) + let rfind b1 b2 = rfind (usob b1) (usob b2) + let rfind_from b1 i b2 = rfind_from (usob b1) i (usob b2) + let ends_with b1 b2 = ends_with (usob b1) (usob b2) + let starts_with b1 b2 = starts_with (usob b1) (usob b2) + let exists b1 b2 = exists (usob b1) (usob b2) + let count_char s c = count_char (usob s) c + let lchop ?n b = ubos (lchop ?n (usob b)) + let rchop ?n b = ubos (rchop ?n (usob b)) + let chop ?l ?r b = ubos (chop ?l ?r (usob b)) + let strip ?(chars = ubos strip_default) b = + ubos (strip ~chars:(usob chars) (usob b)) + let uppercase b = ubos (uppercase (usob b)) + let lowercase b = ubos (lowercase (usob b)) + let capitalize b = ubos (capitalize (usob b)) + let uncapitalize b = ubos (uncapitalize (usob b)) + let copy = Bytes.copy + let sub = Bytes.sub let fill = Bytes.fill - let blit = blit - let concat = concat - let escaped = escaped - let replace_chars = replace_chars - let replace = replace - let nreplace = nreplace - let split = split - let repeat = repeat - let rsplit = rsplit - let nsplit = nsplit - let join = join - let slice = slice - let explode = explode - let implode = implode - let compare = compare - let icompare = icompare - let splice = splice - let trim = trim - let quote = quote - let left = left - let right = right - let head = head - let tail = tail - let filter_map = filter_map - let filter = filter - let of_list = of_list - let to_list = to_list - - let quote = quote - let print = print - let println = println - let print_quoted = print_quoted - - external of_string : string -> _ t = "%identity" - external to_string : [`Read | `Write] t -> string = "%identity" + let blit = Bytes.blit + let concat = Bytes.concat + let escaped = Bytes.escaped + let replace_chars f b = ubos (replace_chars (fun c -> usob (f c)) (usob b)) + let replace ~str ~sub ~by = + let (b, s) = replace ~str:(usob str) ~sub:(usob sub) ~by:(usob by) in + (b, ubos s) + let nreplace ~str ~sub ~by = + ubos (nreplace ~str:(usob str) ~sub:(usob sub) ~by:(usob by)) + let split b ~by = + let (a, b) = split (usob b) ~by:(usob by) in + (ubos a, ubos b) + let repeat b i = ubos (repeat (usob b) i) + let rsplit b ~by = + let (a, b) = rsplit (usob b) ~by:(usob by) in + (ubos a, ubos b) + let nsplit b ~by = List.map ubos (nsplit (usob b) ~by:(usob by)) + let join = Bytes.concat + let slice ?first ?last b = ubos (slice ?first ?last (usob b)) + let explode b = explode (usob b) + let implode cs = ubos (implode cs) + let compare b1 b2 = compare (usob b1) (usob b2) + let icompare b1 b2 = icompare (usob b1) (usob b2) + let splice b1 i1 i2 b2 = ubos (splice (usob b1) i1 i2 (usob b2)) + let trim b = ubos (trim (usob b)) + let quote b = quote (usob b) + let left b i = ubos (left (usob b) i) + let right b i = ubos (right (usob b) i) + let head b i = ubos (head (usob b) i) + let tail b i = ubos (tail (usob b) i) + let filter_map f b = ubos (filter_map f (usob b)) + let filter f b = ubos (filter f (usob b)) + let of_list li = ubos (of_list li) + let to_list b = to_list (usob b) + + let print io b = print io (usob b) + let println io b = println io (usob b) + let print_quoted io b = print_quoted io (usob b) + + external of_string : Bytes.t -> _ t = "%identity" + external of_bytes : Bytes.t -> _ t = "%identity" + external to_string : [`Read | `Write] t -> Bytes.t = "%identity" + external to_bytes : [`Read | `Write] t -> Bytes.t = "%identity" external read_only : [> `Read] t -> [`Read] t = "%identity" external write_only: [> `Write] t -> [`Write] t = "%identity" @@ -1167,18 +1313,24 @@ struct module Exceptionless = struct - let find_from = Exceptionless.find_from - let find = Exceptionless.find - let rfind_from = Exceptionless.rfind_from - let rfind = Exceptionless.rfind - let to_int = Exceptionless.to_int - let to_float = Exceptionless.to_float - let index = Exceptionless.index - let index_from = Exceptionless.index_from - let rindex_from = Exceptionless.rindex_from - let rindex = Exceptionless.rindex - let split = Exceptionless.split - let rsplit = Exceptionless.rsplit + let find_from b1 i b2 = Exceptionless.find_from (usob b1) i (usob b2) + let find b1 b2 = Exceptionless.find (usob b1) (usob b2) + let rfind_from b1 i b2 = Exceptionless.rfind_from (usob b1) i (usob b2) + let rfind b1 b2 = Exceptionless.rfind (usob b1) (usob b2) + let to_int b = Exceptionless.to_int (usob b) + let to_float b = Exceptionless.to_float (usob b) + let index b c = Exceptionless.index (usob b) c + let index_from b i c = Exceptionless.index_from (usob b) i c + let rindex_from b i c = Exceptionless.rindex_from (usob b) i c + let rindex b c = Exceptionless.rindex (usob b) c + let split b ~by = + match Exceptionless.split (usob b) ~by:(usob by) with + | None -> None + | Some (a, b) -> Some (ubos a, ubos b) + let rsplit b ~by = + match Exceptionless.rsplit (usob b) ~by:(usob by) with + | None -> None + | Some (a, b) -> Some (ubos a, ubos b) end (* String.Cap.Exceptionless *) end (* String.Cap *) diff --git a/src/batSubstring.ml b/src/batSubstring.ml index c53af7e4e..b6321ef0b 100644 --- a/src/batSubstring.ml +++ b/src/batSubstring.ml @@ -54,14 +54,17 @@ let create len = String.make len '\000', 0, len let equal (s1,o1,l1) (s2,o2,l2) = if l1 <> l2 then false - else BatReturn.label (fun label -> - for i = 0 to l1-1 do - if s1.[i+o1] <> s1.[i+o2] then BatReturn.return label false - done; true) + else + let rec loop i = + if i = l1 then true + else if s1.[i+o1] <> s2.[i+o2] then false + else loop (i + 1) + in loop 0 (*$T equal equal (of_string "abc") (of_string "abc") = true equal (substring "aba" 0 1) (substring "aba" 2 1) = true equal (substring "aba" 1 1) (substring "aba" 2 1) = false + equal (substring "abc" 0 2) (substring "cab" 1 2) = true *) (* @@ -82,7 +85,7 @@ let of_input inp = and tmp = Bytes.create tempsize in let n = ref 0 in while n := BatIO.input inp tmp 0 tempsize; !n > 0 do - Buffer.add_substring buf tmp 0 !n; + BatBytesCompat.buffer_add_subbytes buf tmp 0 !n; done; Buffer.contents buf, 0, Buffer.length buf @@ -150,7 +153,7 @@ let triml k (str,off,len) = *) let trimr k (str,off,len) = - if k < 0 then invalid_arg "Substring.triml: negative trim not allowed"; + if k < 0 then invalid_arg "Substring.trimr: negative trim not allowed"; if k > len then (str, off, 0) else (str, off, len-k) (*$T trimr @@ -194,10 +197,10 @@ let concat ssl = let item = Bytes.create len in let write = let pos = ref 0 in - fun (s,o,len) -> String.unsafe_blit s o item !pos len; pos := !pos + len + fun (s,o,len) -> Bytes.blit_string s o item !pos len; pos := !pos + len in List.iter write ssl; - item + Bytes.unsafe_to_string item (*$T concat concat [empty ()] = "" concat [substring "foobar" 1 3; empty ()] = "oob" diff --git a/src/batSubstring.mli b/src/batSubstring.mli index 858d70bb7..ca546465a 100644 --- a/src/batSubstring.mli +++ b/src/batSubstring.mli @@ -63,7 +63,7 @@ val base : t -> string * int * int n)]. *) val is_empty : t -> bool -(** [isEmpty (s, i, n)] true if the substring is empty (that is, +(** [is_empty (s, i, n)] true if the substring is empty (that is, [n = 0]). *) val getc : t -> (char * t) option @@ -90,7 +90,7 @@ val trimr : int -> t -> t *) val get : t -> int -> char -(** [sub sus k] returns the k'th character of the substring; that +(** [get sus k] returns the k'th character of the substring; that is, s(i+k) where sus = (s, i, n). @raise Invalid_argument if [k<0] or [k>=n]. *) @@ -137,20 +137,20 @@ val compare : t -> t -> int *) val index : t -> char -> int -(** [index sus c] returns the index of the first occurence of [c] in [sus] or +(** [index sus c] returns the index of the first occurrence of [c] in [sus] or @raise Not_found otherwise. *) val index_from : t -> int -> char -> int -(** [index_from sus i c] returns the index of the first occurence of [c] in +(** [index_from sus i c] returns the index of the first occurrence of [c] in [sus] after the index [i] or @raise Not_found otherwise. If [i] is beyond the range of [sus], @raise Invalid_argument. It is equivalent to [i + index (triml i sus) c]. *) val rindex : t -> char -> int -(** [rindex sus c] returns the index of the last occurence of [c] in [sus] or +(** [rindex sus c] returns the index of the last occurrence of [c] in [sus] or @raise Not_found otherwise. *) val rindex_from : t -> int -> char -> int -(** [index_from sus i c] returns the index of the last occurence of [c] in [sus] +(** [index_from sus i c] returns the index of the last occurrence of [c] in [sus] before the index [i] or @raise Not_found otherwise. If [i] is beyond the range of [sus], @raise Invalid_argument. It is equivalent to [rindex (trimr i sus) c]. *) @@ -278,7 +278,7 @@ val fields : (char -> bool) -> t -> t list *) val fold_left : ('a -> char -> 'a) -> 'a -> t -> 'a -(** [foldl f e sus] folds [f] over [sus] from left to right. That is, +(** [fold_left f e sus] folds [f] over [sus] from left to right. That is, evaluates [f s.[i+n-1] (f ... (f s.[i+1] (f s.[i] e)) ...)] tail-recursively, where [sus = (s, i, n)]. Equivalent to [List.fold_left f e (explode sus)]. *) @@ -290,7 +290,7 @@ val fold_lefti : ('a -> int -> char -> 'a) -> 'a -> t -> 'a *) val fold_right : (char -> 'a -> 'a) -> t -> 'a -> 'a -(** [foldr f e sus] folds [f] over [sus] from right to left. That is, +(** [fold_right f e sus] folds [f] over [sus] from right to left. That is, evaluates [f s.[i] (f s.[i+1] (f ... (f s.[i+n-1] e) ...))] tail-recursively, where [sus = (s, i, n)]. Equivalent to [List.fold_right f e (explode sus)]. diff --git a/src/batSys.mliv b/src/batSys.mliv index 44ac36c11..b7a4f9333 100644 --- a/src/batSys.mliv +++ b/src/batSys.mliv @@ -61,6 +61,12 @@ external getenv : string -> string = "caml_sys_getenv" (** Return the value associated to a variable in the process environment. @raise Not_found if the variable is unbound. *) +val getenv_opt: string -> string option +(** Return the value associated to a variable in the process + environment or [None] if the variable is unbound. + @since 4.05 +*) + external command : string -> int = "caml_sys_system_command" (** Execute the given shell command and return its exit code. *) @@ -146,18 +152,22 @@ val max_array_length : int array is [max_array_length/2] on 32-bit machines and [max_array_length] on 64-bit machines. *) +##V>=4.08##val max_floatarray_length : int +##V>=4.08##(** Maximum length of a floatarray. This is also the maximum length of +##V>=4.08## a [float array] when OCaml is configured with +##V>=4.08## [--enable-flat-float-array]. *) + ##V>=4.3##external runtime_variant : unit -> string = "caml_runtime_variant" ##V>=4.3##(** Return the name of the runtime variant the program is running on. ##V>=4.3## This is normally the argument given to [-runtime-variant] at compile ##V>=4.3## time, but for byte-code it can be changed after compilation. ##V>=4.3## @since 2.5.0 and OCaml 4.03.0 *) -##V>=4.3## + ##V>=4.3##external runtime_parameters : unit -> string = "caml_runtime_parameters" ##V>=4.3##(** Return the value of the runtime parameters, in the same format ##V>=4.3## as the contents of the [OCAMLRUNPARAM] environment variable. ##V>=4.3## @since 2.5.0 and OCaml 4.03.0 *) - (** {6 Signal handling} *) diff --git a/src/batSys.mlv b/src/batSys.mlv index 2287a5581..f59875e34 100644 --- a/src/batSys.mlv +++ b/src/batSys.mlv @@ -35,3 +35,5 @@ let files_of d = BatArray.enum (readdir d) ##V>=4.3##external opaque_identity : 'a -> 'a = "%opaque" ##V<4.3##let opaque_identity = BatOpaqueInnerSys.opaque_identity + +##V<4.5##let getenv_opt v = try Some (getenv v) with Not_found -> None diff --git a/src/batText.ml b/src/batText.ml index 6fcdba4bd..6a5228701 100644 --- a/src/batText.ml +++ b/src/batText.ml @@ -44,10 +44,11 @@ let splice s1 off len s2 = let len = int_min (len1 - off) len in let out_len = len1 - len + len2 in let s = Bytes.create out_len in - String.blit s1 0 s 0 off; (* s1 before splice point *) - String.blit s2 0 s off len2; (* s2 at splice point *) - String.blit s1 (off+len) s (off+len2) (len1 - (off+len)); (* s1 after off+len *) - s + Bytes.blit_string s1 0 s 0 off; (* s1 before splice point *) + Bytes.blit_string s2 0 s off len2; (* s2 at splice point *) + Bytes.blit_string (* s1 after off+len *) + s1 (off+len) s (off+len2) (len1 - (off+len)); + Bytes.unsafe_to_string s type t = Empty (**An empty rope*) @@ -172,7 +173,7 @@ let bal_if_needed l r = if height r < max_height then r else balance r let concat_str l = function - | Empty | Concat(_,_,_,_,_) -> invalid_arg "concat_str" + | Empty | Concat(_,_,_,_,_) -> invalid_arg "Text.concat_str" | Leaf (lenr, rs) as r -> match l with | Empty -> r @@ -492,7 +493,7 @@ let rec iteri ?(base=0) f = function let rec bulk_iteri_backwards ~top f = function | Empty -> () - | Leaf (lens,s) -> f (top-lens) s (* gives f the base position, not the top *) + | Leaf (lens,s) -> f top s | Concat(l,_,r,cr,_) -> bulk_iteri_backwards ~top f r; bulk_iteri_backwards ~top:(top-cr) f l @@ -670,12 +671,23 @@ let rindex r char = Return.return label (p+i) with Not_found -> () in - bulk_iteri_backwards ~top:(length r) index_aux r; + bulk_iteri_backwards ~top:(length r - 1) index_aux r; raise Not_found) +(*$T rindex + rindex (of_string "batteries") (BatUChar.of_char 't') = 3 + rindex (of_string "batt") (BatUChar.of_char 't') = 3 + try ignore (rindex (of_string "batteries") (BatUChar.of_char 'y')); false with Not_found -> true +*) let rindex_from r start char = - let rsub = left r start in + let rsub = left r (start + 1) in (rindex rsub char) +(*$T rindex_from + let s = "batteries" in rindex_from (of_string s) (String.length s - 1) (BatUChar.of_char 't') = 3 + let s = "batteries" in rindex_from (of_string s) 2 (BatUChar.of_char 't') = 2 + try ignore (rindex_from (of_string "batteries") 4 (BatUChar.of_char 'y')); false with Not_found -> true + try ignore (rindex_from (of_string "batteries") 20 (BatUChar.of_char 'y')); false with Out_of_bounds -> true +*) let contains r char = Return.with_label (fun label -> @@ -684,14 +696,42 @@ let contains r char = in bulk_iter contains_aux r; false) +(*$T contains + contains empty (BatUChar.of_char 't') = false + contains (of_string "") (BatUChar.of_char 't') = false + contains (of_string "batteries") (BatUChar.of_char 't') = true + contains (of_string "batteries") (BatUChar.of_char 'y') = false +*) let contains_from r start char = Return.with_label (fun label -> let contains_aux c = if c = char then Return.return label true in range_iter contains_aux start (length r - start) r; false) +(*$T contains_from + try ignore (contains_from empty 4 (BatUChar.of_char 't')); false with Out_of_bounds -> true + try ignore (contains_from (of_string "") 4 (BatUChar.of_char 't')); false with Out_of_bounds -> true + contains_from (of_string "batteries") 4 (BatUChar.of_char 't') = false + contains_from (of_string "batteries") 3 (BatUChar.of_char 't') = true + contains_from (of_string "batteries") 2 (BatUChar.of_char 't') = true + contains_from (of_string "batteries") 1 (BatUChar.of_char 't') = true + contains_from (of_string "batteries") 4 (BatUChar.of_char 'y') = false +*) -let rcontains_from = contains_from +let rcontains_from r stop char = + Return.with_label (fun label -> + let contains_aux c = if c = char then Return.return label true in + range_iter contains_aux 0 (stop + 1) r; + false) +(*$T rcontains_from + try ignore (rcontains_from empty 4 (BatUChar.of_char 't')); false with Out_of_bounds -> true + try ignore (rcontains_from (of_string "") 4 (BatUChar.of_char 't')); false with Out_of_bounds -> true + rcontains_from (of_string "batteries") 4 (BatUChar.of_char 't') = true + rcontains_from (of_string "batteries") 3 (BatUChar.of_char 't') = true + rcontains_from (of_string "batteries") 2 (BatUChar.of_char 't') = true + rcontains_from (of_string "batteries") 1 (BatUChar.of_char 't') = false + rcontains_from (of_string "batteries") 4 (BatUChar.of_char 'y') = false +*) let equal r1 r2 = compare r1 r2 = 0 @@ -831,13 +871,12 @@ let fill r start len char = let blit rsrc offsrc rdst offdst len = splice rdst offdst len (sub rsrc offsrc len) - -let list_reduce f = function [] -> invalid_arg "Empty List" - | h::t -> List.fold_left f h t - let concat sep r_list = - if r_list = [] then empty else - list_reduce (fun r1 r2 -> append r1 (append sep r2)) r_list + match r_list with + | [] -> + empty + | h :: t -> + List.fold_left (fun r1 r2 -> append r1 (append sep r2)) h t (**T concat Text.concat (Text.of_string "xyz") [] = Text.empty @@ -878,7 +917,7 @@ let rsplit (r:t) sep = avoid a call to [List.rev]. *) let nsplit str sep = if is_empty str then [] - else if is_empty sep then invalid_arg "nsplit: empty sep not allowed" + else if is_empty sep then invalid_arg "Text.nsplit: empty sep not allowed" else (* str is not empty *) let seplen = length sep in @@ -983,7 +1022,9 @@ let read_char i = else let s = Bytes.create len in Bytes.set s 0 n0; - ignore(really_input i s 1 ( len - 1)); + let n = really_input i s 1 (len - 1) in + assert (n = len - 1); + let s = Bytes.unsafe_to_string s in UTF8.get s 0 diff --git a/src/batText.mli b/src/batText.mli index 2cccedcc1..9cbeecad5 100644 --- a/src/batText.mli +++ b/src/batText.mli @@ -123,7 +123,7 @@ val height : t -> int val balance : t -> t (** [balance r] returns a balanced copy of the [r] rope. Note that ropes are automatically rebalanced when their height exceeds a given threshold, but - [balance] allows to invoke that operation explicity. *) + [balance] allows to invoke that operation explicitly. *) (** {6 Operations } *) @@ -195,10 +195,10 @@ val iteri : ?base:int -> (int -> BatUChar.t -> unit) -> t -> unit to the given function. *) val range_iter : (BatUChar.t -> unit) -> int -> int -> t -> unit -(** [rangeiter f m n r] applies [f] to all the characters whose +(** [range_iter f m n r] applies [f] to all the characters whose indices [k] satisfy [m] <= [k] < [m + n]. It is thus equivalent to [iter f (sub m n r)], but does not - create an intermediary rope. [rangeiter] operates in worst-case + create an intermediary rope. [range_iter] operates in worst-case [O(n + log m)] time, which improves on the [O(n log m)] bound from an explicit loop using [get]. @@ -283,13 +283,13 @@ val contains_from : t -> int -> BatUChar.t -> bool (** [contains_from s start c] tests if character [c] appears in the subrope of [s] starting from [start] to the end of [s]. - @raise Invalid_argument if [start] is not a valid index of [s]. *) + @raise Out_of_bounds if [start] is not a valid index of [s]. *) val rcontains_from : t -> int -> BatUChar.t -> bool (** [rcontains_from s stop c] tests if character [c] appears in the subrope of [s] starting from the beginning - of [s] to index [stop]. - @raise Invalid_argument if [stop] is not a valid index of [s]. *) + of [s] to index [stop] (included). + @raise Out_of_bounds if [stop] is not a valid index of [s]. *) val find : t -> t -> int (** [find s x] returns the starting index of the first occurrence of @@ -430,7 +430,7 @@ val nsplit : t -> t -> t list [nsplit "" _] returns the empty list. If the separator is not found, it returns a list of the rope [s]. - If two occurences of the separator are consecutive (with nothing + If two occurrences of the separator are consecutive (with nothing in between), the empty rope is added in the sequence. For example, [nsplit "a//b/" "/"] is ["a"; ""; "b"; ""]. diff --git a/src/batUChar.mli b/src/batUChar.mli index 086122705..8032929ed 100644 --- a/src/batUChar.mli +++ b/src/batUChar.mli @@ -53,7 +53,7 @@ external code : t -> int = "%identity" (** [chr n] returns the Unicode character with the code number [n]. If n does not lay in the valid range of Unicode or designates a - surrogate charactor, raises Out_of_range *) + surrogate character, raises Out_of_range *) val chr : int -> t (** Equality by code point comparison *) diff --git a/src/batUnit.ml b/src/batUnit.ml index bc1cb389e..1a6e4da2b 100644 --- a/src/batUnit.ml +++ b/src/batUnit.ml @@ -18,18 +18,14 @@ * Foundation, Inc. *) -(*BISECT-IGNORE-BEGIN*) - let unit_string = "()" type t = unit let string_of () = unit_string let of_string = function | "()" -> () - | _ -> raise (Invalid_argument "unit_of_string") + | _ -> invalid_arg "Unit.of_string" let compare () () = 0 let ord () () = BatOrd.Eq let equal () () = true let print out () = BatInnerIO.nwrite out unit_string - - (*BISECT-IGNORE-END*) diff --git a/src/batUnix.mliv b/src/batUnix.mliv index d035f478b..4e7dd990e 100644 --- a/src/batUnix.mliv +++ b/src/batUnix.mliv @@ -137,11 +137,34 @@ val environment : unit -> string array (** Return the process environment, as an array of strings with the format ``variable=value''. *) +##V>=4.6##val unsafe_environment : unit -> string array +##V>=4.6##(** Return the process environment, as an array of strings with the +##V>=4.6## format ``variable=value''. Unlike {!environment}, this function +##V>=4.6## returns a populated array even if the process has special +##V>=4.6## privileges. See the documentation for {!unsafe_getenv} for more +##V>=4.6## details. +##V>=4.6## +##V>=4.6## @since 2.8.0 and OCaml 4.06.0 *) + val getenv : string -> string (** Return the value associated to a variable in the process environment. @raise Not_found if the variable is unbound. (This function is identical to {!Sys.getenv}.) *) +##V>=4.6##val unsafe_getenv : string -> string +##V>=4.6##(** Return the value associated to a variable in the process +##V>=4.6## environment. +##V>=4.6## +##V>=4.6## Unlike {!getenv}, this function returns the value even if the +##V>=4.6## process has special privileges. It is considered unsafe because the +##V>=4.6## programmer of a setuid or setgid program must be careful to avoid +##V>=4.6## using maliciously crafted environment variables in the search path +##V>=4.6## for executables, the locations for temporary files or logs, and the +##V>=4.6## like. +##V>=4.6## +##V>=4.6## @raise Not_found if the variable is unbound. +##V>=4.6## @since 2.8.0 and 4.06.0 *) + val putenv : string -> string -> unit (** [Unix.putenv name value] sets the value associated to a variable in the process environment. @@ -272,6 +295,7 @@ type open_flag = Unix.open_flag = ##V>=4.1## descriptor returned by {!openfile} ##V>=4.1## ##V>=4.1## Since OCaml 4.1 *) +##V>=4.5## | O_KEEPEXEC (** The flags to {!Unix.openfile}. *) @@ -287,6 +311,9 @@ val openfile : string -> open_flag list -> file_perm -> file_descr val close : file_descr -> unit (** Close a file descriptor. *) +##V>=4.08##val fsync : file_descr -> unit +##V>=4.08##(** Flush file buffers to disk. *) + val read : file_descr -> Bytes.t -> int -> int -> int (** [read fd buff ofs len] reads [len] characters from descriptor [fd], storing them in string [buff], starting at position [ofs] @@ -497,6 +524,63 @@ end whose sizes are greater than [max_int]. *) +##V>=4.6##(** {6 Mapping files into memory} *) +##V>=4.6## +##V=4.6##val map_file : +##V=4.6## file_descr -> ?pos:int64 -> ('a, 'b) CamlinternalBigarray.kind -> +##V=4.6## 'c CamlinternalBigarray.layout -> bool -> int array -> +##V=4.6## ('a, 'b, 'c) CamlinternalBigarray.genarray +##V>4.6##val map_file : +##V>4.6## file_descr -> ?pos:int64 -> ('a, 'b) Bigarray.kind -> +##V>4.6## 'c Bigarray.layout -> bool -> int array -> +##V>4.6## ('a, 'b, 'c) Bigarray.Genarray.t +##V>=4.6##(** Memory mapping of a file as a big array. +##V>=4.6## [map_file fd kind layout shared dims] +##V>=4.6## returns a big array of kind [kind], layout [layout], +##V>=4.6## and dimensions as specified in [dims]. The data contained in +##V>=4.6## this big array are the contents of the file referred to by +##V>=4.6## the file descriptor [fd] (as opened previously with +##V>=4.6## [Unix.openfile], for example). The optional [pos] parameter +##V>=4.6## is the byte offset in the file of the data being mapped; +##V>=4.6## it defaults to 0 (map from the beginning of the file). +##V>=4.6## +##V>=4.6## If [shared] is [true], all modifications performed on the array +##V>=4.6## are reflected in the file. This requires that [fd] be opened +##V>=4.6## with write permissions. If [shared] is [false], modifications +##V>=4.6## performed on the array are done in memory only, using +##V>=4.6## copy-on-write of the modified pages; the underlying file is not +##V>=4.6## affected. +##V>=4.6## +##V>=4.6## [Genarray.map_file] is much more efficient than reading +##V>=4.6## the whole file in a big array, modifying that big array, +##V>=4.6## and writing it afterwards. +##V>=4.6## +##V>=4.6## To adjust automatically the dimensions of the big array to +##V>=4.6## the actual size of the file, the major dimension (that is, +##V>=4.6## the first dimension for an array with C layout, and the last +##V>=4.6## dimension for an array with Fortran layout) can be given as +##V>=4.6## [-1]. [Genarray.map_file] then determines the major dimension +##V>=4.6## from the size of the file. The file must contain an integral +##V>=4.6## number of sub-arrays as determined by the non-major dimensions, +##V>=4.6## otherwise [Failure] is raised. +##V>=4.6## +##V>=4.6## If all dimensions of the big array are given, the file size is +##V>=4.6## matched against the size of the big array. If the file is larger +##V>=4.6## than the big array, only the initial portion of the file is +##V>=4.6## mapped to the big array. If the file is smaller than the big +##V>=4.6## array, the file is automatically grown to the size of the big array. +##V>=4.6## This requires write permissions on [fd]. +##V>=4.6## +##V>=4.6## Array accesses are bounds-checked, but the bounds are determined by +##V>=4.6## the initial call to [map_file]. Therefore, you should make sure no +##V>=4.6## other process modifies the mapped file while you're accessing it, +##V>=4.6## or a SIGBUS signal may be raised. This happens, for instance, if the +##V>=4.6## file is shrunk. +##V>=4.6## +##V>=4.6## [Invalid_argument] or [Failure] may be raised in cases where argument +##V>=4.6## validation fails. +##V>=4.6## @since 2.8.0 and OCaml 4.06.0 *) + (** {6 Operations on file names} *) @@ -506,9 +590,25 @@ val unlink : string -> unit val rename : string -> string -> unit (** [rename old new] changes the name of a file from [old] to [new]. *) -val link : string -> string -> unit -(** [link source dest] creates a hard link named [dest] to the file - named [source]. *) +##V<4.8##val link : string -> string -> unit +##V<4.8##(** [link source dest] creates a hard link named [dest] to the file +##V<4.8## named [source]. *) +##V>=4.8##val link : ?follow:bool -> string -> string -> unit +##V>=4.8##(** [link ?follow source dest] creates a hard link named [dest] to the file +##V>=4.8## named [source]. +##V>=4.8## +##V>=4.8## @param follow indicates whether a [source] symlink is followed or a +##V>=4.8## hardlink to [source] itself will be created. On {e Unix} systems this is +##V>=4.8## done using the [linkat(2)] function. If [?follow] is not provided, then the +##V>=4.8## [link(2)] function is used whose behaviour is OS-dependent, but more widely +##V>=4.8## available. +##V>=4.8## +##V>=4.8## @param follow is only available since 2.10.0 and OCaml 4.08. +##V>=4.8## +##V>=4.8## @raise ENOSYS On {e Unix} if [~follow:_] is requested, but linkat is +##V>=4.8## unavailable. +##V>=4.8## @raise ENOSYS On {e Windows} if [~follow:false] is requested. *) + (** {6 File permissions and ownership} *) @@ -546,11 +646,15 @@ val access : string -> access_permission list -> unit (** {6 Operations on file descriptors} *) -val dup : file_descr -> file_descr +val dup : +##V>=4.5## ?cloexec:bool -> + file_descr -> file_descr (** Return a new file descriptor referencing the same file as the given descriptor. *) -val dup2 : file_descr -> file_descr -> unit +val dup2 : +##V>=4.5## ?cloexec:bool -> + file_descr -> file_descr -> unit (** [dup2 fd1 fd2] duplicates [fd1] to [fd2], closing [fd2] if already opened. *) @@ -615,7 +719,9 @@ val closedir : dir_handle -> unit (** {6 Pipes and redirections} *) -val pipe : unit -> file_descr * file_descr +val pipe : +##V>=4.5## ?cloexec:bool -> + unit -> file_descr * file_descr (** Create a pipe. The first component of the result is opened for reading, that's the exit to the pipe. The second component is opened for writing, that's the entrance to the pipe. *) @@ -702,6 +808,66 @@ val open_process_full : the process yourself to ensure proper cleanup. *) +##V>=4.08##val open_process_args_in : string -> string array -> in_channel +##V>=4.08##(** High-level pipe and process management. The first argument specifies the +##V>=4.08## command to run, and the second argument specifies the argument array passed +##V>=4.08## to the command. This function runs the command in parallel with the program. +##V>=4.08## The standard output of the command is redirected to a pipe, which can be read +##V>=4.08## via the returned input channel. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + +##V>=4.08##val open_process_args_out : string -> string array -> out_channel +##V>=4.08##(** Same as {!Unix.open_process_args_in}, but redirect the standard input of the +##V>=4.08## command to a pipe. Data written to the returned output channel is sent to +##V>=4.08## the standard input of the command. Warning: writes on output channels are +##V>=4.08## buffered, hence be careful to call {!Stdlib.flush} at the right times to +##V>=4.08## ensure correct synchronization. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + +##V>=4.08##val open_process_args : string -> string array -> in_channel * out_channel +##V>=4.08##(** Same as {!Unix.open_process_args_out}, but redirects both the standard input +##V>=4.08## and standard output of the command to pipes connected to the two returned +##V>=4.08## channels. The input channel is connected to the output of the command, and +##V>=4.08## the output channel to the input of the command. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + +##V>=4.08##val open_process_args_full : +##V>=4.08## string -> string array -> string array -> +##V>=4.08## in_channel * out_channel * in_channel +##V>=4.08##(** Similar to {!Unix.open_process_args}, but the third argument specifies the +##V>=4.08## environment passed to the command. The result is a triple of channels +##V>=4.08## connected respectively to the standard output, standard input, and standard +##V>=4.08## error of the command. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + +##V>=4.08##val process_in_pid : in_channel -> int +##V>=4.08##(** Return the pid of a process opened via {!Unix.open_process_in} or +##V>=4.08## {!Unix.open_process_args_in}. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + +##V>=4.08##val process_out_pid : out_channel -> int +##V>=4.08##(** Return the pid of a process opened via {!Unix.open_process_out} or +##V>=4.08## {!Unix.open_process_args_out}. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + +##V>=4.08##val process_pid : in_channel * out_channel -> int +##V>=4.08##(** Return the pid of a process opened via {!Unix.open_process} or +##V>=4.08## {!Unix.open_process_args}. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + +##V>=4.08##val process_full_pid : in_channel * out_channel * in_channel -> int +##V>=4.08##(** Return the pid of a process opened via {!Unix.open_process_full} or +##V>=4.08## {!Unix.open_process_args_full}. +##V>=4.08## +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) + val close_process_in : BatInnerIO.input -> process_status (** Close {!type:input} opened by {!Unix.open_process_in}, wait for the associated command to terminate, @@ -1151,7 +1317,9 @@ type sockaddr = Unix.sockaddr = domain; [addr] is the Internet address of the machine, and [port] is the port number. *) -val socket : socket_domain -> socket_type -> int -> file_descr +val socket : +##V>=4.5## ?cloexec:bool -> + socket_domain -> socket_type -> int -> file_descr (** Create a new socket in the given domain, and with the given kind. The third argument is the protocol type; 0 selects the default protocol for that kind of sockets. *) @@ -1160,10 +1328,13 @@ val domain_of_sockaddr: sockaddr -> socket_domain (** Return the socket domain adequate for the given socket address. *) val socketpair : +##V>=4.5## ?cloexec:bool -> socket_domain -> socket_type -> int -> file_descr * file_descr (** Create a pair of unnamed sockets, connected together. *) -val accept : file_descr -> file_descr * sockaddr +val accept : +##V>=4.5## ?cloexec:bool -> + file_descr -> file_descr * sockaddr (** Accept connections on the given socket. The returned descriptor is a socket connected to the client; the returned address is the address of the connecting client. *) diff --git a/src/batUnix.mlv b/src/batUnix.mlv index e122e16fc..19ac50dc4 100644 --- a/src/batUnix.mlv +++ b/src/batUnix.mlv @@ -22,6 +22,9 @@ include Unix +##V<4.8##external link : string -> string -> unit = "unix_link" +##V>=4.8##external link : ?follow:bool -> string -> string -> unit = "unix_link" + ##V<4.2##let write_substring = write ##V<4.2##let single_write_substring = single_write ##V<4.2##let send_substring = send @@ -38,7 +41,7 @@ let run_and_read cmd = begin let was_read = ref (input ic line_buff 0 buff_size) in while !was_read <> 0 do - Buffer.add_substring buff line_buff 0 !was_read; + BatBytesCompat.buffer_add_subbytes buff line_buff 0 !was_read; was_read := input ic line_buff 0 buff_size; done; close_in ic; @@ -115,14 +118,14 @@ let input_of_descr ?autoclose ?cleanup fd = let descr_of_input cin = try descr_of_in_channel (input_get cin) - with Not_found -> raise (Invalid_argument "Unix.descr_of_in_channel") + with Not_found -> invalid_arg "Unix.descr_of_input" let output_of_descr ?cleanup fd = wrap_out ?cleanup (out_channel_of_descr fd) let descr_of_output cout = try descr_of_out_channel (output_get (cast_output cout)) - with Not_found -> raise (Invalid_argument "Unix.descr_of_out_channel") + with Not_found -> invalid_arg "Unix.descr_of_output" let in_channel_of_descr fd = input_of_descr ~autoclose:false ~cleanup:true fd let descr_of_in_channel = descr_of_input @@ -191,7 +194,7 @@ let close_process_full (cin, cout, cin2) = let shutdown_connection cin = try shutdown_connection (input_get cin) - with Not_found -> raise (Invalid_argument "Unix.descr_of_in_channel") + with Not_found -> invalid_arg "Unix.shutdown_connection" let open_connection ?autoclose addr = let (cin, cout) = open_connection addr in diff --git a/src/batUref.ml b/src/batUref.ml index cfb887771..a8d0f2103 100644 --- a/src/batUref.ml +++ b/src/batUref.ml @@ -39,13 +39,13 @@ let uref x = ref (Ranked (x, 0)) let uget ur = match !(find ur) with - | Ptr _ -> assert false (*BISECT-VISIT*) + | Ptr _ -> assert false | Ranked (x, _) -> x let uset ur x = let ur = find ur in match !ur with - | Ptr _ -> assert false (*BISECT-VISIT*) + | Ptr _ -> assert false | Ranked (_, r) -> ur := Ranked (x, r) let equal ur vr = @@ -68,14 +68,14 @@ let unite ?sel ur vr = For example, [unite ~sel:(fun _ _ -> v) r r] would fail to set the content of [r] to [v] otherwise. *) match !ur with - | Ptr _ -> assert false (*BISECT-VISIT*) + | Ptr _ -> assert false | Ranked (x, r) -> let x' = sel x x in ur := Ranked(x', r) end else match !ur, !vr with - | _, Ptr _ | Ptr _, _ -> assert false (*BISECT-VISIT*) + | _, Ptr _ | Ptr _, _ -> assert false | Ranked (x, xr), Ranked (y, yr) -> let z = match sel with | None -> x (* in the default case, pick x *) @@ -93,7 +93,7 @@ let unite ?sel ur vr = let print elepr out ur = match !(find ur) with - | Ptr _ -> assert false (*BISECT-VISIT*) + | Ptr _ -> assert false | Ranked (x, _) -> BatInnerIO.nwrite out "uref " ; elepr out x diff --git a/src/batVect.ml b/src/batVect.ml index b1e272ec8..1ab88f556 100644 --- a/src/batVect.ml +++ b/src/batVect.ml @@ -32,7 +32,7 @@ module STRING : sig val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b val append : 'a t -> 'a t -> 'a t val concat : 'a t list -> 'a t -end = struct include Array include BatArray end +end = BatArray type 'a t = | Empty @@ -179,7 +179,7 @@ let bal_if_needed l r = if height r < max_height then r else balance r let concat_str l = function - | Empty | Concat _ -> assert false (*BISECT-VISIT*) + | Empty | Concat _ -> assert false | Leaf rs as r -> let lenr = STRING.length rs in match l with @@ -318,9 +318,31 @@ let sub v s l = sub s l v let insert start rope r = concat (concat (sub r 0 start) rope) (sub r start (length r - start)) +(*$T insert +(of_list [0;1;2;3] |> insert 0 (singleton 10) |> to_list) = [10;0;1;2;3] +(of_list [0;1;2;3] |> insert 1 (singleton 10) |> to_list) = [0;10;1;2;3] +(of_list [0;1;2;3] |> insert 2 (singleton 10) |> to_list) = [0;1;10;2;3] +(of_list [0;1;2;3] |> insert 3 (singleton 10) |> to_list) = [0;1;2;10;3] +(of_list [0;1;2;3] |> insert 4 (singleton 10) |> to_list) = [0;1;2;3;10] +try of_list [0;1;2;3] |> insert (-1) (singleton 10) |> to_list |> ignore; false; with _ -> true +try of_list [0;1;2;3] |> insert 5 (singleton 10) |> to_list |> ignore; false; with _ -> true +(of_list [] |> insert 0 (singleton 1) |> to_list) = [1] +(of_list [0] |> insert 0 (singleton 1) |> to_list) = [1; 0] +(of_list [0] |> insert 1 (singleton 1) |> to_list) = [0; 1] +*) + let remove start len r = concat (sub r 0 start) (sub r (start + len) (length r - start - len)) +(*$Q remove +(Q.pair (Q.pair Q.small_int Q.small_int) (Q.small_int)) \ +(fun ((n1, n2), lr) -> \ + let init len = of_list (BatList.init len (fun i -> i)) in \ + let n, lu = min n1 n2, max n1 n2 in \ + let u, r = init lu, init lr in \ + equal (=) u (u |> insert n r |> remove n (length r))) +*) + let to_string r = let rec strings l = function | Empty -> l @@ -486,35 +508,68 @@ let mapi f v = let off = ref 0 in map (fun x -> f (BatRef.post_incr off) x) v -let exists f v = - BatReturn.label (fun label -> - let rec aux = function - | Empty -> () - | Leaf a -> if BatArray.exists f a then BatReturn.return label true else () - | Concat (l, _, r, _, _) -> aux l; aux r in - aux v; - false - ) - -let for_all f v = - BatReturn.label (fun label -> - let rec aux = function - | Empty -> () - | Leaf a -> if not (BatArray.for_all f a) then BatReturn.return label false else () - | Concat (l, _, r, _, _) -> aux l; aux r in - aux v; - true - ) +let rec exists f = function + | Empty -> false + | Leaf a -> BatArray.exists f a + | Concat (l, _, r, _, _) -> exists f l || exists f r + +(*$T exists + exists (fun x -> x = 2) empty = false + exists (fun x -> x = 2) (singleton 2) = true + exists (fun x -> x = 2) (singleton 3) = false + exists (fun x -> x = 2) (of_array [|1; 3|]) = false + exists (fun x -> x = 2) (of_array [|2; 3|]) = true + exists (fun x -> x = 2) (concat (singleton 1) (singleton 3)) = false + exists (fun x -> x = 2) (concat (singleton 1) (of_array [|2|])) = true + exists (fun x -> x = 2) (concat (singleton 2) (singleton 3)) = true +*) +(*$Q exists + (Q.list Q.small_int) (fun li -> let p i = (i mod 4 = 0) in List.exists p li = exists p (of_list li)) +*) + +let rec for_all f = function + | Empty -> true + | Leaf a -> BatArray.for_all f a + | Concat (l, _, r, _, _) -> for_all f l && for_all f r +(*$T for_all + for_all (fun x -> x = 2) empty = true + for_all (fun x -> x = 2) (singleton 2) = true + for_all (fun x -> x = 2) (singleton 3) = false + for_all (fun x -> x = 2) (of_array [|2; 3|]) = false + for_all (fun x -> x = 2) (of_array [|2; 2|]) = true + for_all (fun x -> x = 2) (concat (singleton 1) (singleton 2)) = false + for_all (fun x -> x = 2) (concat (singleton 2) (of_array [|2|])) = true + for_all (fun x -> x = 2) (concat (singleton 2) (singleton 3)) = false +*) +(*$Q for_all + (Q.list Q.small_int) (fun li -> let p i = (i mod 4 > 0) in List.for_all p li = for_all p (of_list li)) +*) + +let rec find_opt f = function + | Empty -> None + | Leaf a -> BatArray.Exceptionless.find f a + | Concat (l, _, r, _, _) -> + begin match find_opt f l with + | Some _ as result -> result + | None -> find_opt f r + end +(*$T find_opt + [0;1;2;3] |> of_list |> find_opt ((=) 2) = Some 2 + [0;1;2;3] |> of_list |> find_opt ((=) 4) = None + [] |> of_list |> find_opt ((=) 2) = None + concat (of_list [0; 1]) (of_list ([2; 3])) |> find_opt (fun n -> n > 0) = Some 1 +*) let find f v = - BatReturn.label (fun label -> - let rec aux = function - | Empty -> () - | Leaf a -> (try BatReturn.return label (BatArray.find f a) with Not_found -> ()) - | Concat (l, _, r, _, _) -> aux l; aux r in - aux v; - raise Not_found - ) + match find_opt f v with + | None -> raise Not_found + | Some x -> x +(*$T find + [0;1;2;3] |> of_list |> find ((=) 2) = 2 + try [0;1;2;3] |> of_list |> find ((=) 4) |> ignore; false with Not_found -> true + try [] |> of_list |> find ((=) 2) |> ignore; false with Not_found -> true + concat (of_list [0; 1]) (of_list ([2; 3])) |> find (fun n -> n > 0) = 1 +*) let findi f v = let off = ref (-1) in @@ -567,7 +622,7 @@ let destructive_set v i x = let of_list l = of_array (Array.of_list l) let init n f = - if n < 0 || n > max_length then raise (Invalid_argument "Vect.init"); + if n < 0 || n > max_length then invalid_arg "Vect.init"; (* Create as many arrays as we need to store all the data *) let rec aux off acc = if off >= n then acc @@ -592,6 +647,39 @@ let ord ord_val v1 v2 = let cmp_val = BatOrd.comp ord_val in BatOrd.ord0 (BatEnum.compare cmp_val (enum v1) (enum v2)) +module Labels = +struct + let init n ~f = init n f + let get v ~n = get v n + let at v ~n = at v n + let set v ~n ~elem = set v n elem + let modify v ~n ~f = modify v n f + let sub v ~m ~n = sub v m n + let insert ~n ~sub = insert n sub + let remove ~m ~n = remove m n + let iter ~f = iter f + let iteri ~f = iteri f + let map ~f = map f + let mapi ~f = mapi f + let for_all ~f = for_all f + let exists ~f = exists f + let find ~f = find f + let mem ~elem = mem elem + let memq ~elem = memq elem + let findi ~f = findi f + let filter ~f = filter f + let filter_map ~f = filter_map f + let find_all ~f = find_all f + let partition ~f = partition f + let destructive_set v ~n ~elem = destructive_set v n elem + let rangeiter ~f ~m ~n = rangeiter f m n + let fold_left ~f ~init = fold_left f init + let fold ~f ~init = fold f init + let reduce ~f = reduce f + let fold_right ~f v ~init = fold_right f v init + let foldi ~f ~init = foldi f init +end + (* Functorial interface *) module type RANDOMACCESS = @@ -624,6 +712,15 @@ module Make(RANDOMACCESS : RANDOMACCESS) end)= struct module STRING = RANDOMACCESS + (*$inject module Test_functor = struct + module STRING = struct + include BatArray + let empty = [||] + end + module PARAM = struct let max_height = 256 let leaf_size = 256 end + module Instance = Make(STRING)(PARAM) + open Instance + *) type 'a t = | Empty @@ -760,7 +857,7 @@ struct if height r < max_height then r else balance r let concat_str l = function - | Empty | Concat _ -> assert false (*BISECT-VISIT*) + | Empty | Concat _ -> assert false | Leaf rs as r -> let lenr = STRING.length rs in match l with @@ -1069,35 +1166,72 @@ struct let off = ref 0 in map (fun x -> f (BatRef.post_incr off) x) v - let exists f v = - BatReturn.label (fun label -> - let rec aux = function - | Empty -> () - | Leaf a -> STRING.iter (fun x -> if f x then BatReturn.return label true) a - | Concat (l, _, r, _, _) -> aux l; aux r in - aux v; - false - ) + let rec exists f = function + | Empty -> false + | Leaf a -> + let rec aux f a len i = + (i < len) + && (f (STRING.unsafe_get a i) || aux f a len (i + 1)) in + aux f a (STRING.length a) 0 + | Concat (l, _, r, _, _) -> exists f l || exists f r + + (*$T exists + exists (fun x -> true) empty = false + exists (fun x -> false) (of_array [|0;1;2|]) = false + exists (fun x -> x mod 2 <> 0) (of_array [|0;1;2|]) = true + exists (fun x -> x mod 2 <> 0) (of_array [|0;2|]) = false + *) + + let rec for_all f = function + | Empty -> true + | Leaf a -> + let rec aux f a len i = + (i >= len) + || (f (STRING.unsafe_get a i) && aux f a len (i + 1)) in + aux f a (STRING.length a) 0 + | Concat (l, _, r, _, _) -> for_all f l && for_all f r + + (*$T for_all + for_all (fun x -> true) empty = true + for_all (fun x -> true) (of_array [|0;1;2|]) = true + for_all (fun x -> x mod 2 = 0) (of_array [|0;1;2|]) = false + for_all (fun x -> x mod 2 = 0) (of_array [|0;2|]) = true + *) + + let rec find_opt f = function + | Empty -> None + | Leaf a -> + let rec aux f a len i = + if i >= len then None + else begin + let x = STRING.unsafe_get a i in + if f x then Some x + else aux f a len (i + 1) + end in + aux f a (STRING.length a) 0 + | Concat (l, _, r, _, _) -> + begin match find_opt f l with + | Some _ as res -> res + | None -> find_opt f r + end - let for_all f v = - BatReturn.label (fun label -> - let rec aux = function - | Empty -> () - | Leaf a -> STRING.iter (fun x -> if not (f x) then BatReturn.return label false) a - | Concat (l, _, r, _, _) -> aux l; aux r in - aux v; - true - ) + (*$T find_opt + find_opt (fun x -> true) empty = None + find_opt (fun x -> true) (of_array [|0;1;2|]) = Some 0 + find_opt (fun x -> x mod 2 <> 0) (of_array [|0;1;2|]) = Some 1 + find_opt (fun x -> x mod 2 <> 0) (of_array [|0;2|]) = None + *) - let find f v = - BatReturn.label (fun label -> - let rec aux = function - | Empty -> () - | Leaf a -> STRING.iter (fun x -> if (f x) then BatReturn.return label x) a - | Concat (l, _, r, _, _) -> aux l; aux r in - aux v; - raise Not_found - ) + let find f v = match find_opt f v with + | None -> raise Not_found + | Some a -> a + + (*$T find + try ignore (find (fun x -> true) empty); false with Not_found -> true + find (fun x -> true) (of_array [|0;1;2|]) = 0 + find (fun x -> x mod 2 <> 0) (of_array [|0;1;2|]) = 1 + try ignore (find (fun x -> x mod 2 <> 0) (of_array [|0;2|])); false with Not_found -> true + *) let findi f v = let off = ref (-1) in @@ -1150,7 +1284,7 @@ struct let of_list l = of_array (Array.of_list l) let init n f = - if n < 0 || n > max_length then raise (Invalid_argument "Vect.init"); + if n < 0 || n > max_length then invalid_arg "Vect.init"; (* Create as many arrays as we need to store all the data *) let rec aux off acc = if off >= n then acc @@ -1165,4 +1299,38 @@ struct let print ?(first="[|") ?(last="|]") ?(sep="; ") print_a out t = BatEnum.print ~first ~last ~sep print_a out (enum t) + module Labels = + struct + let init n ~f = init n f + let get v ~n = get v n + let at v ~n = at v n + let set v ~n ~elem = set v n elem + let modify v ~n ~f = modify v n f + let sub v ~m ~n = sub v m n + let insert ~n ~sub = insert n sub + let remove ~m ~n = remove m n + let iter ~f = iter f + let iteri ~f = iteri f + let map ~f = map f + let mapi ~f = mapi f + let for_all ~f = for_all f + let exists ~f = exists f + let find ~f = find f + let mem ~elem = mem elem + let memq ~elem = memq elem + let findi ~f = findi f + let filter ~f = filter f + let filter_map ~f = filter_map f + let find_all ~f = find_all f + let partition ~f = partition f + let destructive_set v ~n ~elem = destructive_set v n elem + let rangeiter ~f ~m ~n = rangeiter f m n + let fold_left ~f ~init = fold_left f init + let fold ~f ~init = fold f init + let reduce ~f = reduce f + let fold_right ~f v ~init = fold_right f v init + let foldi ~f ~init = foldi f init + end + +(*$inject end *) end diff --git a/src/batVect.mli b/src/batVect.mli index 043b65f8e..f7d522d17 100644 --- a/src/batVect.mli +++ b/src/batVect.mli @@ -121,7 +121,7 @@ val length : 'a t -> int val balance : 'a t -> 'a t (** [balance r] returns a balanced copy of the [r] vect. Note that vects are automatically rebalanced when their height exceeds a given threshold, but - [balance] allows to invoke that operation explicity. *) + [balance] allows to invoke that operation explicitly. *) val concat : 'a t -> 'a t -> 'a t (** [concat r u] concatenates the [r] and [u] vects. In general, it operates @@ -157,8 +157,8 @@ val modify : 'a t -> int -> ('a -> 'a) -> 'a t val destructive_set : 'a t -> int -> 'a -> unit -(** [destructive_set n e v] sets the element of index [n] in the [v] vect - to [e]. {b This operation is destructive}, and will also affect vects +(** [destructive_set v n c] sets the element of index [n] in the [v] vect + to [c]. {b This operation is destructive}, and will also affect vects sharing the modified leaf with [v]. Use with caution. *) val sub : 'a t -> int -> int -> 'a t @@ -169,9 +169,9 @@ val sub : 'a t -> int -> int -> 'a t val insert : int -> 'a t -> 'a t -> 'a t (** [insert n r u] returns a copy of the [u] vect where [r] has been - inserted between the elements with index [n] and [n + 1] in the - original vect. The length of the new vect is - [length u + length r]. + inserted between the elements with index [n - 1] and [n] in the + original vect; after insertion, the first element of [r] (if any) + is at index [n]. The length of the new vect is [length u + length r]. Operates in amortized [O(log(size r) + log(size u))] time. *) val remove : int -> int -> 'a t -> 'a t @@ -216,18 +216,18 @@ val rangeiter : ('a -> unit) -> int -> int -> 'a t -> unit from an explicit loop using [get]. @raise Out_of_bounds in the same cases as [sub]. *) -val fold_left : ('b -> 'a -> 'b ) -> 'b -> 'a t -> 'b +val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b (** [fold_left f a r] computes [ f (... (f (f a r0) r1)...) rN-1 ] where [rn = Vect.get n r ] and [N = length r]. *) -val fold : ('b -> 'a -> 'b ) -> 'b -> 'a t -> 'b +val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b (** An alias for {!fold_left} *) val reduce : ('a -> 'a -> 'a) -> 'a t -> 'a (** as {!fold_left}, but no initial value - just applies reducing function to elements from left to right. *) -val fold_right : ('a -> 'b -> 'b ) -> 'a t -> 'b -> 'b +val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b (** [fold_right f r a] computes [ f (r0 ... (f rN-2 (f rN-1 a)) ...)) ] where [rn = Vect.get n r ] and [N = length r]. *) @@ -269,32 +269,39 @@ val exists : ('a -> bool) -> 'a t -> bool [ (p a0) || (p a1) || ... || (p an)]. *) val find : ('a -> bool) -> 'a t -> 'a -(** [find p a] returns the first element of vect [a] +(** [find p v] returns the first element of vect [v] that satisfies the predicate [p]. @raise Not_found if there is no value that satisfies [p] in the - vect [a]. *) + vect [v]. *) + +val find_opt : ('a -> bool) -> 'a t -> 'a option +(** [find_opt p v] returns [Some a], where [a] is the first element + of vect [v] that satisfies the predicate [p], or [None] + if no such element exists. + + @since 2.7.0 *) val mem : 'a -> 'a t -> bool -(** [mem m a] is true if and only if [m] is equal to an element of [a]. *) +(** [mem a v] is true if and only if [a] is equal to an element of [v]. *) val memq : 'a -> 'a t -> bool (** Same as {!Vect.mem} but uses physical equality instead of structural equality to compare vect elements. *) val findi : ('a -> bool) -> 'a t -> int -(** [findi p a] returns the index of the first element of vect [a] +(** [findi p v] returns the index of the first element of vect [v] that satisfies the predicate [p]. @raise Not_found if there is no value that satisfies [p] in the - vect [a]. *) + vect [v]. *) val filter : ('a -> bool) -> 'a t -> 'a t -(** [filter f v] returns a vect with the elements [x] from [v] such that - [f x] returns [true]. Operates in [O(n)] time. *) +(** [filter f v] returns a vect with the elements [a] from [v] such that + [f a] returns [true]. Operates in [O(n)] time. *) val filter_map : ('a -> 'b option) -> 'a t -> 'b t -(** [filter_map f e] returns a vect consisting of all elements - [x] such that [f y] returns [Some x] , where [y] is an element - of [e]. *) +(** [filter_map f v] returns a vect consisting of all elements + [b] such that [f a] returns [Some b] , where [a] is an element + of [v]. *) val find_all : ('a -> bool) -> 'a t -> 'a t (** [find_all] is another name for {!Vect.filter}. *) @@ -328,6 +335,48 @@ val ord : 'a BatOrd.ord -> 'a t BatOrd.ord val invariants : _ t -> unit (**/**) +(** {6 Override modules}*) + +(** Operations on {!BatVect} with labels. + + This module overrides a number of functions of {!BatVect} by + functions in which some arguments require labels. These labels are + there to improve readability and safety and to let you change the + order of arguments to functions. In every case, the behavior of the + function is identical to that of the corresponding function of {!BatVect}. +*) +module Labels : sig + val init : int -> f:(int -> 'a) -> 'a t + val get : 'a t -> n:int -> 'a + val at : 'a t -> n:int -> 'a + val set : 'a t -> n:int -> elem:'a -> 'a t + val modify : 'a t -> n:int -> f:('a -> 'a) -> 'a t + val destructive_set : 'a t -> n:int -> elem:'a -> unit + val sub : 'a t -> m:int -> n:int -> 'a t + val insert : n:int -> sub:'a t -> 'a t -> 'a t + val remove : m:int -> n:int -> 'a t -> 'a t + val iter : f:('a -> unit) -> 'a t -> unit + val iteri : f:(int -> 'a -> unit) -> 'a t -> unit + val rangeiter : f:('a -> unit) -> m:int -> n:int -> 'a t -> unit + val fold_left : f:('b -> 'a -> 'b) -> init:'b -> 'a t -> 'b + val fold : f:('b -> 'a -> 'b) -> init:'b -> 'a t -> 'b + val reduce : f:('a -> 'a -> 'a) -> 'a t -> 'a + val fold_right : f:('a -> 'b -> 'b) -> 'a t -> init:'b -> 'b + val foldi : f:(int -> 'b -> 'a -> 'b) -> init:'b -> 'a t -> 'b + val map : f:('a -> 'b) -> 'a t -> 'b t + val mapi : f:(int -> 'a -> 'b) -> 'a t -> 'b t + val for_all : f:('a -> bool) -> 'a t -> bool + val exists : f:('a -> bool) -> 'a t -> bool + val find : f:('a -> bool) -> 'a t -> 'a + val mem : elem:'a -> 'a t -> bool + val memq : elem:'a -> 'a t -> bool + val findi : f:('a -> bool) -> 'a t -> int + val filter : f:('a -> bool) -> 'a t -> 'a t + val filter_map : f:('a -> 'b option) -> 'a t -> 'b t + val find_all : f:('a -> bool) -> 'a t -> 'a t + val partition : f:('a -> bool) -> 'a t -> 'a t * 'a t +end + (** {6 Functorial interface} *) module type RANDOMACCESS = @@ -426,7 +475,7 @@ val length : 'a t -> int val balance : 'a t -> 'a t (** [balance r] returns a balanced copy of the [r] vect. Note that vects are automatically rebalanced when their height exceeds a given threshold, but - [balance] allows to invoke that operation explicity. *) + [balance] allows to invoke that operation explicitly. *) val concat : 'a t -> 'a t -> 'a t (** [concat r u] concatenates the [r] and [u] vects. In general, it operates @@ -462,12 +511,12 @@ val modify : 'a t -> int -> ('a -> 'a) -> 'a t val destructive_set : 'a t -> int -> 'a -> unit -(** [destructive_set n e v] sets the element of index [n] in the [v] vect - to [e]. {b This operation is destructive}, and will also affect vects +(** [destructive_set v n c] sets the element of index [n] in the [v] vect + to [c]. {b This operation is destructive}, and will also affect vects sharing the modified leaf with [v]. Use with caution. *) val sub : 'a t -> int -> int -> 'a t -(** [sub m n r] returns a sub-vect of [r] containing all the elements +(** [sub r m n] returns a sub-vect of [r] containing all the elements whose indexes range from [m] to [m + n - 1] (included). @raise Out_of_bounds in the same cases as Array.sub. Operates in worst-case [O(log size)] time. *) @@ -579,6 +628,14 @@ val find : ('a -> bool) -> 'a t -> 'a @raise Not_found if there is no value that satisfies [p] in the vect [a]. *) +val find_opt : ('a -> bool) -> 'a t -> 'a option +(** [find_opt p a] returns [Some x], where [x] is the first element + of vect [a] that satisfies the predicate [p], or [None] + if no such element exists. + + @since 2.7.0 +*) + val mem : 'a -> 'a t -> bool (** [mem m a] is true if and only if [m] is equal to an element of [a]. *) @@ -623,6 +680,48 @@ val pop : 'a t -> 'a * 'a t (** {6 Boilerplate code}*) +(** {6 Override modules}*) + + (** Operations on {!BatVect} with labels. + + This module overrides a number of functions of {!BatVect} by + functions in which some arguments require labels. These labels are + there to improve readability and safety and to let you change the + order of arguments to functions. In every case, the behavior of the + function is identical to that of the corresponding function of {!BatVect}. + *) + module Labels : sig + val init : int -> f:(int -> 'a) -> 'a t + val get : 'a t -> n:int -> 'a + val at : 'a t -> n:int -> 'a + val set : 'a t -> n:int -> elem:'a -> 'a t + val modify : 'a t -> n:int -> f:('a -> 'a) -> 'a t + val destructive_set : 'a t -> n:int -> elem:'a -> unit + val sub : 'a t -> m:int -> n:int -> 'a t + val insert : n:int -> sub:'a t -> 'a t -> 'a t + val remove : m:int -> n:int -> 'a t -> 'a t + val iter : f:('a -> unit) -> 'a t -> unit + val iteri : f:(int -> 'a -> unit) -> 'a t -> unit + val rangeiter : f:('a -> unit) -> m:int -> n:int -> 'a t -> unit + val fold_left : f:('b -> 'a -> 'b) -> init:'b -> 'a t -> 'b + val fold : f:('b -> 'a -> 'b) -> init:'b -> 'a t -> 'b + val reduce : f:('a -> 'a -> 'a) -> 'a t -> 'a + val fold_right : f:('a -> 'b -> 'b) -> 'a t -> init:'b -> 'b + val foldi : f:(int -> 'b -> 'a -> 'b) -> init:'b -> 'a t -> 'b + val map : f:('a -> 'b) -> 'a t -> 'b t + val mapi : f:(int -> 'a -> 'b) -> 'a t -> 'b t + val for_all : f:('a -> bool) -> 'a t -> bool + val exists : f:('a -> bool) -> 'a t -> bool + val find : f:('a -> bool) -> 'a t -> 'a + val mem : elem:'a -> 'a t -> bool + val memq : elem:'a -> 'a t -> bool + val findi : f:('a -> bool) -> 'a t -> int + val filter : f:('a -> bool) -> 'a t -> 'a t + val filter_map : f:('a -> 'b option) -> 'a t -> 'b t + val find_all : f:('a -> bool) -> 'a t -> 'a t + val partition : f:('a -> bool) -> 'a t -> 'a t * 'a t + end + (** {7 Printing}*) val print : ?first:string -> ?last:string -> ?sep:string -> ('a BatInnerIO.output -> 'b -> unit) -> 'a BatInnerIO.output -> 'b t -> unit diff --git a/src/batteries.mllib b/src/batteries.mllib index 144d84cb7..8c1c6e377 100644 --- a/src/batteries.mllib +++ b/src/batteries.mllib @@ -1,16 +1,19 @@ BatInnerPervasives + BatInnerShuffle BatArray BatBigarray BatBig_int BatBool BatBounded BatBuffer + BatBytesCompat BatBytes BatChar BatComplex BatDeque BatDigest BatEnum + BatFilename BatFingerTree BatFloat BatFormat @@ -30,7 +33,6 @@ BatInnerPervasives BatMarshal BatNativeint BatNum - BatOo BatPervasives BatPrintexc BatPrintf diff --git a/src/batteries.mlv b/src/batteries.mlv index e4c6e6993..37e804185 100644 --- a/src/batteries.mlv +++ b/src/batteries.mlv @@ -47,6 +47,7 @@ module Legacy = struct module Big_int = Big_int module Bigarray = Bigarray module Str = Str +##V>=4.8## module Result = Result end (* stdlib modules *) @@ -82,7 +83,6 @@ module Map = BatMap module Marshal = BatMarshal (* MoreLabels *) module Nativeint = BatNativeint -module Oo = BatOo (* Parsing *) module Printexc = BatPrintexc module Printf = BatPrintf (* UNTESTED FOR BACKWARDS COMPATIBILITY *) @@ -162,6 +162,7 @@ module Int = BatInt module Bool = BatBool module Unit = BatUnit (*module Int63 = BatInt63*) +module Filename = BatFilename (* Modules in-progress, API stability not guaranteed *) module Incubator = struct diff --git a/src/batteriesExceptionless.ml b/src/batteriesExceptionless.ml index 29c545c48..18765ea77 100644 --- a/src/batteriesExceptionless.ml +++ b/src/batteriesExceptionless.ml @@ -71,13 +71,13 @@ end module String = struct include (BatString : module type of BatString - with module Cap := BatString.Cap + (* with module Cap := BatString.Cap *) ) include BatString.Exceptionless - module Cap = struct - include BatString.Cap - include BatString.Cap.Exceptionless - end + (* module Cap = struct *) + (* include BatString.Cap *) + (* include BatString.Cap.Exceptionless *) + (* end *) end (* Extlib modules not replacing stdlib *) diff --git a/src/batteriesPrint.ml b/src/batteriesPrint.ml index 8cfd5306e..24f396b81 100644 --- a/src/batteriesPrint.ml +++ b/src/batteriesPrint.ml @@ -27,6 +27,7 @@ let print_rope fmt t = let print_ustring fmt t = Format.fprintf fmt "u%S" t +(* let string_of_cap t = BatString.Cap.to_string (BatString.Cap.copy t) let print_string_cap_rw fmt t = @@ -34,20 +35,20 @@ let print_string_cap_rw fmt t = let print_string_cap_ro fmt t = Format.fprintf fmt "ro%S" (string_of_cap t) + *) let string_dynarray = BatIO.to_f_printer (BatDynArray.print BatString.print) let int_dynarray = BatIO.to_f_printer (BatDynArray.print BatInt.print) let char_dynarray = BatIO.to_f_printer (BatDynArray.print BatChar.print) let float_dynarray = BatIO.to_f_printer (BatDynArray.print BatFloat.print) -module IntSet = BatSet.Make(BatInt) -let int_set = BatIO.to_f_printer (IntSet.print BatInt.print) -module StringSet = BatSet.Make(String) -let string_set = BatIO.to_f_printer (StringSet.print BatString.print) -module TextSet = BatSet.Make(BatText) -let text_set = BatIO.to_f_printer (TextSet.print BatText.print) -(*module CharSet = BatSet.Make(BatChar) - let char_set = BatIO.to_f_printer (CharSet.print BatChar.print) *) +let int_set = BatIO.to_f_printer (BatSet.Int.print BatInt.print) +let int32_set = BatIO.to_f_printer (BatSet.Int32.print BatInt32.print) +let int64_set = BatIO.to_f_printer (BatSet.Int64.print BatInt64.print) +let natint_set = BatIO.to_f_printer (BatSet.Nativeint.print BatNativeint.print) +let float_set = BatIO.to_f_printer (BatSet.Float.print BatFloat.print) +let char_set = BatIO.to_f_printer (BatSet.Char.print BatChar.print) +let string_set = BatIO.to_f_printer (BatSet.String.print BatString.print) let int_pset = BatIO.to_f_printer (BatSet.print BatInt.print) let string_pset = BatIO.to_f_printer (BatSet.print BatString.print) diff --git a/src/extlib.ml b/src/extlib.ml index af83115e6..f6b2d0d86 100644 --- a/src/extlib.ml +++ b/src/extlib.ml @@ -4,13 +4,13 @@ module Dllist = BatDllist module DynArray = BatDynArray module Enum = BatEnum module ExtArray = struct - module Array = struct include Array include BatArray end + module Array = BatArray end module ExtHashtbl = struct module Hashtbl = BatHashtbl end module ExtList = struct - module List = struct include List include BatList end + module List = BatList end module ExtString = struct module String = BatString diff --git a/testsuite/main.ml b/testsuite/main.ml index 8e8481e1d..2e278b567 100644 --- a/testsuite/main.ml +++ b/testsuite/main.ml @@ -1,5 +1,3 @@ -module X = Test_interface - open OUnit let all_tests = diff --git a/testsuite/test_container.ml b/testsuite/test_container.ml index 6008206da..48669a0c6 100644 --- a/testsuite/test_container.ml +++ b/testsuite/test_container.ml @@ -106,7 +106,6 @@ module DllistContainer : Container = struct end module ArrayContainer : Container = struct - include Array include BatArray let map_right = ni2 let iter_right = ni2 diff --git a/testsuite/test_interface.ml b/testsuite/test_interface.ml deleted file mode 100644 index e094d2d52..000000000 --- a/testsuite/test_interface.ml +++ /dev/null @@ -1,50 +0,0 @@ - -(*module X1 : module type of Arg = BatArg REMOVE BATARG? REIMPLEMENT?*) -module X15 : module type of List = BatList -(* -module X2 : module type of Array = BatArray -module X3 : module type of Bigarray = BatBigarray -module X4 : module type of Big_int = BatBig_int - *) -(* module X5 : module type of Buffer = BatBuffer FAIL - channel -> input *) -module X6 : module type of Complex = BatComplex -(* -module X7 : module type of Digest = BatDigest -module X8 : module type of Format = BatFormat - *) -(* module X9 : module type of Gc = BatGc FAIL channel -> output *) -(* -module X10 : module type of Genlex = BatGenlex - *) -(* module X11 : module type of Hashtbl = BatHashtbl FAIL missing fields?*) -module X12 : module type of Int32 = BatInt32 -module X13 : module type of Int64 = BatInt64 -(* -module X14 : module type of Lexing = BatLexing - *) -(* module X16 : module type of Map = BatMap FAIL - missing fields? *) -(* -module X17 : module type of Marshal = BatMarshal - *) -module X18 : module type of Nativeint = BatNativeint -(* -module X19 : module type of Num = BatNum -module X20 : module type of Oo = BatOo -(* PERVASIVES? *) -module X21 : module type of Printexc = BatPrintexc -module X22 : module type of Printf = BatPrintf -module X23 : module type of Queue = BatQueue - *) -module X24 : module type of Random = BatRandom -(* -module X25 : module type of Scanf = BatScanf - *) -(* module X26 : module type of Set = BatSet FAIL - missing fields? *) -(* -module X27 : module type of Stack = BatStack -module X28 : module type of Stream = BatStream -module X29 : module type of String = BatString -module X30 : module type of Str = BatStr -module X31 : module type of Sys = BatSys -(* UNIX? *) - *) diff --git a/testsuite/test_print.ml b/testsuite/test_print.ml index 1a7ea386f..4f8999919 100644 --- a/testsuite/test_print.ml +++ b/testsuite/test_print.ml @@ -3,7 +3,7 @@ open Gc let few_tests = 10 let many_tests= 100000 -(* (*For comparaison, not part of Batteries.*) +(* (*For comparison, not part of Batteries.*) let run_legacy number_of_runs = begin Gc.full_major (); diff --git a/testsuite/test_uref.ml b/testsuite/test_uref.ml index d5d5d8992..a9673db34 100644 --- a/testsuite/test_uref.ml +++ b/testsuite/test_uref.ml @@ -73,7 +73,7 @@ let test_equal () = let test_unite_shuffle () = (* testing the unification in all possible orders of n urefs unfornatunaly, since this is an imperative structure where - you can't undo operations, this is slighlty complicated *) + you can't undo operations, this is slightly complicated *) let pick_one n l f = assert (n <> 0);