From 5e70a0ab91101eed69c8c0b688b13eed069d3fb6 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 2 Feb 2017 17:59:16 +0100 Subject: [PATCH 001/273] fix Bytes and String tests --- src/batBytes.mlv | 14 +++++++------- src/batString.mlv | 14 +++++++------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/batBytes.mlv b/src/batBytes.mlv index 832731549..76698c090 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" + equal ("five" |> of_string |> uppercase_ascii |> to_string) "FIVE" + 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" + equal ("FIVE" |> of_string |> lowercase_ascii |> to_string) "five" + equal ("ÉCOLE" |> of_string |> lowercase_ascii |> to_string) "École" *) ##V<4.3##let map_first_char f s = @@ -67,10 +67,10 @@ include Bytes (*$T capitalize_ascii equal ("five" |> of_string |> capitalize_ascii |> to_string) "Five" - equal ("école" |> of_string |> captialize_ascii |> to_string) "école" + 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" + equal ("Five" |> of_string |> uncapitalize_ascii |> to_string) "five" + equal ("École" |> of_string |> uncapitalize_ascii |> to_string) "École" *) diff --git a/src/batString.mlv b/src/batString.mlv index 44bb91757..8f123d8c3 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -910,13 +910,13 @@ 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 = @@ -930,12 +930,12 @@ let numeric_compare s1 s2 = (*$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 = From 7631922de3506a2ad73fb1c96adafc3f3c640464 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 2 Feb 2017 17:59:31 +0100 Subject: [PATCH 002/273] fix Digest test --- src/batDigest.mlv | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/batDigest.mlv b/src/batDigest.mlv index b9f416a4f..86155358a 100644 --- a/src/batDigest.mlv +++ b/src/batDigest.mlv @@ -98,7 +98,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 "") *) From a8770a5f1e0f0e1c3e328dd55c4bf9c39365d3bd Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 2 Feb 2017 17:59:46 +0100 Subject: [PATCH 003/273] fix List tests --- src/batList.mlv | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/batList.mlv b/src/batList.mlv index 6f5fc7a95..35bd1dd97 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -532,11 +532,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 *) @@ -563,8 +563,8 @@ 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 = From 274b733cd6e2e5984a6394df44288599150b5553 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 2 Feb 2017 18:04:36 +0100 Subject: [PATCH 004/273] fix 'make test' to also work with .mlv files --- Makefile | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index db60710b6..e136559b6 100644 --- a/Makefile +++ b/Makefile @@ -139,11 +139,25 @@ 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/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 +172,9 @@ _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) + qtest -o $@ --shuffle --preamble-file qtest/qtest_preamble.ml \ + extract $(addprefix _build/,$(TESTFILES)) _build/$(QTESTDIR)/all_tests.byte: $(QTESTDIR)/all_tests.ml $(OCAMLBUILD) $(OCAMLBUILDFLAGS) -cflags -warn-error,+26\ From 223a66a3e112b8f3e2a19b6c422eb816b25993c1 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 2 Feb 2017 18:16:27 +0100 Subject: [PATCH 005/273] minor change in the way lexer directives are emitted by the prefilter script The new way to send lexer directives has two nice properties: - there is always a lexer directive at the top of the file, which makes it more clear to human readers that the file was preprocessed - there is one (correct) lexer directive emitted for each omitted line in the output, which means that the lines are always at the same textual position in the preprocessed and postprocessed files --- build/prefilter.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) 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 From a06bf73abeb66cb168c5c8e735bdba883674cb9f Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Fri, 3 Feb 2017 09:32:24 +0100 Subject: [PATCH 006/273] Makefile: run qtest from _build for better file paths --- Makefile | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index e136559b6..f39f4eb09 100644 --- a/Makefile +++ b/Makefile @@ -173,8 +173,9 @@ _build/testsuite/main.native: $(TESTDEPS) $(wildcard testsuite/*.ml) # extract all qtest unit tests into a single ml file $(QTESTDIR)/all_tests.ml: $(TESTABLE) $(OCAMLBUILD) $(OCAMLBUILDFLAGS) $(TESTFILES) - qtest -o $@ --shuffle --preamble-file qtest/qtest_preamble.ml \ - extract $(addprefix _build/,$(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\ From 2677121140e044544795495deca6c505c16ddbe7 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Fri, 3 Feb 2017 10:24:04 +0100 Subject: [PATCH 007/273] add (BatString.chop : ?l:int -> ?r:int -> string -> string) fixes #714 --- ChangeLog | 4 ++++ src/batString.mliv | 16 ++++++++++++++++ src/batString.mlv | 19 +++++++++++++++++++ 3 files changed, 39 insertions(+) diff --git a/ChangeLog b/ChangeLog index 754127f03..f7bfb2414 100644 --- a/ChangeLog +++ b/ChangeLog @@ -22,6 +22,10 @@ Changelog #705 (Ifaz Kabir) +- BatString: add `chop : ?l:int -> ?r:int -> string -> string` + #714, #716 + (Gabriel Scherer, request by François Bérenger) + ## v2.5.3 Batteries 2.5.3 synchronizes library functions with OCaml 4.04+beta2, diff --git a/src/batString.mliv b/src/batString.mliv index 116b97772..85dd77564 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -551,6 +551,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 are 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}). @@ -1032,6 +1046,8 @@ sig val rchop : ?n:int -> [> `Read] t -> _ t + val chop : ?l:int -> ?r:int -> [> `Read] t -> string + val trim : [> `Read] t -> _ t val quote : [> `Read] t -> string diff --git a/src/batString.mlv b/src/batString.mlv index 8f123d8c3..f62777e9e 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -433,6 +433,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 "chop: number of characters to chop on the left is negative"; + if r < 0 then + invalid_arg "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" @@ -1108,6 +1126,7 @@ struct let exists = exists let lchop = lchop let rchop = rchop + let chop = chop let strip = strip let uppercase = uppercase let lowercase = lowercase From 4a90176f5bee2ab3178e133b8dd9185f36f1e21e Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Fri, 3 Feb 2017 08:33:37 -0600 Subject: [PATCH 008/273] tweak doc string --- src/batString.mliv | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/batString.mliv b/src/batString.mliv index 85dd77564..873eb1b04 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -558,7 +558,7 @@ val chop : ?l:int -> ?r:int -> string -> string [chop ~l ~r s] is equivalent to [lchop ~n:l (rchop ~n:r s)]. - @raise Invalid_argument if either [l] or [r] is are less than zero. + @raise Invalid_argument if either [l] or [r] is less than zero. Examples: [String.chop "\"Weeble\"" = "Weeble"] From 6f6a39e122c412625676cd100d4e1fc829b88765 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Tue, 7 Feb 2017 16:02:46 -0600 Subject: [PATCH 009/273] added in-place array shuffle shared by BatArray, BatList and BatRandom heavily inspired by the in-place array shuffle that was found in BatRandom before --- src/batInnerShuffle.ml | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 src/batInnerShuffle.ml diff --git a/src/batInnerShuffle.ml b/src/batInnerShuffle.ml new file mode 100644 index 000000000..6ef9450f2 --- /dev/null +++ b/src/batInnerShuffle.ml @@ -0,0 +1,10 @@ + +let array_shuffle ?state:(s = Random.get_state ()) a = + for n = Array.length a - 1 downto 1 do + let k = Random.State.int s (n + 1) in + if k <> n then + let buf = Array.unsafe_get a n in + Array.unsafe_set a n (Array.unsafe_get a k); + Array.unsafe_set a k buf + done; + a From 2346ca1f31bbaf3f9f36d85b25454914830b6d2f Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Tue, 7 Feb 2017 16:04:50 -0600 Subject: [PATCH 010/273] added Bat{List|Array}.shuffle --- ChangeLog | 4 ++++ src/batArray.mliv | 12 ++++++++++++ src/batArray.mlv | 8 ++++++++ src/batList.mli | 12 ++++++++++++ src/batList.mlv | 9 +++++++++ src/batRandom.ml | 9 +-------- 6 files changed, 46 insertions(+), 8 deletions(-) diff --git a/ChangeLog b/ChangeLog index f7bfb2414..28b02feef 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,10 @@ Changelog ## NEXT_RELEASE (minor release) +- added {BatList|BatArray}.shuffle + #702, #707 + (Francois Berenger, Gabriel Scherer) + - Clarification and improvements to the documentation #682, #685, #693 (Florian Angeletti, Johannes Kloos, Michael Färber) diff --git a/src/batArray.mliv b/src/batArray.mliv index 0d832607c..c89aecdc4 100644 --- a/src/batArray.mliv +++ b/src/batArray.mliv @@ -533,6 +533,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 -> 'a array +(** [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 NEXT_RELEASE +*) + 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 diff --git a/src/batArray.mlv b/src/batArray.mlv index dfdb7e487..01a2b027b 100644 --- a/src/batArray.mlv +++ b/src/batArray.mlv @@ -735,6 +735,14 @@ let ord ord_elt a1 a2 = ord BatInt.ord [|1;1;1|] [|1;1;1|] = BatOrd.Eq *) +let shuffle ?state:(s = Random.get_state ()) a = + BatInnerShuffle.array_shuffle ~state:s a +(*$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 Incubator = struct module Eq (T : BatOrd.Eq) = struct type t = T.t array diff --git a/src/batList.mli b/src/batList.mli index 1d10be905..29579e7d7 100644 --- a/src/batList.mli +++ b/src/batList.mli @@ -98,6 +98,18 @@ val at : 'a list -> int -> 'a 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 NEXT_RELEASE + *) + 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).*) diff --git a/src/batList.mlv b/src/batList.mlv index 35bd1dd97..7eeedd44d 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -1304,6 +1304,15 @@ 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:(s = Random.get_state ()) l = + let a = BatInnerShuffle.array_shuffle ~state:s (Array.of_list l) in + Array.to_list a +(*$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/batRandom.ml b/src/batRandom.ml index 355425640..82194325d 100644 --- a/src/batRandom.ml +++ b/src/batRandom.ml @@ -106,14 +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; - a + BatInnerShuffle.array_shuffle a let get_state = Random.get_state let set_state = Random.set_state From 8e8dc17182b0ef31f7a89f7ecd2112076b7202eb Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Tue, 7 Feb 2017 16:58:49 -0600 Subject: [PATCH 011/273] added BatInnerShuffle into src/batteries.mllib --- src/batteries.mllib | 1 + 1 file changed, 1 insertion(+) diff --git a/src/batteries.mllib b/src/batteries.mllib index 144d84cb7..a59fd1097 100644 --- a/src/batteries.mllib +++ b/src/batteries.mllib @@ -1,4 +1,5 @@ BatInnerPervasives + BatInnerShuffle BatArray BatBigarray BatBig_int From 8ecfd5fda89a5b9563d314755c74bfc34dc6315e Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Fri, 10 Feb 2017 17:24:28 +0100 Subject: [PATCH 012/273] fix the handling of optional random-generator state in BatInnerShuffle The behavior we want for randomness-manipulating function with an optional parameter is that: - if a state is passed, it is used (and mutated) for random generation - if no state is passed, the default/global random state is used (and mutated) for random generation It might seem that a parameter with default value ?(state = Random.get_state ()) would suffice to get this behavior, but in fact Random.get_state () performs a copy of the default/global random state, instead of just returning it, so the default/global state is not mutated by calls to shuffles (they will not be truly random). The current implementation avoids this pitfall by calling the global/default Random.int function directly. --- src/batArray.mlv | 4 ++-- src/batInnerShuffle.ml | 11 +++++++---- src/batList.mlv | 4 ++-- 3 files changed, 11 insertions(+), 8 deletions(-) diff --git a/src/batArray.mlv b/src/batArray.mlv index 01a2b027b..99d0dfeb5 100644 --- a/src/batArray.mlv +++ b/src/batArray.mlv @@ -735,8 +735,8 @@ let ord ord_elt a1 a2 = ord BatInt.ord [|1;1;1|] [|1;1;1|] = BatOrd.Eq *) -let shuffle ?state:(s = Random.get_state ()) a = - BatInnerShuffle.array_shuffle ~state:s a +let shuffle ?state a = + BatInnerShuffle.array_shuffle ?state a (*$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|] diff --git a/src/batInnerShuffle.ml b/src/batInnerShuffle.ml index 6ef9450f2..c513f25c1 100644 --- a/src/batInnerShuffle.ml +++ b/src/batInnerShuffle.ml @@ -1,10 +1,13 @@ - -let array_shuffle ?state:(s = Random.get_state ()) a = +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.State.int s (n + 1) in - if k <> n then + 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; a diff --git a/src/batList.mlv b/src/batList.mlv index 7eeedd44d..6206f9160 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -1304,8 +1304,8 @@ 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:(s = Random.get_state ()) l = - let a = BatInnerShuffle.array_shuffle ~state:s (Array.of_list l) in +let shuffle ?state l = + let a = BatInnerShuffle.array_shuffle ?state (Array.of_list l) in Array.to_list a (*$T shuffle let s = Random.State.make [|11|] in \ From 13800e9d8308121daab311a061d39978d40324f8 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 11 Feb 2017 16:32:27 +0100 Subject: [PATCH 013/273] change the return type of BatArray.shuffle to unit We had shuffle : ?state:Random.State.t -> 'a array -> 'a array but the shuffle was in-place. This is better reflected by the new interface shuffle : ?state:Random.State.t -> 'a array -> unit --- src/batArray.mliv | 2 +- src/batInnerShuffle.ml | 3 +-- src/batList.mlv | 5 +++-- src/batRandom.ml | 3 ++- 4 files changed, 7 insertions(+), 6 deletions(-) diff --git a/src/batArray.mliv b/src/batArray.mliv index c89aecdc4..168af9658 100644 --- a/src/batArray.mliv +++ b/src/batArray.mliv @@ -533,7 +533,7 @@ 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 -> 'a array +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). diff --git a/src/batInnerShuffle.ml b/src/batInnerShuffle.ml index c513f25c1..81704317d 100644 --- a/src/batInnerShuffle.ml +++ b/src/batInnerShuffle.ml @@ -9,5 +9,4 @@ let array_shuffle ?state a = Array.unsafe_set a n (Array.unsafe_get a k); Array.unsafe_set a k buf end - done; - a + done diff --git a/src/batList.mlv b/src/batList.mlv index 6206f9160..94a295c17 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -1305,8 +1305,9 @@ let subset cmp l l' = for_all (fun x -> mem_cmp cmp x l') l *) let shuffle ?state l = - let a = BatInnerShuffle.array_shuffle ?state (Array.of_list l) in - Array.to_list a + 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] diff --git a/src/batRandom.ml b/src/batRandom.ml index 82194325d..11e02fe7e 100644 --- a/src/batRandom.ml +++ b/src/batRandom.ml @@ -106,7 +106,8 @@ let multi_choice n e = let shuffle e = let a = BatArray.of_enum e in - BatInnerShuffle.array_shuffle a + BatInnerShuffle.array_shuffle a; + a let get_state = Random.get_state let set_state = Random.set_state From 91149d90f1a48ed9c0c602f25dd9a4e8d4245d8c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 11 Feb 2017 16:34:54 +0100 Subject: [PATCH 014/273] shuffle: check that shuffles performs a permutation of the original array --- src/batInnerShuffle.ml | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/batInnerShuffle.ml b/src/batInnerShuffle.ml index 81704317d..763f1b648 100644 --- a/src/batInnerShuffle.ml +++ b/src/batInnerShuffle.ml @@ -10,3 +10,11 @@ let array_shuffle ?state a = 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)) +*) From 072d2fe6a96416be799228f51fc4852aa90ea074 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 11 Feb 2017 16:49:54 +0100 Subject: [PATCH 015/273] shuffle: test that all permutations occur --- src/batInnerShuffle.ml | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/batInnerShuffle.ml b/src/batInnerShuffle.ml index 763f1b648..4bcda8672 100644 --- a/src/batInnerShuffle.ml +++ b/src/batInnerShuffle.ml @@ -18,3 +18,17 @@ let array_shuffle ?state 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) +*) From 4e5dbab22175cdf600a4605f28d397d907c4e179 Mon Sep 17 00:00:00 2001 From: Thibault Suzanne Date: Wed, 15 Feb 2017 15:41:46 +0100 Subject: [PATCH 016/273] Make Set.to_array explicitly build the array instead of using Dynarray This breaks the dependency Set -> Dynarray -> Int. A quick benchmark also shows that the new function is approximately twice as fast and can avoid Out_of_memory. --- src/batSet.ml | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/batSet.ml b/src/batSet.ml index 97b62cfab..778ca12df 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. *) @@ -332,9 +332,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 From 2645190576f7d50ed81d070eb550a613f8aae745 Mon Sep 17 00:00:00 2001 From: Thibault Suzanne Date: Wed, 15 Feb 2017 17:05:20 +0100 Subject: [PATCH 017/273] Add Changelog entry --- ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ChangeLog b/ChangeLog index f7bfb2414..7c29b4208 100644 --- a/ChangeLog +++ b/ChangeLog @@ -26,6 +26,11 @@ Changelog #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) + ## v2.5.3 Batteries 2.5.3 synchronizes library functions with OCaml 4.04+beta2, From 6b37625b677536041cfb5eed78d8f37f6a25b8e5 Mon Sep 17 00:00:00 2001 From: Thibault Suzanne Date: Wed, 15 Feb 2017 17:10:10 +0100 Subject: [PATCH 018/273] Fix a whitespace oddity in Changelog --- ChangeLog | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7c29b4208..65ad58246 100644 --- a/ChangeLog +++ b/ChangeLog @@ -114,8 +114,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 From a75d25b187b8c5e111fcaf45b17fd5bd0884e8e6 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Fri, 17 Feb 2017 10:04:14 -0600 Subject: [PATCH 019/273] Hashtbl.{of|to}_list and bindings added BatHashtbl.to_list, of_list and bindings --- ChangeLog | 4 ++++ src/batHashtbl.mli | 17 +++++++++++++++++ src/batHashtbl.mlv | 35 +++++++++++++++++++++++++++++++++++ 3 files changed, 56 insertions(+) diff --git a/ChangeLog b/ChangeLog index 65ad58246..102c3f1ec 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,10 @@ Changelog ## NEXT_RELEASE (minor release) +- BatHashtbl: added {to|of}_list, bindings + #728 + (Francois Berenger, Thibault Suzanne) + - Clarification and improvements to the documentation #682, #685, #693 (Florian Angeletti, Johannes Kloos, Michael Färber) diff --git a/src/batHashtbl.mli b/src/batHashtbl.mli index d3a9118d0..d50f0c1ba 100644 --- a/src/batHashtbl.mli +++ b/src/batHashtbl.mli @@ -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 NEXT_RELEASE *) + +val to_list : ('a, 'b) t -> ('a * 'b) list +(** Return the list of (key,value) pairs. + @since NEXT_RELEASE *) + +val bindings : ('a, 'b) t -> ('a * 'b) list +(** Alias for [to_list]. + @since NEXT_RELEASE *) (**{6 Searching}*) @@ -382,7 +395,9 @@ sig 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) -> @@ -546,6 +561,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}*) diff --git a/src/batHashtbl.mlv b/src/batHashtbl.mlv index ac84cfeec..603a4b263 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) @@ -403,7 +432,9 @@ sig 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) -> @@ -562,10 +593,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) @@ -751,7 +784,9 @@ 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 From ffac0420a5e4b83239c3213547ed711acf0e2621 Mon Sep 17 00:00:00 2001 From: Thibault Suzanne Date: Fri, 17 Feb 2017 21:59:25 +0100 Subject: [PATCH 020/273] ready to use sets and maps Added {BatSet,BatMap}.{Int,Int32,Int64,Nativeint,Float,Char,String} --- ChangeLog | 5 +++++ src/batMap.ml | 25 ++++++++++++++++--------- src/batMap.mli | 10 +++++++++- src/batSet.ml | 16 ++++++++++++---- src/batSet.mli | 12 +++++++++++- 5 files changed, 53 insertions(+), 15 deletions(-) diff --git a/ChangeLog b/ChangeLog index 102c3f1ec..ed5db5e4e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -26,6 +26,11 @@ 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) diff --git a/src/batMap.ml b/src/batMap.ml index bb6411538..aa4cc5744 100644 --- a/src/batMap.ml +++ b/src/batMap.ml @@ -912,6 +912,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 @@ -978,7 +985,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 +994,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 @@ -1097,7 +1104,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 } @@ -1164,8 +1171,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 +1183,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 @@ -1199,10 +1206,10 @@ module PMap = struct (*$< PMap *) 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 }) diff --git a/src/batMap.mli b/src/batMap.mli index 4d3fc259c..08480ccb7 100644 --- a/src/batMap.mli +++ b/src/batMap.mli @@ -363,6 +363,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} @@ -946,4 +955,3 @@ module PMap : sig val get_cmp : ('a, 'b) t -> ('a -> 'a -> int) end (* PMap module *) - diff --git a/src/batSet.ml b/src/batSet.ml index 778ca12df..d77c8fdf5 100644 --- a/src/batSet.ml +++ b/src/batSet.ml @@ -738,6 +738,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) @@ -755,9 +763,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) \ @@ -779,7 +787,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 *) diff --git a/src/batSet.mli b/src/batSet.mli index 0fdcf50c0..4769486cc 100644 --- a/src/batSet.mli +++ b/src/batSet.mli @@ -375,7 +375,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. From 26f4848352bf2fa42ad273513826cd86c8d8aeea Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Fri, 17 Feb 2017 15:12:01 -0600 Subject: [PATCH 021/273] repared tests for BatArray.shuffle --- src/batArray.mlv | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/batArray.mlv b/src/batArray.mlv index 99d0dfeb5..14d113618 100644 --- a/src/batArray.mlv +++ b/src/batArray.mlv @@ -739,8 +739,12 @@ let shuffle ?state a = BatInnerShuffle.array_shuffle ?state a (*$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 [||] = [||] + 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 = [||] *) module Incubator = struct From 01114562c05513e4f7214f14d6458b165dde9df6 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Mon, 20 Feb 2017 14:43:10 -0600 Subject: [PATCH 022/273] added BatMap.find_default --- ChangeLog | 3 +++ src/batMap.ml | 17 +++++++++++++++++ src/batMap.mli | 12 ++++++++++++ src/batSplay.ml | 4 ++++ 4 files changed, 36 insertions(+) diff --git a/ChangeLog b/ChangeLog index 6b00059b0..abb790ff8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,9 @@ Changelog ## NEXT_RELEASE (minor release) +- BatMap: added find_default + Francois Berenger + - BatHashtbl: added {to|of}_list, bindings #728 (Francois Berenger, Thibault Suzanne) diff --git a/src/batMap.ml b/src/batMap.ml index aa4cc5744..629003fd0 100644 --- a/src/batMap.ml +++ b/src/batMap.ml @@ -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, _) -> @@ -721,6 +725,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 @@ -815,6 +820,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) @@ -944,6 +950,9 @@ 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 pop_min_binding (empty |> add 1 true |> pop_min_binding) = ((1, true), empty) (empty |> add 1 true |> add 2 false |> pop_min_binding) = \ @@ -1120,6 +1129,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 @@ -1129,6 +1141,11 @@ 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 diff --git a/src/batMap.mli b/src/batMap.mli index 08480ccb7..bd1803eb1 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. *) @@ -415,6 +419,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. *) @@ -711,6 +719,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. *) diff --git a/src/batSplay.ml b/src/batSplay.ml index 3595d5dae..bed2f8256 100644 --- a/src/batSplay.ml +++ b/src/batSplay.ml @@ -301,6 +301,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 = From 94835257de9c2167e6d96d60e513e6481c29c6ef Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Mon, 20 Feb 2017 17:56:52 -0600 Subject: [PATCH 023/273] added scripts/install_test.sh --- ChangeLog | 3 +++ scripts/install_test.sh | 22 ++++++++++++++++++++++ 2 files changed, 25 insertions(+) create mode 100755 scripts/install_test.sh diff --git a/ChangeLog b/ChangeLog index 6b00059b0..99e6c863c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,9 @@ Changelog ## NEXT_RELEASE (minor release) +- added scripts/install_test.sh + Francois Berenger + - BatHashtbl: added {to|of}_list, bindings #728 (Francois Berenger, Thibault Suzanne) diff --git a/scripts/install_test.sh b/scripts/install_test.sh new file mode 100755 index 000000000..d5dc90a5c --- /dev/null +++ b/scripts/install_test.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 From 3ba8fe2d588cf0a09aea36ec978595bf2fe813a6 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Mon, 20 Feb 2017 18:00:12 -0600 Subject: [PATCH 024/273] added pull request number to ChangeLog --- ChangeLog | 1 + 1 file changed, 1 insertion(+) diff --git a/ChangeLog b/ChangeLog index abb790ff8..0a3eb41f4 100644 --- a/ChangeLog +++ b/ChangeLog @@ -4,6 +4,7 @@ Changelog ## NEXT_RELEASE (minor release) - BatMap: added find_default + #730 Francois Berenger - BatHashtbl: added {to|of}_list, bindings From 7b8eb66a4b09b79a7ed881f1ad9ad66b69aa30a4 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Mon, 20 Feb 2017 18:04:49 -0600 Subject: [PATCH 025/273] two more unit tests for find_default --- src/batMap.ml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/batMap.ml b/src/batMap.ml index 629003fd0..4be4fb397 100644 --- a/src/batMap.ml +++ b/src/batMap.ml @@ -953,6 +953,11 @@ let find x m = Concrete.find x Pervasives.compare m 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) = \ From eff5b090f51804e84604b1f956c05b71019f9325 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Tue, 21 Feb 2017 08:14:30 -0600 Subject: [PATCH 026/273] mv scripts/install_test.sh scripts/test_install.sh --- scripts/{install_test.sh => test_install.sh} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename scripts/{install_test.sh => test_install.sh} (100%) diff --git a/scripts/install_test.sh b/scripts/test_install.sh similarity index 100% rename from scripts/install_test.sh rename to scripts/test_install.sh From 2bca2fd81d9d476f2513825f6392ca2b45557c6b Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Tue, 21 Feb 2017 08:17:31 -0600 Subject: [PATCH 027/273] added phony target test_install --- Makefile | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index f39f4eb09..bf8fa8559 100644 --- a/Makefile +++ b/Makefile @@ -71,7 +71,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 coverage man test_install all: @echo "Build mode:" $(MODE) @@ -98,6 +98,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) From 666259b158d428ac99f5e4b2d12ee0af2a9f2880 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Tue, 21 Feb 2017 08:23:11 -0600 Subject: [PATCH 028/273] added make test_install in howto/release.md --- howto/release.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/howto/release.md b/howto/release.md index 4f3b14c71..34703faf0 100644 --- a/howto/release.md +++ b/howto/release.md @@ -13,6 +13,9 @@ 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' + # Release marking These steps can be redone as many times as necessary, and do not need From eb86d19059584d0ce70251c17f9a53af1b5e8385 Mon Sep 17 00:00:00 2001 From: Thibault Suzanne Date: Fri, 24 Feb 2017 22:34:35 +0100 Subject: [PATCH 029/273] Add List.fold_map --- src/batList.mli | 9 +++++++++ src/batList.mlv | 19 +++++++++++++++++++ 2 files changed, 28 insertions(+) diff --git a/src/batList.mli b/src/batList.mli index 29579e7d7..bbba5dddc 100644 --- a/src/batList.mli +++ b/src/batList.mli @@ -231,6 +231,15 @@ val reduce : ('a -> 'a -> 'a) -> 'a list -> 'a @raise Invalid_argument on empty list. *) +val fold_map : ('a -> 'b -> ('a * 'c)) -> 'a -> 'b list -> 'a * 'c list +(** If [f x] is [(f_fst x, f_snd x)], [fold_map f acc [a0; a1; ...; + an]] returns both [f_fst (... (f_fst (f_fst acc a0) a1) ...) an] + (like [fold_left]) and [[f_snd a0; ...; f_snd an]] (like + [map]). Tail recursive. + + @since NEXT_RELEASE +*) + val max : 'a list -> 'a (** [max l] returns the largest value in [l] as judged by [Pervasives.compare] *) diff --git a/src/batList.mlv b/src/batList.mlv index 94a295c17..8c084dac3 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -891,6 +891,25 @@ let fold_righti f l init = fold_righti (fun i x acc -> (i, x) :: acc) [0.; 1.] [] = [(0, 0.); (1, 1.)] *) +let fold_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_map + fold_map (fun acc x -> assert false) 0 [] = (0, []) + fold_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 From 575b585b8bbe9bc594bd1b4fd2d6c3a655a1e3c9 Mon Sep 17 00:00:00 2001 From: Thibault Suzanne Date: Fri, 24 Feb 2017 22:38:31 +0100 Subject: [PATCH 030/273] Add BatList.fold_map to Changelog --- ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ChangeLog b/ChangeLog index 6b00059b0..b0b59dba1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -44,6 +44,10 @@ Changelog #724 (Thibault Suzanne) +- BatList: add `fold_map` + #734 + (Thibault Suzanne) + ## v2.5.3 Batteries 2.5.3 synchronizes library functions with OCaml 4.04+beta2, From c084822d05a9ecd38fb9e28424732a9f3222c4d6 Mon Sep 17 00:00:00 2001 From: Thibault Suzanne Date: Fri, 24 Feb 2017 23:56:07 +0100 Subject: [PATCH 031/273] Rename BatList.fold_left to fold_left_map, update doc and Changelog --- ChangeLog | 2 +- src/batList.mli | 7 ++----- src/batList.mlv | 8 ++++---- 3 files changed, 7 insertions(+), 10 deletions(-) diff --git a/ChangeLog b/ChangeLog index b0b59dba1..716e4d7b3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -44,7 +44,7 @@ Changelog #724 (Thibault Suzanne) -- BatList: add `fold_map` +- BatList: add `fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list` #734 (Thibault Suzanne) diff --git a/src/batList.mli b/src/batList.mli index bbba5dddc..0bc5db6b2 100644 --- a/src/batList.mli +++ b/src/batList.mli @@ -231,11 +231,8 @@ val reduce : ('a -> 'a -> 'a) -> 'a list -> 'a @raise Invalid_argument on empty list. *) -val fold_map : ('a -> 'b -> ('a * 'c)) -> 'a -> 'b list -> 'a * 'c list -(** If [f x] is [(f_fst x, f_snd x)], [fold_map f acc [a0; a1; ...; - an]] returns both [f_fst (... (f_fst (f_fst acc a0) a1) ...) an] - (like [fold_left]) and [[f_snd a0; ...; f_snd an]] (like - [map]). Tail recursive. +val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list +(** Combines [fold_left] and [map]. Tail-recursive. @since NEXT_RELEASE *) diff --git a/src/batList.mlv b/src/batList.mlv index 8c084dac3..e8f6a6a1a 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -891,7 +891,7 @@ let fold_righti f l init = fold_righti (fun i x acc -> (i, x) :: acc) [0.; 1.] [] = [(0, 0.); (1, 1.)] *) -let fold_map f acc = function +let fold_left_map f acc = function | [] -> acc, [] | h :: t -> let rec loop acc dst = function @@ -905,9 +905,9 @@ let fold_map f acc = function let res = loop acc' r t in res, inj r -(*$T fold_map - fold_map (fun acc x -> assert false) 0 [] = (0, []) - fold_map (fun acc x -> acc ^ x, int_of_string x) "0" ["1"; "2"; "3"] = ("0123", [1; 2; 3]) +(*$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 From c29873ce77c9ed56da59bcfd86168da87c9ad602 Mon Sep 17 00:00:00 2001 From: Thibault Suzanne Date: Sat, 25 Feb 2017 01:03:31 +0100 Subject: [PATCH 032/273] Credit Oscar Gauthier for the feature request of List.fold_left_map --- ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 716e4d7b3..8d27c4922 100644 --- a/ChangeLog +++ b/ChangeLog @@ -46,7 +46,7 @@ Changelog - BatList: add `fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list` #734 - (Thibault Suzanne) + (Thibault Suzanne, feature request by Oscar Gauthier) ## v2.5.3 From ad7b7a9b6be6faa38bccb610d0758db18aaec3ad Mon Sep 17 00:00:00 2001 From: Thibault Suzanne Date: Sat, 25 Feb 2017 19:21:42 +0100 Subject: [PATCH 033/273] Add a formal description of BatList.fold_left_map in the doc --- src/batList.mli | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/batList.mli b/src/batList.mli index 0bc5db6b2..b160af8dd 100644 --- a/src/batList.mli +++ b/src/batList.mli @@ -234,6 +234,15 @@ val reduce : ('a -> 'a -> 'a) -> 'a list -> 'a 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 NEXT_RELEASE *) From 3e8d5feeecc734945ad998ed4355e3b1285a72e4 Mon Sep 17 00:00:00 2001 From: Thibault Suzanne Date: Sat, 25 Feb 2017 19:23:31 +0100 Subject: [PATCH 034/273] Add gasche to BatList.fold_map_left changelog --- ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 8d27c4922..4a05e99fc 100644 --- a/ChangeLog +++ b/ChangeLog @@ -46,7 +46,7 @@ Changelog - BatList: add `fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list` #734 - (Thibault Suzanne, feature request by Oscar Gauthier) + (Thibault Suzanne, review by Gabriel Scherer, request by Oscar Gauthier) ## v2.5.3 From 2e6a9dc343e4b9478aaf57b60fe1c97534c24429 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Thu, 16 Mar 2017 14:07:41 -0500 Subject: [PATCH 035/273] added bin_annot in _tags so that .cmt and .cmti files are compiled --- _tags | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/_tags b/_tags index fbc6e9f73..02dedf6df 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 From d7d1e6bc6008d4a57236088d298dbe9713d1dd78 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Thu, 16 Mar 2017 14:18:04 -0500 Subject: [PATCH 036/273] install .cmt and .cmti files --- ChangeLog | 4 ++++ Makefile | 1 + 2 files changed, 5 insertions(+) diff --git a/ChangeLog b/ChangeLog index 0a3eb41f4..a855d5c89 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,10 @@ Changelog ## NEXT_RELEASE (minor release) +- install .cmt and .cmti files + #740 + (Francois Berenger, Gabriel Scherer) + - BatMap: added find_default #730 Francois Berenger diff --git a/Makefile b/Makefile index f39f4eb09..a42ed837b 100644 --- a/Makefile +++ b/Makefile @@ -35,6 +35,7 @@ endif INSTALL_FILES = _build/META _build/src/*.cma \ battop.ml _build/src/*.cmi _build/src/*.mli \ + _build/src/*.cmti _build/src/*.cmt \ _build/src/batteriesHelp.cmo _build/src/batteriesConfig.cmo _build/src/batteriesPrint.cmo \ ocamlinit build/ocaml OPT_INSTALL_FILES = _build/src/*.cmx _build/src/*.a _build/src/*.cmxa \ From 0fb6ed12e8c5f8cf32903928ff9bc1075d83ad7a Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Thu, 16 Mar 2017 14:33:21 -0500 Subject: [PATCH 037/273] BatteriesConcreteQueue.cmi and cmx were installed capitalized while others are consistently installed uncapitalized --- myocamlbuild.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/myocamlbuild.ml b/myocamlbuild.ml index 702476557..b4fc1be08 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -121,7 +121,7 @@ let _ = dispatch begin function 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. From 1814197ed6db1ccf00d5dec8894c72595268a94f Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 16 Mar 2017 20:51:52 +0100 Subject: [PATCH 038/273] Update release doc (#733) * howto/release: more explanations on the opam metadata * howto/release: remove deprecated forge, emphasize the github release page --- howto/release.md | 57 ++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 53 insertions(+), 4 deletions(-) diff --git a/howto/release.md b/howto/release.md index 4f3b14c71..9d9754b1c 100644 --- a/howto/release.md +++ b/howto/release.md @@ -40,17 +40,66 @@ 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 commited. + +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 + +- once the new opam package is merged, announce on the mailing-list. From 0e4d92ba449dbb1ca2c28fce4c8e24cf4187e1a1 Mon Sep 17 00:00:00 2001 From: Thibault Suzanne Date: Fri, 17 Mar 2017 00:57:30 +0100 Subject: [PATCH 039/273] Improve multiline code in List.fold_left_map doc --- src/batList.mli | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/batList.mli b/src/batList.mli index b160af8dd..c6fa197b8 100644 --- a/src/batList.mli +++ b/src/batList.mli @@ -236,12 +236,14 @@ val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list 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)] + {[ + 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 NEXT_RELEASE *) From 1d880b1f1813486774cd21c8fb3a7ee5005d4961 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Thu, 6 Apr 2017 16:20:39 -0500 Subject: [PATCH 040/273] added BatList.frange --- src/batList.mli | 13 +++++++++++++ src/batList.mlv | 43 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 56 insertions(+) diff --git a/src/batList.mli b/src/batList.mli index c6fa197b8..2f084bb57 100644 --- a/src/batList.mli +++ b/src/batList.mli @@ -147,6 +147,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 NEXT_RELEASE *) + 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)). diff --git a/src/batList.mlv b/src/batList.mlv index e8f6a6a1a..0d472e9d9 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -841,6 +841,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 -> From 4720636ae66a1cbdf9bb75201fef0bb755e3df05 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 6 Apr 2017 18:38:19 -0400 Subject: [PATCH 041/273] ChangeLog update --- ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ChangeLog b/ChangeLog index 3db312daf..0c6062ac8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -58,6 +58,11 @@ Changelog #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, From 96ae5614eb82a7d28d177be82cc47726ea3ee44d Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Fri, 7 Apr 2017 13:45:24 -0500 Subject: [PATCH 042/273] added BatList.favg and faster BatList.fsum (#746) * added BatList.favg and faster BatList.fsum --- ChangeLog | 4 ++++ src/batList.mli | 6 ++++++ src/batList.mlv | 43 ++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 52 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 0c6062ac8..e71e8b139 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,10 @@ Changelog ## NEXT_RELEASE (minor release) +- added BatList.favg and faster BatList.fsum + #746 + (Gabriel Scherer, Francois Berenger) + - install .cmt and .cmti files #740 (Francois Berenger, Gabriel Scherer) diff --git a/src/batList.mli b/src/batList.mli index 2f084bb57..8b3c31d16 100644 --- a/src/batList.mli +++ b/src/batList.mli @@ -279,6 +279,12 @@ val fsum : float list -> float @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 NEXT_RELEASE + *) + val kahan_sum : float list -> float (** [kahan_sum l] returns a numerically-accurate sum of the floats of [l]. See {!BatArray.fsum} for more details. diff --git a/src/batList.mlv b/src/batList.mlv index 0d472e9d9..ca3d9d046 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -1286,7 +1286,48 @@ let reduce f = function [] -> invalid_arg "Empty List" 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 fsum l = + match l with + | [] -> invalid_arg "List.fsum: Empty List" + | 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 +(*$T fsum + try let _ = fsum [] in false with Invalid_argument _ -> true + fsum [1.;2.;3.] = 6. +*) + +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 From 18aaa3780b6d27afb3ab6b95e170aa9b0afbb819 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Tue, 11 Apr 2017 18:12:53 -0500 Subject: [PATCH 043/273] preparatory work for next minor release (v2.6.0) (#747) * preparatory work for next minor release (v2.5.4) * Update setup.ml based on _oasis * next release is 2.6.0, not 2.5.4 since there are new functionalities * updated opam file to the latest in the opam repository * say something about older ocaml version testing in the release howto * removed the upper bound ocaml version limit from the opam file --- ChangeLog | 6 ++++-- _oasis | 2 +- howto/release.md | 5 ++++- setup.ml | 24 +++++++++++++----------- src/batArray.mliv | 2 +- src/batHashtbl.mli | 6 +++--- src/batList.mli | 8 ++++---- src/batResult.mli | 4 ++-- 8 files changed, 32 insertions(+), 25 deletions(-) diff --git a/ChangeLog b/ChangeLog index e71e8b139..87175157e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,7 +1,7 @@ Changelog --------- -## NEXT_RELEASE (minor release) +## v2.6.0 (minor release) - added BatList.favg and faster BatList.fsum #746 @@ -13,9 +13,11 @@ Changelog - BatMap: added find_default #730 + (Francois Berenger) - added scripts/test_install.sh - Francois Berenger + #743 + (Francois Berenger) - BatHashtbl: added {to|of}_list, bindings #728 diff --git a/_oasis b/_oasis index 613f8f23a..afbf2a446 100644 --- a/_oasis +++ b/_oasis @@ -1,7 +1,7 @@ OASISFormat: 0.4 OCamlVersion: >= 3.12.1 Name: batteries -Version: 2.5.3 +Version: 2.6.0 Authors: Batteries Included Team License: LGPL-2.1 with OCaml linking exception LicenseFile: LICENSE diff --git a/howto/release.md b/howto/release.md index 032e318f2..d52a2a6ca 100644 --- a/howto/release.md +++ b/howto/release.md @@ -6,6 +6,9 @@ Make a release - `make test` on a 64 bits machine - `make test` on a 32 bits machine +- `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` @@ -28,7 +31,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 diff --git a/setup.ml b/setup.ml index df2daf7d9..4e2bc2e8a 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: adb4e4363b81cc88c590c82403607f51) *) (* - Regenerated by OASIS v0.4.7 + Regenerated by OASIS v0.4.8 Visit http://oasis.forge.ocamlcore.org for more information and documentation about functions used in this file. *) @@ -658,6 +658,7 @@ module OASISContext = struct ignore_unknown_fields: bool; printf: level -> string -> unit; srcfs: source OASISFileSystem.fs; + load_oasis_plugin: string -> bool; } @@ -682,6 +683,7 @@ module OASISContext = struct ignore_unknown_fields = false; printf = printf; srcfs = new OASISFileSystem.host_fs(Sys.getcwd ()); + load_oasis_plugin = (fun _ -> false); } @@ -3160,7 +3162,7 @@ module OASISFileUtil = struct end -# 3163 "setup.ml" +# 3165 "setup.ml" module BaseEnvLight = struct (* # 22 "src/base/BaseEnvLight.ml" *) @@ -3240,7 +3242,7 @@ module BaseEnvLight = struct end -# 3243 "setup.ml" +# 3245 "setup.ml" module BaseContext = struct (* # 22 "src/base/BaseContext.ml" *) @@ -5663,7 +5665,7 @@ module BaseCompat = struct end -# 5666 "setup.ml" +# 5668 "setup.ml" module InternalConfigurePlugin = struct (* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *) @@ -6469,7 +6471,7 @@ module InternalInstallPlugin = struct end -# 6472 "setup.ml" +# 6474 "setup.ml" module CustomPlugin = struct (* # 22 "src/plugins/custom/CustomPlugin.ml" *) @@ -6601,7 +6603,7 @@ module CustomPlugin = struct end -# 6604 "setup.ml" +# 6606 "setup.ml" open OASISTypes;; let setup_t = @@ -6749,7 +6751,7 @@ let setup_t = { oasis_version = "0.4"; ocaml_version = Some (OASISVersion.VGreaterEqual "3.12.1"); - version = "2.5.3"; + version = "2.5.4"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -7025,8 +7027,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.8"; + oasis_digest = Some "\200e\186\249\186.\167q\012\193\239N\023k\129."; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -7034,7 +7036,7 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 7038 "setup.ml" +# 7040 "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 168af9658..00dc5f6c2 100644 --- a/src/batArray.mliv +++ b/src/batArray.mliv @@ -542,7 +542,7 @@ val shuffle : ?state:Random.State.t -> 'a array -> unit algorithm and works in O(n), where n is the number of elements of [a]. - @since NEXT_RELEASE + @since 2.6.0 *) val equal : 'a BatOrd.eq -> 'a array BatOrd.eq diff --git a/src/batHashtbl.mli b/src/batHashtbl.mli index d50f0c1ba..f373c29ae 100644 --- a/src/batHashtbl.mli +++ b/src/batHashtbl.mli @@ -123,15 +123,15 @@ val of_enum : ('a * 'b) BatEnum.t -> ('a, 'b) t val of_list : ('a * 'b) list -> ('a, 'b) t (** Create a hashtable from a list of (key,value) pairs. - @since NEXT_RELEASE *) + @since 2.6.0 *) val to_list : ('a, 'b) t -> ('a * 'b) list (** Return the list of (key,value) pairs. - @since NEXT_RELEASE *) + @since 2.6.0 *) val bindings : ('a, 'b) t -> ('a * 'b) list (** Alias for [to_list]. - @since NEXT_RELEASE *) + @since 2.6.0 *) (**{6 Searching}*) diff --git a/src/batList.mli b/src/batList.mli index 8b3c31d16..bfdc65be3 100644 --- a/src/batList.mli +++ b/src/batList.mli @@ -107,7 +107,7 @@ val shuffle : ?state:Random.State.t -> 'a list -> 'a list algorithm on an array and works in O(n), where n is the number of elements of [l]. - @since NEXT_RELEASE + @since 2.6.0 *) val append : 'a list -> 'a list -> 'a list @@ -158,7 +158,7 @@ val frange : float -> [< `To | `Downto ] -> float -> int -> float list @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 NEXT_RELEASE *) + @since 2.6.0 *) val init : int -> (int -> 'a) -> 'a list (** Similar to [Array.init], [init n f] returns the list containing @@ -258,7 +258,7 @@ val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list (res, y :: ys) ]} - @since NEXT_RELEASE + @since 2.6.0 *) val max : 'a list -> 'a @@ -282,7 +282,7 @@ val fsum : float list -> float val favg : float list -> float (** [favg l] returns the average of the floats of [l] @raise Invalid_argument on the empty list. - @since NEXT_RELEASE + @since 2.6.0 *) val kahan_sum : float list -> float diff --git a/src/batResult.mli b/src/batResult.mli index 0cc56d845..fbb1ffbba 100644 --- a/src/batResult.mli +++ b/src/batResult.mli @@ -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 From 8a6ea9bbd205715549d034c73cfc33807ed07cf2 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Wed, 12 Apr 2017 10:23:36 -0500 Subject: [PATCH 044/273] fix in the Makefile for when *.cmt{i} files are not produced by ocamlbuild (#748) --- Makefile | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index c192d050d..bb858a8cc 100644 --- a/Makefile +++ b/Makefile @@ -35,9 +35,17 @@ endif INSTALL_FILES = _build/META _build/src/*.cma \ battop.ml _build/src/*.cmi _build/src/*.mli \ - _build/src/*.cmti _build/src/*.cmt \ _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 From 4f1096904f1356efe2ea8a3307616f161af559d0 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 12 Apr 2017 11:33:01 -0400 Subject: [PATCH 045/273] Bin annot flag (#749) * myocamlbuild.ml: make OCaml version available * backport bin-annot to 4.00 --- myocamlbuild.ml | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/myocamlbuild.ml b/myocamlbuild.ml index b4fc1be08..a719effb3 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -111,12 +111,17 @@ 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 @@ -209,8 +214,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"]; From 1e2f93bca7f3ded2fe7b3f7456599049ce1bc8dd Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Thu, 4 May 2017 15:27:26 +0200 Subject: [PATCH 046/273] Fix BatSet doc re. raised exceptions (#752) Functions that fails on an empty set raise Not_found not Invalid_argument. --- src/batSet.mli | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/batSet.mli b/src/batSet.mli index 4769486cc..6449aaad3 100644 --- a/src/batSet.mli +++ b/src/batSet.mli @@ -583,7 +583,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 @@ -607,11 +607,11 @@ 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 pop : 'a t -> 'a * 'a t (** returns one element of the set and the set without that element. @@ -874,7 +874,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 @@ -898,11 +898,11 @@ 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 pop : 'a t -> 'a * 'a t (** returns one element of the set and the set without that element. From fa31d0163a9f051532334080aff54c10bd843422 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Fri, 5 May 2017 04:41:17 +0200 Subject: [PATCH 047/273] Fix typo s/occurence/occurrence/ --- benchsuite/bench_nreplace.ml | 2 +- src/batMap.ml | 2 +- src/batString.mliv | 4 ++-- src/batSubstring.mli | 8 ++++---- src/batText.mli | 2 +- 5 files changed, 9 insertions(+), 9 deletions(-) diff --git a/benchsuite/bench_nreplace.ml b/benchsuite/bench_nreplace.ml index f4b56c0d0..cf05258ef 100644 --- a/benchsuite/bench_nreplace.ml +++ b/benchsuite/bench_nreplace.ml @@ -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/src/batMap.ml b/src/batMap.ml index 4be4fb397..4112c31f1 100644 --- a/src/batMap.ml +++ b/src/batMap.ml @@ -1063,7 +1063,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 *) diff --git a/src/batString.mliv b/src/batString.mliv index 873eb1b04..87ac7f554 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -690,7 +690,7 @@ val split_on_char: char -> string -> string list 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. @@ -702,7 +702,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. diff --git a/src/batSubstring.mli b/src/batSubstring.mli index 858d70bb7..bcf444d98 100644 --- a/src/batSubstring.mli +++ b/src/batSubstring.mli @@ -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]. *) diff --git a/src/batText.mli b/src/batText.mli index 2cccedcc1..b7b545bdf 100644 --- a/src/batText.mli +++ b/src/batText.mli @@ -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"; ""]. From caed4659a7d1b8115997e5147c80dcf3a0627c94 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Wed, 3 May 2017 20:34:18 +0200 Subject: [PATCH 048/273] Add Bat{Set,Map,Splay}.any and fix Bat{Map,Splay}.choose Choose must return equal elements for equal sets/maps/splay-maps. Therefore we need another function to return (in constant time) any element from a container with no such constraint. --- ChangeLog | 4 ++++ src/batMap.ml | 25 +++++++++++++++------ src/batMap.mli | 60 ++++++++++++++++++++++++++++++++++--------------- src/batSet.ml | 20 +++++++++++++---- src/batSet.mli | 30 ++++++++++++++++++++++--- src/batSplay.ml | 31 ++++++++++++++++++++----- 6 files changed, 132 insertions(+), 38 deletions(-) diff --git a/ChangeLog b/ChangeLog index 87175157e..1f3ed7168 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,10 @@ Changelog ## 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) diff --git a/src/batMap.ml b/src/batMap.ml index 4112c31f1..5f3745bd9 100644 --- a/src/batMap.ml +++ b/src/batMap.ml @@ -403,10 +403,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 @@ -434,7 +430,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) @@ -749,6 +750,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 @@ -768,6 +770,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 @@ -860,6 +864,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 @@ -895,6 +900,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 = @@ -1025,6 +1032,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 @@ -1093,6 +1101,8 @@ let equal eq_val m1 m2 = Concrete.equal Pervasives.compare (=) 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 = @@ -1224,8 +1234,6 @@ 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 = @@ -1249,6 +1257,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 @@ -1303,6 +1312,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 bd1803eb1..ae9dfda05 100644 --- a/src/batMap.mli +++ b/src/batMap.mli @@ -226,17 +226,24 @@ sig 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 @@ -323,6 +330,8 @@ sig (** 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} *) @@ -490,16 +499,21 @@ val filter_map: ('key -> 'a -> 'b option) -> ('key, 'a) t -> ('key, 'b) t pairs [keyi],[bi] 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 @@ -620,6 +634,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 @@ -790,15 +806,21 @@ module PMap : sig pairs [keyi],[bi] 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 @@ -926,6 +948,8 @@ module PMap : sig (** 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 diff --git a/src/batSet.ml b/src/batSet.ml index d77c8fdf5..dea16ec39 100644 --- a/src/batSet.ml +++ b/src/batSet.ml @@ -183,10 +183,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 @@ -391,6 +387,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 @@ -558,6 +564,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 @@ -582,6 +589,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 (** Operations on {!Set} with labels. *) @@ -642,6 +650,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 @@ -722,6 +731,7 @@ 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 @@ -812,6 +822,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 @@ -939,6 +950,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 diff --git a/src/batSet.mli b/src/batSet.mli index 6449aaad3..8b8dfdd24 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. @@ -319,6 +327,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 @@ -613,6 +622,13 @@ val choose : 'a t -> 'a (** returns an arbitrary (but deterministic) element of the given 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. @raise Not_found if given an empty set *) @@ -904,6 +920,14 @@ module PSet : sig (** returns an arbitrary (but deterministic) element of the given 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. @raise Not_found if given an empty set *) diff --git a/src/batSplay.ml b/src/batSplay.ml index bed2f8256..cc626ceef 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 @@ -354,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 @@ -367,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 choose empty ; false with Not_found -> true + *) + + let any tr = match sget tr with + | Empty -> raise Not_found + | Node (_, kv, _) -> kv + (*$T any + try any empty ; false with Not_found -> true + *) + let pop_min_binding tr = let mini = ref (choose tr) in let rec bfind = function @@ -536,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 @@ -658,4 +676,5 @@ struct match !maybe_v with | None -> raise Not_found | Some v -> v, sref tr + (*$>*) end From 953e1d65ae432d3bb53cddf97da4bf2bfb7344c4 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Wed, 31 May 2017 11:14:14 +0900 Subject: [PATCH 049/273] added BatArray.min_max --- src/batArray.mliv | 6 ++++++ src/batArray.mlv | 18 ++++++++++++++++++ 2 files changed, 24 insertions(+) diff --git a/src/batArray.mliv b/src/batArray.mliv index 00dc5f6c2..103199572 100644 --- a/src/batArray.mliv +++ b/src/batArray.mliv @@ -182,6 +182,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] *) diff --git a/src/batArray.mlv b/src/batArray.mlv index 14d113618..44094a2f4 100644 --- a/src/batArray.mlv +++ b/src/batArray.mlv @@ -573,6 +573,24 @@ let max a = reduce Pervasives.max a max [|2;3;1|] = 3 *) +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 min_max [||]; false with Invalid_argument _ -> true +*) + let sum = reduce (+) let fsum = reduce (+.) From 25eb4f7b8e4009ff910dd8fcdd706d7d105657d3 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Wed, 31 May 2017 11:17:31 +0900 Subject: [PATCH 050/273] added BatArray.min_max in ChangeLog --- ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/ChangeLog b/ChangeLog index 1f3ed7168..d4cf4d4b1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,12 @@ Changelog --------- +## next minor release + +- added BatArray.min_max + #757 + (Francois Berenger) + ## v2.6.0 (minor release) - added Bat{Set,Map,Splay}.any and fixed Bat{Map,Splay}.choose From 97dbdfe6a470958835ec1c044a4a995d13f11589 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Sun, 16 Jul 2017 18:18:12 +0200 Subject: [PATCH 051/273] Fix typos in documentation strings --- src/batBounded.mli | 6 +++--- src/batBuffer.mli | 4 ++-- src/batBytes.mliv | 2 +- src/batDeque.mli | 8 ++++---- src/batDynArray.mli | 2 +- src/batEnum.mli | 2 +- src/batFile.mli | 2 +- src/batFingerTree.mli | 4 ++-- src/batHashtbl.mli | 2 +- src/batIMap.mli | 2 +- src/batLazyList.mli | 8 ++++---- src/batList.mli | 8 ++++---- src/batPervasives.mliv | 4 ++-- src/batPrintexc.mliv | 4 ++-- src/batScanf.mli | 4 ++-- src/batStack.mli | 2 +- src/batString.mliv | 2 +- src/batSubstring.mli | 8 ++++---- src/batText.mli | 4 ++-- 19 files changed, 39 insertions(+), 39 deletions(-) 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 index 5765e064a..47a97b12b 100644 --- a/src/batBuffer.mli +++ b/src/batBuffer.mli @@ -103,7 +103,7 @@ 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]. +(** [add_bytes b s] appends the string [s] at the end of the buffer [b]. @since 2.3.0 *) @@ -113,7 +113,7 @@ val add_substring : t -> string -> int -> int -> unit [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 +(** [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 diff --git a/src/batBytes.mliv b/src/batBytes.mliv index f3dbfa5ad..e1d684c07 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]. diff --git a/src/batDeque.mli b/src/batDeque.mli index 077f5cf49..e70804441 100644 --- a/src/batDeque.mli +++ b/src/batDeque.mli @@ -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/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.mli b/src/batEnum.mli index 07469c873..cb8dd5e81 100644 --- a/src/batEnum.mli +++ b/src/batEnum.mli @@ -600,7 +600,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 *) 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/batFingerTree.mli b/src/batFingerTree.mli index 8b9e09f70..c66f22ee0 100644 --- a/src/batFingerTree.mli +++ b/src/batFingerTree.mli @@ -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). *) diff --git a/src/batHashtbl.mli b/src/batHashtbl.mli index f373c29ae..f3092f9fa 100644 --- a/src/batHashtbl.mli +++ b/src/batHashtbl.mli @@ -220,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 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/batLazyList.mli b/src/batLazyList.mli index 31e32d221..35e470464 100644 --- a/src/batLazyList.mli +++ b/src/batLazyList.mli @@ -253,7 +253,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 +262,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. *) @@ -604,7 +604,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 +617,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/batList.mli b/src/batList.mli index bfdc65be3..ebb31804e 100644 --- a/src/batList.mli +++ b/src/batList.mli @@ -430,7 +430,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. @@ -444,7 +444,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). @@ -587,7 +587,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]. @@ -642,7 +642,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 *) diff --git a/src/batPervasives.mliv b/src/batPervasives.mliv index 635321421..062076bbc 100644 --- a/src/batPervasives.mliv +++ b/src/batPervasives.mliv @@ -300,7 +300,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 @@ -748,7 +748,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..c756dafc7 100644 --- a/src/batPrintexc.mliv +++ b/src/batPrintexc.mliv @@ -301,7 +301,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 @@ -333,7 +333,7 @@ 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 diff --git a/src/batScanf.mli b/src/batScanf.mli index 2f8b70379..84f00a27d 100644 --- a/src/batScanf.mli +++ b/src/batScanf.mli @@ -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]. *) (** 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/batString.mliv b/src/batString.mliv index 87ac7f554..43519dd47 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -655,7 +655,7 @@ 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 *) diff --git a/src/batSubstring.mli b/src/batSubstring.mli index bcf444d98..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]. *) @@ -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/batText.mli b/src/batText.mli index b7b545bdf..0148b5d4b 100644 --- a/src/batText.mli +++ b/src/batText.mli @@ -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]. From acf4218ea19c4fb186c4dc568b059d15f5d36786 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Sun, 16 Jul 2017 19:38:18 +0200 Subject: [PATCH 052/273] Fix make test Ask opam for a qcheck package that's compatible with batteries (This is not a proper fix for #756, but make tests work in the meantime). While at it, ask for bisect. Also clean some harmless warnings in the compilation of some tests ("expression should have type unit"). --- opam | 3 ++- src/batArray.mlv | 2 +- src/batSplay.ml | 4 ++-- 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/opam b/opam index bd6183f6b..8190b1749 100644 --- a/opam +++ b/opam @@ -20,7 +20,8 @@ remove: [["ocamlfind" "remove" "batteries"]] depends: [ "ocamlfind" {>= "1.5.3"} "ocamlbuild" {build} - "qtest" {test & >= "2.0.0"} + "qtest" {test & >= "2.0.0" & < "2.5"} + "bisect" {test} ] available: [ ocaml-version >= "3.12.1" diff --git a/src/batArray.mlv b/src/batArray.mlv index 44094a2f4..c6e59d209 100644 --- a/src/batArray.mlv +++ b/src/batArray.mlv @@ -588,7 +588,7 @@ let min_max a = (*$T min_max min_max [|1|] = (1, 1) min_max [|1;-2;10;3|] = (-2, 10) - try min_max [||]; false with Invalid_argument _ -> true + try ignore (min_max [||]); false with Invalid_argument _ -> true *) let sum = reduce (+) diff --git a/src/batSplay.ml b/src/batSplay.ml index cc626ceef..950b6ea76 100644 --- a/src/batSplay.ml +++ b/src/batSplay.ml @@ -374,14 +374,14 @@ struct (empty |> add 1 1 |> add 0 1 |> choose) *) (*$T choose - try choose empty ; false with Not_found -> true + 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 any empty ; false with Not_found -> true + try ignore (any empty) ; false with Not_found -> true *) let pop_min_binding tr = From 95f5d430374dd6c9fff8499bdda0f72eb3a5ec60 Mon Sep 17 00:00:00 2001 From: theindigamer Date: Sun, 16 Jul 2017 22:02:47 -0400 Subject: [PATCH 053/273] Adds `Labels` submodule to `BatVect`. * Partial fix for issue #760. * Also fixes a few typos in the `BatVect` documentation. --- src/batVect.ml | 64 +++++++++++++++++++++++++++++++++ src/batVect.mli | 96 +++++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 153 insertions(+), 7 deletions(-) diff --git a/src/batVect.ml b/src/batVect.ml index b1e272ec8..e09b369b2 100644 --- a/src/batVect.ml +++ b/src/batVect.ml @@ -592,6 +592,38 @@ 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 concat ~v1 ~v2 = concat v1 v2 + let get v ~n = get v n + let at v ~n = at v n + let set v ~n ~c = set v n c + let modify v ~n ~f = modify v n f + let sub v ~m ~n = sub v 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 ~c = mem c + let memq ~c = memq c + 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 ~c = destructive_set v n c + let rangeiter ~f ~m ~n = rangeiter f m n + let fold_left ~f ~x0 = fold_left f x0 + let fold ~f ~x0 = fold f x0 + let reduce ~f = reduce f + let fold_right ~f v ~x0 = fold_right f v x0 + let foldi ~f ~x0 = foldi f x0 +end + (* Functorial interface *) module type RANDOMACCESS = @@ -1165,4 +1197,36 @@ 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 concat ~v1 ~v2 = concat v1 v2 + let get v ~n = get v n + let at v ~n = at v n + let set v ~n ~c = set v n c + let modify v ~n ~f = modify v n f + let sub v ~m ~n = sub v 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 ~c = mem c + let memq ~c = memq c + 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 ~c = destructive_set v n c + let rangeiter ~f ~m ~n = rangeiter f m n + let fold_left ~f ~x0 = fold_left f x0 + let fold ~f ~x0 = fold f x0 + let reduce ~f = reduce f + let fold_right ~f v ~x0 = fold_right f v x0 + let foldi ~f ~x0 = foldi f x0 + end + end diff --git a/src/batVect.mli b/src/batVect.mli index 043b65f8e..dd1902705 100644 --- a/src/batVect.mli +++ b/src/batVect.mli @@ -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 @@ -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]. *) @@ -328,6 +328,47 @@ 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 concat : v1:'a t -> v2:'a t -> 'a t + val get : 'a t -> n:int -> 'a + val at : 'a t -> n:int -> 'a + val set : 'a t -> n:int -> c:'a -> 'a t + val modify : 'a t -> n:int -> f:('a -> 'a) -> 'a t + val destructive_set : 'a t -> n:int -> c:'a -> unit + val sub : 'a t -> m:int -> n:int -> '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) -> x0:'b -> 'a t -> 'b + val fold : f:('b -> 'a -> 'b) -> x0:'b -> 'a t -> 'b + val reduce : f:('a -> 'a -> 'a) -> 'a t -> 'a + val fold_right : f:('a -> 'b -> 'b) -> 'a t -> x0:'b -> 'b + val foldi : f:(int -> 'b -> 'a -> 'b) -> x0:'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 : c:'a -> 'a t -> bool + val memq : c:'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 = @@ -462,8 +503,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 @@ -623,6 +664,47 @@ 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 concat : v1:'a t -> v2:'a t -> 'a t + val get : 'a t -> n:int -> 'a + val at : 'a t -> n:int -> 'a + val set : 'a t -> n:int -> c:'a -> 'a t + val modify : 'a t -> n:int -> f:('a -> 'a) -> 'a t + val destructive_set : 'a t -> n:int -> c:'a -> unit + val sub : 'a t -> m:int -> n:int -> '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) -> x0:'b -> 'a t -> 'b + val fold : f:('b -> 'a -> 'b) -> x0:'b -> 'a t -> 'b + val reduce : f:('a -> 'a -> 'a) -> 'a t -> 'a + val fold_right : f:('a -> 'b -> 'b) -> 'a t -> x0:'b -> 'b + val foldi : f:(int -> 'b -> 'a -> 'b) -> x0:'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 : c:'a -> 'a t -> bool + val memq : c:'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 From f210b01adfd30b2d2846365e948cc1dc70fcc48e Mon Sep 17 00:00:00 2001 From: theindigamer Date: Wed, 19 Jul 2017 11:33:17 -0400 Subject: [PATCH 054/273] Easier to understand labels in BatVect.Labels. --- src/batVect.ml | 46 ++++++++++++++++++++++++---------------------- src/batVect.mli | 38 ++++++++++++++++++++------------------ 2 files changed, 44 insertions(+), 40 deletions(-) diff --git a/src/batVect.ml b/src/batVect.ml index e09b369b2..4d2d3b11d 100644 --- a/src/batVect.ml +++ b/src/batVect.ml @@ -595,12 +595,13 @@ let ord ord_val v1 v2 = module Labels = struct let init n ~f = init n f - let concat ~v1 ~v2 = concat v1 v2 let get v ~n = get v n let at v ~n = at v n - let set v ~n ~c = set v n c + 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 @@ -608,20 +609,20 @@ struct let for_all ~f = for_all f let exists ~f = exists f let find ~f = find f - let mem ~c = mem c - let memq ~c = memq c + 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 ~c = destructive_set v n c - let rangeiter ~f ~m ~n = rangeiter f m n - let fold_left ~f ~x0 = fold_left f x0 - let fold ~f ~x0 = fold f x0 - let reduce ~f = reduce f - let fold_right ~f v ~x0 = fold_right f v x0 - let foldi ~f ~x0 = foldi f x0 + 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 *) @@ -1200,12 +1201,13 @@ struct module Labels = struct let init n ~f = init n f - let concat ~v1 ~v2 = concat v1 v2 let get v ~n = get v n let at v ~n = at v n - let set v ~n ~c = set v n c + 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 @@ -1213,20 +1215,20 @@ struct let for_all ~f = for_all f let exists ~f = exists f let find ~f = find f - let mem ~c = mem c - let memq ~c = memq c + 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 ~c = destructive_set v n c - let rangeiter ~f ~m ~n = rangeiter f m n - let fold_left ~f ~x0 = fold_left f x0 - let fold ~f ~x0 = fold f x0 - let reduce ~f = reduce f - let fold_right ~f v ~x0 = fold_right f v x0 - let foldi ~f ~x0 = foldi f x0 + 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 end diff --git a/src/batVect.mli b/src/batVect.mli index dd1902705..d2ffa481b 100644 --- a/src/batVect.mli +++ b/src/batVect.mli @@ -340,28 +340,29 @@ val invariants : _ t -> unit *) module Labels : sig val init : int -> f:(int -> 'a) -> 'a t - val concat : v1:'a t -> v2:'a t -> 'a t val get : 'a t -> n:int -> 'a val at : 'a t -> n:int -> 'a - val set : 'a t -> n:int -> c:'a -> 'a t + 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 -> c:'a -> unit + 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) -> x0:'b -> 'a t -> 'b - val fold : f:('b -> 'a -> 'b) -> x0:'b -> 'a t -> 'b + 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 -> x0:'b -> 'b - val foldi : f:(int -> 'b -> 'a -> 'b) -> x0:'b -> 'a t -> 'b + 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 : c:'a -> 'a t -> bool - val memq : c:'a -> 'a t -> bool + 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 @@ -676,28 +677,29 @@ val pop : 'a t -> 'a * 'a t *) module Labels : sig val init : int -> f:(int -> 'a) -> 'a t - val concat : v1:'a t -> v2:'a t -> 'a t val get : 'a t -> n:int -> 'a val at : 'a t -> n:int -> 'a - val set : 'a t -> n:int -> c:'a -> 'a t + 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 -> c:'a -> unit + 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) -> x0:'b -> 'a t -> 'b - val fold : f:('b -> 'a -> 'b) -> x0:'b -> 'a t -> 'b + 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 -> x0:'b -> 'b - val foldi : f:(int -> 'b -> 'a -> 'b) -> x0:'b -> 'a t -> 'b + 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 : c:'a -> 'a t -> bool - val memq : c:'a -> 'a t -> bool + 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 From 1b0b69b56832d592edc612c34a0b23c806e9cbf3 Mon Sep 17 00:00:00 2001 From: Varun Gandhi Date: Sun, 30 Jul 2017 21:45:21 -0400 Subject: [PATCH 055/273] Documents exceptions for List.(min, max) and small punctuation fixes. (#770) --- src/batList.mli | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/src/batList.mli b/src/batList.mli index ebb31804e..da70a40a5 100644 --- a/src/batList.mli +++ b/src/batList.mli @@ -71,7 +71,7 @@ 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] *) +(** [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 @@ -263,19 +263,23 @@ val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list 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] +(** [sum l] returns the sum of the integers of [l]. @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]. @raise Invalid_argument on the empty list. *) @@ -698,7 +702,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} @@ -709,7 +713,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 @@ -718,7 +722,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 @@ -812,7 +816,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]. *) @@ -876,7 +880,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}. *) @@ -903,7 +907,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 @@ -944,7 +948,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 From 3df4fbcf65597e2f96c4a3d9f04688bb2f9087ad Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Mon, 31 Jul 2017 10:47:16 +0900 Subject: [PATCH 056/273] added pull request 770 to Changelog --- ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ChangeLog b/ChangeLog index d4cf4d4b1..004568fef 100644 --- a/ChangeLog +++ b/ChangeLog @@ -6,6 +6,10 @@ Changelog - added BatArray.min_max #757 (Francois Berenger) + +- Documents exceptions for List.(min, max) + #770 + (Varun Gandhi) ## v2.6.0 (minor release) From 359c9f04501fa55ea107bbc5e0a40b69b936c22d Mon Sep 17 00:00:00 2001 From: Thibault Suzanne Date: Thu, 3 Aug 2017 20:50:47 +0200 Subject: [PATCH 057/273] Add Changelog for #763 (BatVect.Labels addition) --- ChangeLog | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 004568fef..056fe5ed1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -6,7 +6,11 @@ Changelog - added BatArray.min_max #757 (Francois Berenger) - + +- added a Label module to BatVect + #763 + (Varun Gandhi, review by Francois Berenger, Gabriel Scherer, Thibault Suzanne) + - Documents exceptions for List.(min, max) #770 (Varun Gandhi) From 7b59f41f426a9985469dc20e02c5ff4191e81c99 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 30 Jul 2017 11:52:41 +0200 Subject: [PATCH 058/273] Fix an implementation/specification mismatch in BatVect.insert `BatVect.insert : int -> 'a t -> 'a t` is specified so that `insert n r u` inserts the rope `r` between the elements of index `n` and `n+1` in `u`. Its implementation does something different, it inserts `r` strictly before the element of index `n` in `u`. The present commit changes the specification to match the implementation. First, we expect users to have tested their program instead of trusting (or, unfortunately, even reading) the documentation, so it is likely that the uses of BatVect.insert with the current implementation is correct for their needs; changing it would break user program. Second, we argue that the implemented behavior is actually far more natural: - the implementation (in terms of `sub` and `concat`) is nicer -- hear the code! - the ranges of integer values valid for `insert` is `0 .. (length u - 1)`, as one would expect, instead of `(-1) .. (length u - 2)` as with the current specification. - this gives a very natural invariant between `insert` and `BatVect.remove : (*start*)int -> (*len*)int -> 'a t -> 'a t`: `u` is equal to `u |> insert n r |> remove n (length r))`. fixes #766. --- ChangeLog | 4 ++++ src/batVect.ml | 22 ++++++++++++++++++++++ src/batVect.mli | 6 +++--- 3 files changed, 29 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index 056fe5ed1..e504ff71a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -11,6 +11,10 @@ Changelog #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) + - Documents exceptions for List.(min, max) #770 (Varun Gandhi) diff --git a/src/batVect.ml b/src/batVect.ml index 4d2d3b11d..29a8b01e4 100644 --- a/src/batVect.ml +++ b/src/batVect.ml @@ -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 diff --git a/src/batVect.mli b/src/batVect.mli index d2ffa481b..2827a5222 100644 --- a/src/batVect.mli +++ b/src/batVect.mli @@ -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 From e9f0eaeb8e1cc8a0acd94e73ca449c0e20d3c9ef Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 13 Jul 2017 22:05:19 -0400 Subject: [PATCH 059/273] remove exceptions in BatString.starts_with --- src/batString.mlv | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/batString.mlv b/src/batString.mlv index f62777e9e..9e30a3b9e 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -46,13 +46,11 @@ 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) + let rec loop str p i = + if i = len then true + else 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" "" From c8d8fd0da95fa4329ae2ea7ead4128b0e4974a3c Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 13 Jul 2017 22:06:56 -0400 Subject: [PATCH 060/273] remove exceptions in BatString.ends_with --- src/batString.mlv | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/batString.mlv b/src/batString.mlv index 9e30a3b9e..9783de6e8 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -69,13 +69,11 @@ let ends_with str p = let diff = sl - el in 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) + let rec loop str p diff i = + if i = el then true + else if get str (diff + i) <> 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" "" From b969df7a4be10667098c7bde84c053b39b164a1e Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 13 Jul 2017 22:31:41 -0400 Subject: [PATCH 061/273] remove exceptions in BatString.find_from --- src/batString.mlv | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/src/batString.mlv b/src/batString.mlv index 9783de6e8..8f5829546 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -90,16 +90,15 @@ let find_from str pos sub = let sublen = length sub in if pos < 0 || pos > len then raise (Invalid_argument "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 + let rec loop ~str ~sub i j = + if j = sublen then i + else 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 \ From 86e76202c74a2f7cb5256f5fb95c94826b8e1f48 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 13 Jul 2017 23:15:03 -0400 Subject: [PATCH 062/273] remove exceptions in BatString.rfind_from --- src/batString.mlv | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/src/batString.mlv b/src/batString.mlv index 8f5829546..fefc12e23 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -132,16 +132,15 @@ let rfind_from str pos sub = and len = length str in if pos + 1 < 0 || pos + 1 > len then raise (Invalid_argument "String.rfind_from"); 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 - ) + let rec find ~str ~sub i = + if i < 0 then raise Not_found + else + let rec loop ~str ~sub i j = + if j = sublen then i + else 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 \ From 744ea80809783bb0e58a478bd145174d0e3022f5 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 13 Jul 2017 23:17:33 -0400 Subject: [PATCH 063/273] fix bug in batSubstring.equal --- src/batSubstring.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/batSubstring.ml b/src/batSubstring.ml index c53af7e4e..d9617f9da 100644 --- a/src/batSubstring.ml +++ b/src/batSubstring.ml @@ -56,12 +56,13 @@ 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 + if s1.[i+o1] <> s2.[i+o2] then BatReturn.return label false done; true) (*$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 *) (* From 3954ec667f0d9de92e92997a1b0c223441f34e26 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 13 Jul 2017 23:19:01 -0400 Subject: [PATCH 064/273] remove exceptions in BatSubstring.equal --- src/batSubstring.ml | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/batSubstring.ml b/src/batSubstring.ml index d9617f9da..97ed3c22b 100644 --- a/src/batSubstring.ml +++ b/src/batSubstring.ml @@ -54,10 +54,12 @@ 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] <> s2.[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 From b13b90792b321334255f08e79513d602e99b6f32 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 30 Jul 2017 19:20:57 +0200 Subject: [PATCH 065/273] change entry for the String, Substring changes --- ChangeLog | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/ChangeLog b/ChangeLog index e504ff71a..4c6a8c131 100644 --- a/ChangeLog +++ b/ChangeLog @@ -15,6 +15,15 @@ Changelog #766, #767 (Gabriel Scherer, report by Varun Gandhi) +- avoid using exceptions for internal control-flow + #768 + 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 and BatSubstring. + (Gabriel Scherer, request by Clément Pit-Claudel) + - Documents exceptions for List.(min, max) #770 (Varun Gandhi) From 9f4cae18d338f7730cfd2faf8bb8787a3f489e0d Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 9 Aug 2017 09:42:23 +0200 Subject: [PATCH 066/273] Changelog: add review information for #768 --- ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 4c6a8c131..e222a3f16 100644 --- a/ChangeLog +++ b/ChangeLog @@ -22,7 +22,7 @@ Changelog raising/catching than the native OCaml backend. Internal exceptions (trough the BatReturn label) have been removed from the modules BatString and BatSubstring. - (Gabriel Scherer, request by Clément Pit-Claudel) + (Gabriel Scherer, request and review by Clément Pit-Claudel) - Documents exceptions for List.(min, max) #770 From bdbf26fd785e5222b1ba8f55697653d8c08ecc87 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 13 Jul 2017 23:33:27 -0400 Subject: [PATCH 067/273] remove exceptions in BatVect.{exists,for_all} --- src/batVect.ml | 53 +++++++++++++++++++++++++++++++++----------------- 1 file changed, 35 insertions(+), 18 deletions(-) diff --git a/src/batVect.ml b/src/batVect.ml index 29a8b01e4..5e7556598 100644 --- a/src/batVect.ml +++ b/src/batVect.ml @@ -508,25 +508,42 @@ 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 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 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 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 find f v = BatReturn.label (fun label -> From 26a6aaa97ac4163d3d17d3c596b72df6ffaebb53 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 29 Jul 2017 13:02:36 +0200 Subject: [PATCH 068/273] remove exceptions in BatVect.find Implementing BatVect.find_opt makes this more efficient (we have at most one allocation for the result, instead of using exception handlers for each left subtree), but the function is not exposed publicly. --- src/batVect.ml | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/src/batVect.ml b/src/batVect.ml index 5e7556598..a13d9735f 100644 --- a/src/batVect.ml +++ b/src/batVect.ml @@ -545,15 +545,25 @@ let rec for_all f = function (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 + 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 From f80a7516e12fccac54086ed85e9649f5ce8411bb Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 30 Jul 2017 12:12:45 +0200 Subject: [PATCH 069/273] BatVect: expose find_opt and harmonize variable names in .mli section --- ChangeLog | 4 ++++ src/batVect.ml | 6 ++++++ src/batVect.mli | 27 +++++++++++++++++---------- 3 files changed, 27 insertions(+), 10 deletions(-) diff --git a/ChangeLog b/ChangeLog index e222a3f16..86ea40afa 100644 --- a/ChangeLog +++ b/ChangeLog @@ -24,6 +24,10 @@ Changelog from the modules BatString and BatSubstring. (Gabriel Scherer, request and review by Clément Pit-Claudel) +- added `BatVect.find_opt : ('a -> bool) -> 'a t -> 'a option` + #TODO + (Gabriel Scherer) + - Documents exceptions for List.(min, max) #770 (Varun Gandhi) diff --git a/src/batVect.ml b/src/batVect.ml index a13d9735f..0113c54ea 100644 --- a/src/batVect.ml +++ b/src/batVect.ml @@ -553,6 +553,12 @@ let rec find_opt f = function | 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 = match find_opt f v with diff --git a/src/batVect.mli b/src/batVect.mli index 2827a5222..8abf81972 100644 --- a/src/batVect.mli +++ b/src/batVect.mli @@ -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 NEXT_RELEASE *) 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}. *) From feef5ba1f4f10885e5bb14c3ea91cfaf86dc4190 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 30 Jul 2017 14:08:40 +0200 Subject: [PATCH 070/273] remove exceptions in BatVect.Make.{for_all,exists} --- src/batVect.ml | 36 +++++++++++++++++------------------- 1 file changed, 17 insertions(+), 19 deletions(-) diff --git a/src/batVect.ml b/src/batVect.ml index 0113c54ea..2514c454d 100644 --- a/src/batVect.ml +++ b/src/batVect.ml @@ -1157,25 +1157,23 @@ 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 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 - ) + 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 + + 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 let find f v = BatReturn.label (fun label -> From 6601b948557e2ae600240c91592c6f77ae6cd2f9 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 30 Jul 2017 14:11:26 +0200 Subject: [PATCH 071/273] remove exceptions in BatVect.Make.find --- src/batVect.ml | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/src/batVect.ml b/src/batVect.ml index 2514c454d..9a8816587 100644 --- a/src/batVect.ml +++ b/src/batVect.ml @@ -1175,15 +1175,26 @@ struct aux f a (STRING.length a) 0 | Concat (l, _, r, _, _) -> for_all f l && for_all f r - 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 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 find f v = match find_opt f v with + | None -> raise Not_found + | Some a -> a let findi f v = let off = ref (-1) in From 2d28dd3ed993ec6ee91ab16b09810f5a70a13726 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 30 Jul 2017 14:26:11 +0200 Subject: [PATCH 072/273] tests for BatVect.Make functions --- src/batVect.ml | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/src/batVect.ml b/src/batVect.ml index 9a8816587..d8fc1c292 100644 --- a/src/batVect.ml +++ b/src/batVect.ml @@ -712,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 @@ -1166,6 +1175,13 @@ struct 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 -> @@ -1175,6 +1191,13 @@ struct 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 -> @@ -1196,6 +1219,13 @@ struct | 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 ignore (find (fun x -> let result = f x in incr off; result) v); @@ -1295,4 +1325,5 @@ struct let foldi ~f ~init = foldi f init end +(*$inject end *) end From 2d792e1e90a7bc587f3c211f4dcf51472aa6f1fc Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 30 Jul 2017 14:28:55 +0200 Subject: [PATCH 073/273] expose BatVect.Make.find_opt --- ChangeLog | 1 + src/batVect.ml | 7 +++++++ src/batVect.mli | 8 ++++++++ 3 files changed, 16 insertions(+) diff --git a/ChangeLog b/ChangeLog index 86ea40afa..a1c8cec65 100644 --- a/ChangeLog +++ b/ChangeLog @@ -25,6 +25,7 @@ Changelog (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 #TODO (Gabriel Scherer) diff --git a/src/batVect.ml b/src/batVect.ml index d8fc1c292..5fe7f4109 100644 --- a/src/batVect.ml +++ b/src/batVect.ml @@ -1215,6 +1215,13 @@ struct | None -> find_opt f r end + (*$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 = match find_opt f v with | None -> raise Not_found | Some a -> a diff --git a/src/batVect.mli b/src/batVect.mli index 8abf81972..db88358d2 100644 --- a/src/batVect.mli +++ b/src/batVect.mli @@ -628,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 NEXT_RELEASE +*) + val mem : 'a -> 'a t -> bool (** [mem m a] is true if and only if [m] is equal to an element of [a]. *) From 51e235ff7c7a5f5abd37e7e47030e9f5c6b67420 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 30 Jul 2017 19:37:20 +0200 Subject: [PATCH 074/273] less exceptions in batVect: changelog entry --- ChangeLog | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index a1c8cec65..a17f051f7 100644 --- a/ChangeLog +++ b/ChangeLog @@ -16,17 +16,17 @@ Changelog (Gabriel Scherer, report by Varun Gandhi) - avoid using exceptions for internal control-flow - #768 + #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 and BatSubstring. + 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 - #TODO + #769 (Gabriel Scherer) - Documents exceptions for List.(min, max) From 665f60a8706c1d55f05ab63fe4ea46f85efa14fb Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 9 Aug 2017 09:36:22 +0200 Subject: [PATCH 075/273] Makefile: introduce a QTEST_SEED variable to set qtest random seed To reproduce a failure that may depend on the seed 1234, you may use make test QTEST_SEED=1345 --- Makefile | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/Makefile b/Makefile index bb858a8cc..6fccc7342 100644 --- a/Makefile +++ b/Makefile @@ -49,6 +49,12 @@ 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 @@ -207,21 +213,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 ############################################## From 443300dc1fd5085aafca5c98c6d5ca6a7984101f Mon Sep 17 00:00:00 2001 From: Tej Chajed Date: Fri, 11 Aug 2017 10:56:07 +0100 Subject: [PATCH 076/273] Fix some issues in the README --- README.md | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index c40bf35df..6500f2ac7 100644 --- a/README.md +++ b/README.md @@ -24,14 +24,15 @@ 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/ @@ -42,7 +43,7 @@ You will need the following libraries: To install the full version of Batteries, execute $ make all - $ make test test [ optional ] + $ make test [ optional ] $ sudo make install $ make doc [ optional ] @@ -96,9 +97,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. From 711a5c336ef70fccb7b930867281ab3063eb4aad Mon Sep 17 00:00:00 2001 From: Tej Chajed Date: Fri, 11 Aug 2017 11:03:22 +0100 Subject: [PATCH 077/273] Fix compilation with OCaml 4.05.0 --- src/batGc.mliv | 6 ++++-- src/batInnerWeaktbl.ml | 1 + src/batUnix.mliv | 22 +++++++++++++++++----- 3 files changed, 22 insertions(+), 7 deletions(-) diff --git a/src/batGc.mliv b/src/batGc.mliv index 474dd01f8..162f35659 100644 --- a/src/batGc.mliv +++ b/src/batGc.mliv @@ -182,7 +182,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.5## [@@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 +228,8 @@ 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.5## [@@noalloc] (** Return the current size of the free space inside the minor heap. @since 2.5.0 and OCaml 4.03.0 *) diff --git a/src/batInnerWeaktbl.ml b/src/batInnerWeaktbl.ml index e16b683b3..3dd21487a 100644 --- a/src/batInnerWeaktbl.ml +++ b/src/batInnerWeaktbl.ml @@ -95,6 +95,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 (top_value (W.find tbl (dummy key))) with Not_found -> None let add tbl key data = let bd = bind_new key data in let cls = diff --git a/src/batUnix.mliv b/src/batUnix.mliv index d035f478b..1870fb9d8 100644 --- a/src/batUnix.mliv +++ b/src/batUnix.mliv @@ -272,6 +272,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}. *) @@ -546,11 +547,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 +620,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. *) @@ -1151,7 +1158,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 +1169,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. *) From 0db98663b85afb8d0e4e9253d2cff055f027c5b4 Mon Sep 17 00:00:00 2001 From: Tej Chajed Date: Fri, 11 Aug 2017 11:37:52 +0100 Subject: [PATCH 078/273] Fixes based on @gasche's comments --- src/batGc.mliv | 5 +++-- src/batInnerWeaktbl.ml | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/batGc.mliv b/src/batGc.mliv index 162f35659..04220f735 100644 --- a/src/batGc.mliv +++ b/src/batGc.mliv @@ -183,7 +183,7 @@ external counters : unit -> float * float * float = "caml_gc_counters" ##V>=4.4##external minor_words : unit -> (float [@unboxed]) ##V>=4.4## = "caml_gc_minor_words" "caml_gc_minor_words_unboxed" -##V<4.5## [@@noalloc] +##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. @@ -229,7 +229,8 @@ val allocated_bytes : unit -> float with [int] on 32-bit machines. *) ##V>=4.3##external get_minor_free : unit -> int = "caml_get_minor_free" -##V<4.5## [@@noalloc] +##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 *) diff --git a/src/batInnerWeaktbl.ml b/src/batInnerWeaktbl.ml index 3dd21487a..67f133500 100644 --- a/src/batInnerWeaktbl.ml +++ b/src/batInnerWeaktbl.ml @@ -95,7 +95,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 (top_value (W.find tbl (dummy key))) with Not_found -> None + 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 = From 5b325ca3d2368dec58eb267211d64cbe318188a2 Mon Sep 17 00:00:00 2001 From: Tej Chajed Date: Fri, 11 Aug 2017 14:21:11 +0100 Subject: [PATCH 079/273] Add support for new APIs --- src/batBig_int.mliv | 29 ++++++++++ src/batBigarray.mliv | 80 +++++++++++++++++++++++++++ src/batBigarray.mlv | 8 +++ src/{batBuffer.mli => batBuffer.mliv} | 4 ++ src/batBytes.mliv | 27 +++++++++ src/batInt32.mliv | 4 ++ src/batInt32.mlv | 1 + src/batInt64.mliv | 4 ++ src/batInt64.mlv | 1 + src/{batList.mli => batList.mliv} | 47 ++++++++++++++++ src/batList.mlv | 15 +++++ src/batNativeint.mliv | 4 ++ src/batNativeint.mlv | 1 + src/batPrintexc.mliv | 11 +++- src/batString.mliv | 36 ++++++++++++ src/batSys.mliv | 6 ++ 16 files changed, 276 insertions(+), 2 deletions(-) rename src/{batBuffer.mli => batBuffer.mliv} (96%) rename src/{batList.mli => batList.mliv} (94%) diff --git a/src/batBig_int.mliv b/src/batBig_int.mliv index 557f69518..2cfec4a8e 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. *) +##V>=4.5##val big_int_of_string_opt: string -> big_int option +##V>=4.5##(** Convert a string to a big integer, in decimal. +##V>=4.5## The string consists of an optional [-] or [+] sign, +##V>=4.5## followed by one or several decimal digits. Other the function +##V>=4.5## returns [None]. +##V>=4.5## @since 4.05 +##V>=4.5##*) 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. *) +##V>=4.5##val int_of_big_int_opt: big_int -> int option +##V>=4.5##(** Convert a big integer to a small integer (type [int]). Return +##V>=4.5## [None] if the big integer is not representable as a small +##V>=4.5## integer. +##V>=4.5## @since 4.05 +##V>=4.5##*) 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]]. *) +##V>=4.5##val int32_of_big_int_opt: big_int -> int32 option +##V>=4.5##(** Convert a big integer to a 32-bit integer. Return [None] if the +##V>=4.5## big integer is outside the range \[-2{^31}, 2{^31}-1\]. +##V>=4.5## @since 4.05 +##V>=4.5##*) 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]]. *) +##V>=4.5##val nativeint_of_big_int_opt: big_int -> nativeint option +##V>=4.5##(** Convert a big integer to a native integer. Return [None] if the +##V>=4.5## big integer is outside the range [[Nativeint.min_int, +##V>=4.5## Nativeint.max_int]]; +##V>=4.5## @since 4.05 +##V>=4.5##*) 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]]. *) +##V>=4.5##val int64_of_big_int_opt: big_int -> int64 option +##V>=4.5##(** Convert a big integer to a 64-bit integer. Return [None] if the +##V>=4.5## big integer is outside the range \[-2{^63}, 2{^63}-1\]. +##V>=4.5## @since 4.05 +##V>=4.5##*) val float_of_big_int : big_int -> float (** Returns a floating-point number approximating the diff --git a/src/batBigarray.mliv b/src/batBigarray.mliv index 8af3d5026..bdd859600 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 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 @@ -618,6 +675,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 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. @@ -1017,6 +1081,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 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 +1101,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 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 +1141,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 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..e498164d3 100644 --- a/src/batBigarray.mlv +++ b/src/batBigarray.mlv @@ -284,6 +284,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,10 +300,16 @@ 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 diff --git a/src/batBuffer.mli b/src/batBuffer.mliv similarity index 96% rename from src/batBuffer.mli rename to src/batBuffer.mliv index 47a97b12b..ad1e328c9 100644 --- a/src/batBuffer.mli +++ b/src/batBuffer.mliv @@ -151,6 +151,10 @@ 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]. *) (** {6 Boilerplate code}*) diff --git a/src/batBytes.mliv b/src/batBytes.mliv index e1d684c07..4f61141e8 100644 --- a/src/batBytes.mliv +++ b/src/batBytes.mliv @@ -197,12 +197,22 @@ val index : t -> char -> int Raise [Not_found] if [c] does not occur in [s]. *) +##V>=4.5##val index_opt: bytes -> char -> int option +##V>=4.5##(** [index_opt s c] returns the index of the first occurrence of byte [c] +##V>=4.5## in [s] or [None] if [c] does not occur in [s]. +##V>=4.5## @since 4.05 *) + 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]. *) +##V>=4.5##val rindex_opt: bytes -> char -> int option +##V>=4.5##(** [rindex_opt s c] returns the index of the last occurrence of byte [c] +##V>=4.5## in [s] or [None] if [c] does not occur in [s]. +##V>=4.5## @since 4.05 *) + 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]. *) +##V>=4.5##val index_from_opt: bytes -> int -> char -> int option +##V>=4.5##(** [index_from _opts i c] returns the index of the first occurrence of +##V>=4.5## byte [c] in [s] after position [i] or [None] if [c] does not occur in [s] after position [i]. +##V>=4.5## [Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c]. +##V>=4.5## +##V>=4.5## Raise [Invalid_argument] if [i] is not a valid position in [s]. +##V>=4.5## @since 4.05 *) + 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]. *) +##V>=4.5##val rindex_from_opt: bytes -> int -> char -> int option +##V>=4.5##(** [rindex_from_opt s i c] returns the index of the last occurrence +##V>=4.5## of byte [c] in [s] before position [i+1] or [None] if [c] does not +##V>=4.5## occur in [s] before position [i+1]. [rindex_opt s c] is equivalent to +##V>=4.5## [rindex_from s (Bytes.length s - 1) c]. +##V>=4.5## +##V>=4.5## Raise [Invalid_argument] if [i+1] is not a valid position in [s]. +##V>=4.5## @since 4.05 *) + val contains : t -> char -> bool (** [contains s c] tests if byte [c] appears in [s]. *) diff --git a/src/batInt32.mliv b/src/batInt32.mliv index ee6173558..661ecff33 100644 --- a/src/batInt32.mliv +++ b/src/batInt32.mliv @@ -193,6 +193,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]. *) +##V>=4.5##val of_string_opt: string -> int32 option +##V>=4.5##(** Same as [of_string], but return [None] instead of raising. +##V>=4.5## @since 4.05 *) + val to_string : int32 -> string (** Return the string representation of its argument, in signed decimal. *) diff --git a/src/batInt32.mlv b/src/batInt32.mlv index 85bcd8306..52abadd32 100644 --- a/src/batInt32.mlv +++ b/src/batInt32.mlv @@ -146,6 +146,7 @@ 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 external of_int64 : int64 -> int32 = "%int64_to_int32" external to_int64 : int32 -> int64 = "%int64_of_int32" external of_nativeint : nativeint -> int32 = "%int32_of_nativeint" diff --git a/src/batInt64.mliv b/src/batInt64.mliv index 15c8f724d..22350d0bb 100644 --- a/src/batInt64.mliv +++ b/src/batInt64.mliv @@ -191,6 +191,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]. *) +##V>=4.5##val of_string_opt: string -> int64 option +##V>=4.5##(** Same as [of_string], but return [None] instead of raising. +##V>=4.5## @since 4.05 *) + val to_string : int64 -> string (** Return the string representation of its argument, in decimal. *) diff --git a/src/batInt64.mlv b/src/batInt64.mlv index 93b00aec1..3554f2258 100644 --- a/src/batInt64.mlv +++ b/src/batInt64.mlv @@ -56,6 +56,7 @@ 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 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" diff --git a/src/batList.mli b/src/batList.mliv similarity index 94% rename from src/batList.mli rename to src/batList.mliv index da70a40a5..047394769 100644 --- a/src/batList.mli +++ b/src/batList.mliv @@ -91,10 +91,29 @@ val last : 'a list -> 'a val length : 'a list -> int (** Return the length (number of elements) of the given list. *) +##V>=4.5##val compare_lengths : 'a list -> 'b list -> int +##V>=4.5##(** Compare the lengths of two lists. [compare_lengths l1 l2] is +##V>=4.5## equivalent to [compare (length l1) (length l2)], except that +##V>=4.5## the computation stops after itering on the shortest list. +##V>=4.5## @since 4.05.0 +##V>=4.5## *) + +##V>=4.5##val compare_length_with : 'a list -> int -> int +##V>=4.5##(** Compare the length of a list to an integer. [compare_length_with l n] is +##V>=4.5## equivalent to [compare (length l) n], except that +##V>=4.5## the computation stops after at most [n] iterations on the list. +##V>=4.5## @since 4.05.0 +##V>=4.5##*) + 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) *) +##V>=4.5##val at_opt : 'a list -> int -> 'a option +##V>=4.5##(** [at_opt] returns the n-th element of the list [l] or None if the index is +##V>=4.5## beyond the length of [l]. +##V>=4.5## @raise Invalid_argument if the index is negative *) + val rev : 'a list -> 'a list (** List reversal. *) @@ -408,6 +427,12 @@ val find : ('a -> bool) -> 'a list -> 'a @raise Not_found if there is no value that satisfies [p] in the list [l]. *) +##V>=4.5##val find_opt: ('a -> bool) -> 'a list -> 'a option +##V>=4.5##(** [find_opt p l] returns the first element of the list [l] that +##V>=4.5## satisfies the predicate [p], or [None] if there is no value that +##V>=4.5## satisfies [p] in the list [l]. +##V>=4.5## @since 4.05 *) + 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. *) @@ -530,6 +555,15 @@ val assoc : 'a -> ('a * 'b) list -> 'b @raise Not_found if there is no value associated with [a] in the list [l]. *) +##V>=4.5##val assoc_opt: 'a -> ('a * 'b) list -> 'b option +##V>=4.5##(** [assoc_opt a l] returns the value associated with key [a] in the list of +##V>=4.5## pairs [l]. That is, +##V>=4.5## [assoc_opt a [ ...; (a,b); ...] = b] +##V>=4.5## if [(a,b)] is the leftmost binding of [a] in list [l]. +##V>=4.5## Returns [None] if there is no value associated with [a] in the +##V>=4.5## list [l]. +##V>=4.5## @since 4.05 *) + 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] @@ -550,6 +584,11 @@ val assq : 'a -> ('a * 'b) list -> 'b (** Same as {!List.assoc}, but uses physical equality instead of structural equality to compare keys. *) +##V>=4.5##val assq_opt : 'a -> ('a * 'b) list -> 'b option +##V>=4.5##(** Same as {!List.assoc_opt}, but uses physical equality instead of structural +##V>=4.5## equality to compare keys. +##V>=4.5## @since 4.05 *) + val assq_inv : 'b -> ('a * 'b) list -> 'a (** Same as {!List.assoc_inv}, but uses physical equality instead of structural equality to compare keys. *) @@ -868,6 +907,14 @@ module Comp (T : Comp) : Comp with type t = T.t list val nth : 'a list -> int -> 'a (** Obsolete. As [at]. *) +##V>=4.5##val nth_opt: 'a list -> int -> 'a option +##V>=4.5##(** Return the [n]-th element of the given list. +##V>=4.5## The first element (head of the list) is at position 0. +##V>=4.5## Return [None] if the list is too short. +##V>=4.5## Raise [Invalid_argument "List.nth"] if [n] is negative. +##V>=4.5## @since 4.05 +##V>=4.5##*) + val takewhile : ('a -> bool) -> 'a list -> 'a list (** obsolete, as {!take_while} *) diff --git a/src/batList.mlv b/src/batList.mlv index ca3d9d046..0697f5a66 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -28,8 +28,11 @@ 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 let assoc = List.assoc +##V>=4.5##let assoc_opt = List.assoc_opt let find = List.find +##V>=4.5##let find_opt = List.find_opt let exists = List.exists let for_all = List.for_all let fold_left = List.fold_left @@ -38,6 +41,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 @@ -101,6 +106,15 @@ let at = nth at [1;2;3] 2 = 3 *) +##V>=4.5##let at_opt l index = +##V>=4.5## if index < 0 then invalid_arg at_negative_index_msg; +##V>=4.5## try Some (at l index) with Invalid_argument _ -> None +##V>=4.5##(*$T at_opt +##V>=4.5## at_opt [] 0 = None +##V>=4.5## try ignore (at_opt [1;2;3] (-1)); false with Invalid_argument _ -> true +##V>=4.5## at_opt [1;2;3] 2 = Some 3 +##V>=4.5##*) + let mem_cmp cmp x l = exists (fun y -> cmp x y = 0) l @@ -357,6 +371,7 @@ let group_consecutive p l = (group_consecutive (=) [2; 2]) [[2; 2]] *) +##V>=4.5##let nth_opt = List.nth_opt let takewhile = take_while let dropwhile = drop_while diff --git a/src/batNativeint.mliv b/src/batNativeint.mliv index b37545f5c..38fe6685d 100644 --- a/src/batNativeint.mliv +++ b/src/batNativeint.mliv @@ -204,6 +204,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]. *) +##V>=4.5##val of_string_opt: string -> nativeint option +##V>=4.5##(** Same as [of_string], but return [None] instead of raising. +##V>=4.5## @since 4.05 *) + val to_string : nativeint -> string (** Return the string representation of its argument, in decimal. *) diff --git a/src/batNativeint.mlv b/src/batNativeint.mlv index fd8ea6852..cb0cbe370 100644 --- a/src/batNativeint.mlv +++ b/src/batNativeint.mlv @@ -73,6 +73,7 @@ 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 external format : string -> nativeint -> string = "caml_nativeint_format" diff --git a/src/batPrintexc.mliv b/src/batPrintexc.mliv index c756dafc7..2d5257fd1 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 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 diff --git a/src/batString.mliv b/src/batString.mliv index 43519dd47..f32cb0df8 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -199,12 +199,24 @@ val index : string -> char -> int @raise Not_found if [c] does not occur in [s]. *) +##V>=4.5##val index_opt: string -> char -> int option +##V>=4.5##(** [String.index_opt s c] returns the index of the first +##V>=4.5## occurrence of character [c] in string [s], or +##V>=4.5## [None] if [c] does not occur in [s]. +##V>=4.5## @since 4.05 *) + 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]. *) +##V>=4.5##val rindex_opt: string -> char -> int option +##V>=4.5##(** [String.rindex_opt s c] returns the index of the last occurrence +##V>=4.5## of character [c] in string [s], or [None] if [c] does not occur in +##V>=4.5## [s]. +##V>=4.5## @since 4.05 *) + 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]. @@ -213,6 +225,17 @@ val index_from : string -> 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]. *) +##V>=4.5##val index_from_opt: string -> int -> char -> int option +##V>=4.5##(** [String.index_from_opt s i c] returns the index of the +##V>=4.5## first occurrence of character [c] in string [s] after position [i] +##V>=4.5## or [None] if [c] does not occur in [s] after position [i]. +##V>=4.5## +##V>=4.5## [String.index_opt s c] is equivalent to [String.index_from_opt s 0 c]. +##V>=4.5## Raise [Invalid_argument] if [i] is not a valid position in [s]. +##V>=4.5## +##V>=4.5## @since 4.05 +##V>=4.5##*) + 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 +245,19 @@ 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]. *) +##V>=4.5##val rindex_from_opt: string -> int -> char -> int option +##V>=4.5##(** [String.rindex_from_opt s i c] returns the index of the +##V>=4.5## last occurrence of character [c] in string [s] before position [i+1] +##V>=4.5## or [None] if [c] does not occur in [s] before position [i+1]. +##V>=4.5## +##V>=4.5## [String.rindex_opt s c] is equivalent to +##V>=4.5## [String.rindex_from_opt s (String.length s - 1) c]. +##V>=4.5## +##V>=4.5## Raise [Invalid_argument] if [i+1] is not a valid position in [s]. +##V>=4.5## +##V>=4.5## @since 4.05 +##V>=4.5##*) + val contains : string -> char -> bool (** [String.contains s c] tests if character [c] appears in the string [s]. *) diff --git a/src/batSys.mliv b/src/batSys.mliv index 44ac36c11..6fc2d605d 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. *) +##V>=4.5##val getenv_opt: string -> string option +##V>=4.5##(** Return the value associated to a variable in the process +##V>=4.5## environment or [None] if the variable is unbound. +##V>=4.5## @since 4.05 +##V>=4.5##*) + external command : string -> int = "caml_sys_system_command" (** Execute the given shell command and return its exit code. *) From a0bcb16c43ecbf99e0dfaa0f35e6cf395a78b533 Mon Sep 17 00:00:00 2001 From: Tej Chajed Date: Fri, 11 Aug 2017 14:24:20 +0100 Subject: [PATCH 080/273] Update for compatibility with qcheck 0.6 Unfortunately this does break backwards compatibility with qcheck 0.5, so there is now an explicit opam dependency on qcheck >= 0.6. Fixes #756. --- opam | 3 ++- src/batArray.mlv | 20 ++++++++++---------- src/batList.mlv | 4 ++-- 3 files changed, 14 insertions(+), 13 deletions(-) diff --git a/opam b/opam index 8190b1749..41b95f513 100644 --- a/opam +++ b/opam @@ -20,7 +20,8 @@ remove: [["ocamlfind" "remove" "batteries"]] depends: [ "ocamlfind" {>= "1.5.3"} "ocamlbuild" {build} - "qtest" {test & >= "2.0.0" & < "2.5"} + "qtest" {test & >= "2.0.0"} + "qcheck" {test & >= "0.6"} "bisect" {test} ] available: [ diff --git a/src/batArray.mlv b/src/batArray.mlv index c6e59d209..005c4df03 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.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 \ @@ -217,7 +217,7 @@ let filter p xs = assert false (*BISECT-VISIT*) ) (*$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') \ @@ -276,7 +276,7 @@ let partition p xs = r) in xs1, xs2 (*$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 \ @@ -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.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 \ @@ -661,8 +661,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 = @@ -670,8 +670,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 = diff --git a/src/batList.mlv b/src/batList.mlv index ca3d9d046..715c381d0 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -172,8 +172,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 From 9b5676fd2023c1cbdc3a5fcffece59f2ecbf5a28 Mon Sep 17 00:00:00 2001 From: Tej Chajed Date: Sat, 12 Aug 2017 17:23:29 +0100 Subject: [PATCH 081/273] Simplify dependency restriction on qtest --- opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/opam b/opam index 41b95f513..636532e91 100644 --- a/opam +++ b/opam @@ -20,7 +20,7 @@ remove: [["ocamlfind" "remove" "batteries"]] depends: [ "ocamlfind" {>= "1.5.3"} "ocamlbuild" {build} - "qtest" {test & >= "2.0.0"} + "qtest" {test & >= "2.5"} "qcheck" {test & >= "0.6"} "bisect" {test} ] From 151a06f81500d8aec22af6df04668788eafe1985 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 30 Jul 2017 15:15:21 +0200 Subject: [PATCH 082/273] batText: add tests and fix a bug in `rindex{,_from}` --- ChangeLog | 4 ++++ src/batText.ml | 23 ++++++++++++++++++++--- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index a17f051f7..e3490fdb6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -33,6 +33,10 @@ Changelog #770 (Varun Gandhi) +- fix return value of BatText.rindex{,_from} + #TODO + (Gabriel Scherer) + ## v2.6.0 (minor release) - added Bat{Set,Map,Splay}.any and fixed Bat{Map,Splay}.choose diff --git a/src/batText.ml b/src/batText.ml index 6fcdba4bd..92e81424a 100644 --- a/src/batText.ml +++ b/src/batText.ml @@ -492,7 +492,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 +670,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,6 +695,12 @@ 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 -> From 0c0987b1e44abb6c81d3730105e494d9afe9c4b7 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 30 Jul 2017 19:05:17 +0200 Subject: [PATCH 083/273] batText: add tests for contains_from and fix documentation bug (exception name) --- src/batText.ml | 9 +++++++++ src/batText.mli | 4 ++-- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/src/batText.ml b/src/batText.ml index 92e81424a..ab0352e51 100644 --- a/src/batText.ml +++ b/src/batText.ml @@ -707,6 +707,15 @@ let contains_from r start char = 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 diff --git a/src/batText.mli b/src/batText.mli index 0148b5d4b..1df5fc27e 100644 --- a/src/batText.mli +++ b/src/batText.mli @@ -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]. *) + @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 From 007308eedad42bafe4f98ea3ef209420a68eca7f Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 30 Jul 2017 19:08:59 +0200 Subject: [PATCH 084/273] batText: add tests to rcontains_from and fix bug in passing --- ChangeLog | 2 +- src/batText.ml | 15 ++++++++++++++- src/batText.mli | 2 +- 3 files changed, 16 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index e3490fdb6..b2ed5ba09 100644 --- a/ChangeLog +++ b/ChangeLog @@ -33,7 +33,7 @@ Changelog #770 (Varun Gandhi) -- fix return value of BatText.rindex{,_from} +- BatText: bugfixes in `rindex{,_from}` and `rcontains_from` #TODO (Gabriel Scherer) diff --git a/src/batText.ml b/src/batText.ml index ab0352e51..27166077d 100644 --- a/src/batText.ml +++ b/src/batText.ml @@ -717,7 +717,20 @@ let contains_from r start char = 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 diff --git a/src/batText.mli b/src/batText.mli index 1df5fc27e..4306c8cb9 100644 --- a/src/batText.mli +++ b/src/batText.mli @@ -288,7 +288,7 @@ val contains_from : t -> int -> BatUChar.t -> bool 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]. + of [s] to index [stop] (included). @raise Out_of_bounds if [stop] is not a valid index of [s]. *) val find : t -> t -> int From df8f3f468e21e9ad5908e75cbd8017c1c5c6f1b6 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 13 Aug 2017 19:52:18 +0200 Subject: [PATCH 085/273] battext changes: ChangeLog entry --- ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index b2ed5ba09..8bc9eb4c4 100644 --- a/ChangeLog +++ b/ChangeLog @@ -34,7 +34,7 @@ Changelog (Varun Gandhi) - BatText: bugfixes in `rindex{,_from}` and `rcontains_from` - #TODO + #775 (Gabriel Scherer) ## v2.6.0 (minor release) From 407bb5fc856eccbacdb1d06970f39423a1d92bc7 Mon Sep 17 00:00:00 2001 From: Anton Yabchinskiy Date: Mon, 14 Aug 2017 00:05:22 +0300 Subject: [PATCH 086/273] batNum: handle negatives in of_float_string --- src/batNum.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/batNum.ml b/src/batNum.ml index e6de91add..b3dfed114 100644 --- a/src/batNum.ml +++ b/src/batNum.ml @@ -104,11 +104,13 @@ let of_float_string a = let frac = pow num10 (of_int (String.length fpart_s)) in Infix.(fpart/frac) in - add ipart fpart + if lt_num ipart zero then sub ipart fpart + else add ipart fpart with Not_found -> of_string a (**T of_float_string "2.5" = of_string "5/2" + of_float_string "-2.5" = of_string "-5/2" of_float_string "2." = of_string "2" of_float_string ".5" = of_string "1/2" *) From ed11ab6c12ca9b2aac919216c0edeb116212b823 Mon Sep 17 00:00:00 2001 From: Anton Yabchinskiy Date: Mon, 14 Aug 2017 02:04:15 +0300 Subject: [PATCH 087/273] ChangeLog entry on BatNum.of_float_string --- ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ChangeLog b/ChangeLog index 8bc9eb4c4..08cb152ef 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,10 @@ Changelog ## next minor release +- BatNum: fix of_float_string to handle negative numbers properly + #780 + (Anton Yabchinskiy) + - added BatArray.min_max #757 (Francois Berenger) From 749993109aed501b9d68c75794e962e31fb0c541 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 14 Aug 2017 02:41:30 +0200 Subject: [PATCH 088/273] BatNum.of_float_string: extra testcase --- src/batNum.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/batNum.ml b/src/batNum.ml index b3dfed114..721269579 100644 --- a/src/batNum.ml +++ b/src/batNum.ml @@ -111,6 +111,7 @@ let of_float_string a = (**T of_float_string "2.5" = of_string "5/2" of_float_string "-2.5" = of_string "-5/2" + of_float_string "-2.1" = of_string "-21/10" of_float_string "2." = of_string "2" of_float_string ".5" = of_string "1/2" *) From d2f0d519434646df0293703c661061439ce87888 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 14 Aug 2017 11:23:42 +0200 Subject: [PATCH 089/273] Backport new 4.05 functions (#779) * Backport the new option-returning *_opt functions from 4.05.0 * Bigarray.Array0 cannot be backported from 4.05 (it depends on a runtime change) * batList: backport compare_length{s,_with} to <4.5 versions * Printexc.raise_with_backtrace cannot be backported from 4.05 This is a new primitive from the runtime. * Change entry for #777, #779 --- ChangeLog | 7 +++ src/batBig_int.mliv | 58 +++++++++---------- src/{batBig_int.ml => batBig_int.mlv} | 8 +++ src/batBigarray.mliv | 10 ++-- src/batBytes.mliv | 46 +++++++-------- src/batBytes.mlv | 6 ++ src/batInt32.mliv | 6 +- src/batInt32.mlv | 1 + src/batInt64.mliv | 6 +- src/batInt64.mlv | 1 + src/batList.mliv | 83 ++++++++++++++------------- src/batList.mlv | 63 +++++++++++++++++--- src/batNativeint.mliv | 6 +- src/batNativeint.mlv | 1 + src/batPrintexc.mliv | 2 +- src/batString.mliv | 64 ++++++++++----------- src/batString.mlv | 5 ++ src/batSys.mliv | 10 ++-- src/batSys.mlv | 2 + 19 files changed, 232 insertions(+), 153 deletions(-) rename src/{batBig_int.ml => batBig_int.mlv} (94%) diff --git a/ChangeLog b/ChangeLog index 08cb152ef..f0a2cc6b4 100644 --- a/ChangeLog +++ b/ChangeLog @@ -41,6 +41,13 @@ Changelog #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 diff --git a/src/batBig_int.mliv b/src/batBig_int.mliv index 2cfec4a8e..1766b73a7 100644 --- a/src/batBig_int.mliv +++ b/src/batBig_int.mliv @@ -180,13 +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. *) -##V>=4.5##val big_int_of_string_opt: string -> big_int option -##V>=4.5##(** Convert a string to a big integer, in decimal. -##V>=4.5## The string consists of an optional [-] or [+] sign, -##V>=4.5## followed by one or several decimal digits. Other the function -##V>=4.5## returns [None]. -##V>=4.5## @since 4.05 -##V>=4.5##*) +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 NEXT_RELEASE +*) val to_string_in_binary : big_int -> string (** as [string_of_big_int], but in base 2 *) @@ -249,12 +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. *) -##V>=4.5##val int_of_big_int_opt: big_int -> int option -##V>=4.5##(** Convert a big integer to a small integer (type [int]). Return -##V>=4.5## [None] if the big integer is not representable as a small -##V>=4.5## integer. -##V>=4.5## @since 4.05 -##V>=4.5##*) +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 NEXT_RELEASE +*) val big_int_of_int32 : int32 -> big_int (** Convert a 32-bit integer to a big integer. *) @@ -266,30 +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]]. *) -##V>=4.5##val int32_of_big_int_opt: big_int -> int32 option -##V>=4.5##(** Convert a big integer to a 32-bit integer. Return [None] if the -##V>=4.5## big integer is outside the range \[-2{^31}, 2{^31}-1\]. -##V>=4.5## @since 4.05 -##V>=4.5##*) +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 NEXT_RELEASE +*) 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]]. *) -##V>=4.5##val nativeint_of_big_int_opt: big_int -> nativeint option -##V>=4.5##(** Convert a big integer to a native integer. Return [None] if the -##V>=4.5## big integer is outside the range [[Nativeint.min_int, -##V>=4.5## Nativeint.max_int]]; -##V>=4.5## @since 4.05 -##V>=4.5##*) +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 NEXT_RELEASE +*) 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]]. *) -##V>=4.5##val int64_of_big_int_opt: big_int -> int64 option -##V>=4.5##(** Convert a big integer to a 64-bit integer. Return [None] if the -##V>=4.5## big integer is outside the range \[-2{^63}, 2{^63}-1\]. -##V>=4.5## @since 4.05 -##V>=4.5##*) +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 NEXT_RELEASE +*) val float_of_big_int : big_int -> float (** Returns a floating-point number approximating the diff --git a/src/batBig_int.ml b/src/batBig_int.mlv similarity index 94% rename from src/batBig_int.ml rename to src/batBig_int.mlv index cc2dc1eb4..0e4279c2f 100644 --- a/src/batBig_int.ml +++ b/src/batBig_int.mlv @@ -19,6 +19,7 @@ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) + 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 @@ -172,3 +173,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 bdd859600..e369186eb 100644 --- a/src/batBigarray.mliv +++ b/src/batBigarray.mliv @@ -567,7 +567,7 @@ end ##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 4.05.0 *) +##V>=4.5## @since NEXT_RELEASE 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 @@ -680,7 +680,7 @@ module Array1 : sig ##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 4.05.0 *) +##V>=4.5## @since NEXT_RELEASE and OCaml 4.05.0 *) external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit" @@ -1084,7 +1084,7 @@ end ##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 4.05.0 *) +##V>=4.5## big array. @since NEXT_RELEASE and OCaml 4.05.0 *) external genarray_of_array1 : ('a, 'b, 'c) Array1.t -> ('a, 'b, 'c) Genarray.t = "%identity" @@ -1105,7 +1105,7 @@ external genarray_of_array3 : ##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 4.05.0 *) +##V>=4.5## @since NEXT_RELEASE 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 @@ -1144,7 +1144,7 @@ val reshape : ('a, 'b, 'c) Genarray.t -> int array -> ('a, 'b, 'c) Genarray.t ##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 4.05.0 *) +##V>=4.5## @since NEXT_RELEASE 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 diff --git a/src/batBytes.mliv b/src/batBytes.mliv index 4f61141e8..49df483e3 100644 --- a/src/batBytes.mliv +++ b/src/batBytes.mliv @@ -197,10 +197,10 @@ val index : t -> char -> int Raise [Not_found] if [c] does not occur in [s]. *) -##V>=4.5##val index_opt: bytes -> char -> int option -##V>=4.5##(** [index_opt s c] returns the index of the first occurrence of byte [c] -##V>=4.5## in [s] or [None] if [c] does not occur in [s]. -##V>=4.5## @since 4.05 *) +val index_opt: bytes -> 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 NEXT_RELEASE *) val rindex : t -> char -> int (** [rindex s c] returns the index of the last occurrence of byte [c] @@ -208,10 +208,10 @@ val rindex : t -> char -> int Raise [Not_found] if [c] does not occur in [s]. *) -##V>=4.5##val rindex_opt: bytes -> char -> int option -##V>=4.5##(** [rindex_opt s c] returns the index of the last occurrence of byte [c] -##V>=4.5## in [s] or [None] if [c] does not occur in [s]. -##V>=4.5## @since 4.05 *) +val rindex_opt: bytes -> 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 NEXT_RELEASE *) val index_from : t -> int -> char -> int (** [index_from s i c] returns the index of the first occurrence of @@ -221,13 +221,13 @@ 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]. *) -##V>=4.5##val index_from_opt: bytes -> int -> char -> int option -##V>=4.5##(** [index_from _opts i c] returns the index of the first occurrence of -##V>=4.5## byte [c] in [s] after position [i] or [None] if [c] does not occur in [s] after position [i]. -##V>=4.5## [Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c]. -##V>=4.5## -##V>=4.5## Raise [Invalid_argument] if [i] is not a valid position in [s]. -##V>=4.5## @since 4.05 *) +val index_from_opt: bytes -> 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 NEXT_RELEASE *) val rindex_from : t -> int -> char -> int (** [rindex_from s i c] returns the index of the last occurrence of @@ -237,14 +237,14 @@ 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]. *) -##V>=4.5##val rindex_from_opt: bytes -> int -> char -> int option -##V>=4.5##(** [rindex_from_opt s i c] returns the index of the last occurrence -##V>=4.5## of byte [c] in [s] before position [i+1] or [None] if [c] does not -##V>=4.5## occur in [s] before position [i+1]. [rindex_opt s c] is equivalent to -##V>=4.5## [rindex_from s (Bytes.length s - 1) c]. -##V>=4.5## -##V>=4.5## Raise [Invalid_argument] if [i+1] is not a valid position in [s]. -##V>=4.5## @since 4.05 *) +val rindex_from_opt: bytes -> 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 NEXT_RELEASE *) val contains : t -> char -> bool (** [contains s c] tests if byte [c] appears in [s]. *) diff --git a/src/batBytes.mlv b/src/batBytes.mlv index 76698c090..23aaf993d 100644 --- a/src/batBytes.mlv +++ b/src/batBytes.mlv @@ -74,3 +74,9 @@ include Bytes equal ("Five" |> of_string |> uncapitalize_ascii |> to_string) "five" 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 diff --git a/src/batInt32.mliv b/src/batInt32.mliv index 661ecff33..d8ba4a0f8 100644 --- a/src/batInt32.mliv +++ b/src/batInt32.mliv @@ -193,9 +193,9 @@ 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]. *) -##V>=4.5##val of_string_opt: string -> int32 option -##V>=4.5##(** Same as [of_string], but return [None] instead of raising. -##V>=4.5## @since 4.05 *) +val of_string_opt: string -> int32 option +(** Same as [of_string], but return [None] instead of raising. + @since NEXT_RELEASE *) val to_string : int32 -> string (** Return the string representation of its argument, in signed decimal. *) diff --git a/src/batInt32.mlv b/src/batInt32.mlv index 52abadd32..e2b884bee 100644 --- a/src/batInt32.mlv +++ b/src/batInt32.mlv @@ -147,6 +147,7 @@ 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" diff --git a/src/batInt64.mliv b/src/batInt64.mliv index 22350d0bb..7308efb82 100644 --- a/src/batInt64.mliv +++ b/src/batInt64.mliv @@ -191,9 +191,9 @@ 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]. *) -##V>=4.5##val of_string_opt: string -> int64 option -##V>=4.5##(** Same as [of_string], but return [None] instead of raising. -##V>=4.5## @since 4.05 *) +val of_string_opt: string -> int64 option +(** Same as [of_string], but return [None] instead of raising. + @since NEXT_RELEASE *) val to_string : int64 -> string (** Return the string representation of its argument, in decimal. *) diff --git a/src/batInt64.mlv b/src/batInt64.mlv index 3554f2258..c650d686e 100644 --- a/src/batInt64.mlv +++ b/src/batInt64.mlv @@ -57,6 +57,7 @@ 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" diff --git a/src/batList.mliv b/src/batList.mliv index 047394769..fb67d1f2b 100644 --- a/src/batList.mliv +++ b/src/batList.mliv @@ -91,28 +91,29 @@ val last : 'a list -> 'a val length : 'a list -> int (** Return the length (number of elements) of the given list. *) -##V>=4.5##val compare_lengths : 'a list -> 'b list -> int -##V>=4.5##(** Compare the lengths of two lists. [compare_lengths l1 l2] is -##V>=4.5## equivalent to [compare (length l1) (length l2)], except that -##V>=4.5## the computation stops after itering on the shortest list. -##V>=4.5## @since 4.05.0 -##V>=4.5## *) - -##V>=4.5##val compare_length_with : 'a list -> int -> int -##V>=4.5##(** Compare the length of a list to an integer. [compare_length_with l n] is -##V>=4.5## equivalent to [compare (length l) n], except that -##V>=4.5## the computation stops after at most [n] iterations on the list. -##V>=4.5## @since 4.05.0 -##V>=4.5##*) +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 NEXT_RELEASE + *) + +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 NEXT_RELEASE +*) 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) *) -##V>=4.5##val at_opt : 'a list -> int -> 'a option -##V>=4.5##(** [at_opt] returns the n-th element of the list [l] or None if the index is -##V>=4.5## beyond the length of [l]. -##V>=4.5## @raise Invalid_argument if the index is negative *) +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 NEXT_RELEASE + @raise Invalid_argument if the index is negative *) val rev : 'a list -> 'a list (** List reversal. *) @@ -427,11 +428,11 @@ val find : ('a -> bool) -> 'a list -> 'a @raise Not_found if there is no value that satisfies [p] in the list [l]. *) -##V>=4.5##val find_opt: ('a -> bool) -> 'a list -> 'a option -##V>=4.5##(** [find_opt p l] returns the first element of the list [l] that -##V>=4.5## satisfies the predicate [p], or [None] if there is no value that -##V>=4.5## satisfies [p] in the list [l]. -##V>=4.5## @since 4.05 *) +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 NEXT_RELEASE *) val find_exn : ('a -> bool) -> exn -> 'a list -> 'a (** [find_exn p e l] returns the first element of [l] such as [p x] @@ -555,14 +556,14 @@ val assoc : 'a -> ('a * 'b) list -> 'b @raise Not_found if there is no value associated with [a] in the list [l]. *) -##V>=4.5##val assoc_opt: 'a -> ('a * 'b) list -> 'b option -##V>=4.5##(** [assoc_opt a l] returns the value associated with key [a] in the list of -##V>=4.5## pairs [l]. That is, -##V>=4.5## [assoc_opt a [ ...; (a,b); ...] = b] -##V>=4.5## if [(a,b)] is the leftmost binding of [a] in list [l]. -##V>=4.5## Returns [None] if there is no value associated with [a] in the -##V>=4.5## list [l]. -##V>=4.5## @since 4.05 *) +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 NEXT_RELEASE *) val assoc_inv : 'b -> ('a * 'b) list -> 'a (** [assoc_inv b l] returns the key associated with value [b] in the list of @@ -584,10 +585,10 @@ val assq : 'a -> ('a * 'b) list -> 'b (** Same as {!List.assoc}, but uses physical equality instead of structural equality to compare keys. *) -##V>=4.5##val assq_opt : 'a -> ('a * 'b) list -> 'b option -##V>=4.5##(** Same as {!List.assoc_opt}, but uses physical equality instead of structural -##V>=4.5## equality to compare keys. -##V>=4.5## @since 4.05 *) +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 NEXT_RELEASE *) val assq_inv : 'b -> ('a * 'b) list -> 'a (** Same as {!List.assoc_inv}, but uses physical equality instead of structural @@ -907,13 +908,13 @@ module Comp (T : Comp) : Comp with type t = T.t list val nth : 'a list -> int -> 'a (** Obsolete. As [at]. *) -##V>=4.5##val nth_opt: 'a list -> int -> 'a option -##V>=4.5##(** Return the [n]-th element of the given list. -##V>=4.5## The first element (head of the list) is at position 0. -##V>=4.5## Return [None] if the list is too short. -##V>=4.5## Raise [Invalid_argument "List.nth"] if [n] is negative. -##V>=4.5## @since 4.05 -##V>=4.5##*) +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 NEXT_RELEASE +*) val takewhile : ('a -> bool) -> 'a list -> 'a list (** obsolete, as {!take_while} *) diff --git a/src/batList.mlv b/src/batList.mlv index 9e27569c1..9208b7659 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -29,10 +29,13 @@ 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 @@ -52,6 +55,49 @@ let mem_assoc = List.mem_assoc let rev_map2 = List.rev_map2 (* ::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; @@ -106,14 +152,14 @@ let at = nth at [1;2;3] 2 = 3 *) -##V>=4.5##let at_opt l index = -##V>=4.5## if index < 0 then invalid_arg at_negative_index_msg; -##V>=4.5## try Some (at l index) with Invalid_argument _ -> None -##V>=4.5##(*$T at_opt -##V>=4.5## at_opt [] 0 = None -##V>=4.5## try ignore (at_opt [1;2;3] (-1)); false with Invalid_argument _ -> true -##V>=4.5## at_opt [1;2;3] 2 = Some 3 -##V>=4.5##*) +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 @@ -372,6 +418,7 @@ let group_consecutive p l = *) ##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 diff --git a/src/batNativeint.mliv b/src/batNativeint.mliv index 38fe6685d..8d072aada 100644 --- a/src/batNativeint.mliv +++ b/src/batNativeint.mliv @@ -204,9 +204,9 @@ 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]. *) -##V>=4.5##val of_string_opt: string -> nativeint option -##V>=4.5##(** Same as [of_string], but return [None] instead of raising. -##V>=4.5## @since 4.05 *) +val of_string_opt: string -> nativeint option +(** Same as [of_string], but return [None] instead of raising. + @since NEXT_RELEASE *) val to_string : nativeint -> string (** Return the string representation of its argument, in decimal. *) diff --git a/src/batNativeint.mlv b/src/batNativeint.mlv index cb0cbe370..3df1935d9 100644 --- a/src/batNativeint.mlv +++ b/src/batNativeint.mlv @@ -74,6 +74,7 @@ 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" diff --git a/src/batPrintexc.mliv b/src/batPrintexc.mliv index 2d5257fd1..7880a90ce 100644 --- a/src/batPrintexc.mliv +++ b/src/batPrintexc.mliv @@ -112,7 +112,7 @@ val print : _ BatInnerIO.output -> exn -> unit ##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 4.05.0 +##V>=4.5## @since NEXT_RELEASE and OCaml 4.05.0 ##V>=4.5##*) ##V=4.1##(** {6 Current call stack} *) diff --git a/src/batString.mliv b/src/batString.mliv index f32cb0df8..e2679a09d 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -199,11 +199,11 @@ val index : string -> char -> int @raise Not_found if [c] does not occur in [s]. *) -##V>=4.5##val index_opt: string -> char -> int option -##V>=4.5##(** [String.index_opt s c] returns the index of the first -##V>=4.5## occurrence of character [c] in string [s], or -##V>=4.5## [None] if [c] does not occur in [s]. -##V>=4.5## @since 4.05 *) +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 NEXT_RELEASE *) val rindex : string -> char -> int (** [String.rindex s c] returns the character number of the last @@ -211,11 +211,11 @@ val rindex : string -> char -> int @raise Not_found if [c] does not occur in [s]. *) -##V>=4.5##val rindex_opt: string -> char -> int option -##V>=4.5##(** [String.rindex_opt s c] returns the index of the last occurrence -##V>=4.5## of character [c] in string [s], or [None] if [c] does not occur in -##V>=4.5## [s]. -##V>=4.5## @since 4.05 *) +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 NEXT_RELEASE *) val index_from : string -> int -> char -> int (** [String.index_from s i c] returns the character number of the @@ -225,16 +225,16 @@ val index_from : string -> 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]. *) -##V>=4.5##val index_from_opt: string -> int -> char -> int option -##V>=4.5##(** [String.index_from_opt s i c] returns the index of the -##V>=4.5## first occurrence of character [c] in string [s] after position [i] -##V>=4.5## or [None] if [c] does not occur in [s] after position [i]. -##V>=4.5## -##V>=4.5## [String.index_opt s c] is equivalent to [String.index_from_opt s 0 c]. -##V>=4.5## Raise [Invalid_argument] if [i] is not a valid position in [s]. -##V>=4.5## -##V>=4.5## @since 4.05 -##V>=4.5##*) +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 NEXT_RELEASE +*) val rindex_from : string -> int -> char -> int (** [String.rindex_from s i c] returns the character number of the @@ -245,18 +245,18 @@ 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]. *) -##V>=4.5##val rindex_from_opt: string -> int -> char -> int option -##V>=4.5##(** [String.rindex_from_opt s i c] returns the index of the -##V>=4.5## last occurrence of character [c] in string [s] before position [i+1] -##V>=4.5## or [None] if [c] does not occur in [s] before position [i+1]. -##V>=4.5## -##V>=4.5## [String.rindex_opt s c] is equivalent to -##V>=4.5## [String.rindex_from_opt s (String.length s - 1) c]. -##V>=4.5## -##V>=4.5## Raise [Invalid_argument] if [i+1] is not a valid position in [s]. -##V>=4.5## -##V>=4.5## @since 4.05 -##V>=4.5##*) +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 NEXT_RELEASE +*) val contains : string -> char -> bool (** [String.contains s c] tests if character [c] diff --git a/src/batString.mlv b/src/batString.mlv index fefc12e23..8322996ce 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -1080,6 +1080,11 @@ 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 diff --git a/src/batSys.mliv b/src/batSys.mliv index 6fc2d605d..accf642ea 100644 --- a/src/batSys.mliv +++ b/src/batSys.mliv @@ -61,11 +61,11 @@ 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. *) -##V>=4.5##val getenv_opt: string -> string option -##V>=4.5##(** Return the value associated to a variable in the process -##V>=4.5## environment or [None] if the variable is unbound. -##V>=4.5## @since 4.05 -##V>=4.5##*) +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. *) 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 From 396f350501e79b1227acee51bdc4342e4fa935d4 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 14 Aug 2017 12:13:56 +0200 Subject: [PATCH 090/273] batBytes: minor compatibility fix --- src/batBytes.mliv | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/batBytes.mliv b/src/batBytes.mliv index 49df483e3..4f3395c6a 100644 --- a/src/batBytes.mliv +++ b/src/batBytes.mliv @@ -197,7 +197,7 @@ val index : t -> char -> int Raise [Not_found] if [c] does not occur in [s]. *) -val index_opt: bytes -> char -> int option +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 NEXT_RELEASE *) @@ -208,7 +208,7 @@ val rindex : t -> char -> int Raise [Not_found] if [c] does not occur in [s]. *) -val rindex_opt: bytes -> char -> int option +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 NEXT_RELEASE *) @@ -221,7 +221,7 @@ 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: bytes -> int -> char -> int option +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]. @@ -237,7 +237,7 @@ 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: bytes -> int -> char -> int option +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 From 63cbfbca01899fd378ff54d0747d9ff0695558d2 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 16 Aug 2017 01:57:10 +0200 Subject: [PATCH 091/273] release summary (#782) --- ChangeLog | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/ChangeLog b/ChangeLog index f0a2cc6b4..9b99b4070 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,13 @@ Changelog ## next 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) From 7dcff5c7e3649c47a77673f814c0e46230e1a0ee Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 16 Aug 2017 01:57:55 +0200 Subject: [PATCH 092/273] add a "num" dependency to mirror upstream opam file (#783) See https://github.com/ocaml/opam-repository/pull/9341 Note that, if/when "num" is split off the standard distribution, there will be the question of keeping it or not in Batteries. It could be come a separate package (batteries-num, depending on batteries) for example. --- opam | 1 + 1 file changed, 1 insertion(+) diff --git a/opam b/opam index 636532e91..3b8a3c894 100644 --- a/opam +++ b/opam @@ -23,6 +23,7 @@ depends: [ "qtest" {test & >= "2.5"} "qcheck" {test & >= "0.6"} "bisect" {test} + "num" ] available: [ ocaml-version >= "3.12.1" From 94a1128a7ccbcf86673e0f31de80403fa50af04a Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Wed, 16 Aug 2017 09:22:13 +0900 Subject: [PATCH 093/273] next release will be 2.7.0 --- ChangeLog | 2 +- _oasis | 3 +-- src/batBig_int.mliv | 10 +++++----- src/batBigarray.mliv | 10 +++++----- src/batBytes.mliv | 8 ++++---- src/batInt32.mliv | 2 +- src/batInt64.mliv | 2 +- src/batList.mliv | 14 +++++++------- src/batNativeint.mliv | 2 +- src/batPrintexc.mliv | 2 +- src/batString.mliv | 8 ++++---- src/batVect.mli | 4 ++-- 12 files changed, 33 insertions(+), 34 deletions(-) diff --git a/ChangeLog b/ChangeLog index 9b99b4070..4530affe8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,7 +1,7 @@ Changelog --------- -## next minor release +## 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 diff --git a/_oasis b/_oasis index afbf2a446..ca74e8279 100644 --- a/_oasis +++ b/_oasis @@ -1,7 +1,7 @@ OASISFormat: 0.4 OCamlVersion: >= 3.12.1 Name: batteries -Version: 2.6.0 +Version: 2.7.0 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/src/batBig_int.mliv b/src/batBig_int.mliv index 1766b73a7..4ce5b0e04 100644 --- a/src/batBig_int.mliv +++ b/src/batBig_int.mliv @@ -185,7 +185,7 @@ val big_int_of_string_opt: string -> big_int option The string consists of an optional [-] or [+] sign, followed by one or several decimal digits. Other the function returns [None]. - @since NEXT_RELEASE + @since 2.7.0 *) val to_string_in_binary : big_int -> string @@ -253,7 +253,7 @@ 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 NEXT_RELEASE + @since 2.7.0 *) val big_int_of_int32 : int32 -> big_int @@ -269,7 +269,7 @@ val int32_of_big_int : big_int -> int32 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 NEXT_RELEASE + @since 2.7.0 *) val nativeint_of_big_int : big_int -> nativeint (** Convert a big integer to a native integer. @@ -279,7 +279,7 @@ 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 NEXT_RELEASE + @since 2.7.0 *) val int64_of_big_int : big_int -> int64 (** Convert a big integer to a 64-bit integer. @@ -288,7 +288,7 @@ val int64_of_big_int : big_int -> int64 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 NEXT_RELEASE + @since 2.7.0 *) val float_of_big_int : big_int -> float diff --git a/src/batBigarray.mliv b/src/batBigarray.mliv index e369186eb..178ac40d5 100644 --- a/src/batBigarray.mliv +++ b/src/batBigarray.mliv @@ -567,7 +567,7 @@ end ##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 NEXT_RELEASE and OCaml 4.05.0 *) +##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 @@ -680,7 +680,7 @@ module Array1 : sig ##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 NEXT_RELEASE and OCaml 4.05.0 *) +##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" @@ -1084,7 +1084,7 @@ end ##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 NEXT_RELEASE and OCaml 4.05.0 *) +##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" @@ -1105,7 +1105,7 @@ external genarray_of_array3 : ##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 NEXT_RELEASE and OCaml 4.05.0 *) +##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 @@ -1144,7 +1144,7 @@ val reshape : ('a, 'b, 'c) Genarray.t -> int array -> ('a, 'b, 'c) Genarray.t ##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 NEXT_RELEASE and OCaml 4.05.0 *) +##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 diff --git a/src/batBytes.mliv b/src/batBytes.mliv index 4f3395c6a..5ab71f332 100644 --- a/src/batBytes.mliv +++ b/src/batBytes.mliv @@ -200,7 +200,7 @@ val index : t -> char -> int 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 NEXT_RELEASE *) + @since 2.7.0 *) val rindex : t -> char -> int (** [rindex s c] returns the index of the last occurrence of byte [c] @@ -211,7 +211,7 @@ val rindex : t -> char -> int 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 NEXT_RELEASE *) + @since 2.7.0 *) val index_from : t -> int -> char -> int (** [index_from s i c] returns the index of the first occurrence of @@ -227,7 +227,7 @@ val index_from_opt: t -> int -> char -> int option [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 NEXT_RELEASE *) + @since 2.7.0 *) val rindex_from : t -> int -> char -> int (** [rindex_from s i c] returns the index of the last occurrence of @@ -244,7 +244,7 @@ val rindex_from_opt: t -> int -> char -> int option [rindex_from s (Bytes.length s - 1) c]. Raise [Invalid_argument] if [i+1] is not a valid position in [s]. - @since NEXT_RELEASE *) + @since 2.7.0 *) val contains : t -> char -> bool (** [contains s c] tests if byte [c] appears in [s]. *) diff --git a/src/batInt32.mliv b/src/batInt32.mliv index d8ba4a0f8..e1176c767 100644 --- a/src/batInt32.mliv +++ b/src/batInt32.mliv @@ -195,7 +195,7 @@ external of_string : string -> int32 = "caml_int32_of_string" val of_string_opt: string -> int32 option (** Same as [of_string], but return [None] instead of raising. - @since NEXT_RELEASE *) + @since 2.7.0 *) val to_string : int32 -> string (** Return the string representation of its argument, in signed decimal. *) diff --git a/src/batInt64.mliv b/src/batInt64.mliv index 7308efb82..01e72ffc5 100644 --- a/src/batInt64.mliv +++ b/src/batInt64.mliv @@ -193,7 +193,7 @@ external of_string : string -> int64 = "caml_int64_of_string" val of_string_opt: string -> int64 option (** Same as [of_string], but return [None] instead of raising. - @since NEXT_RELEASE *) + @since 2.7.0 *) val to_string : int64 -> string (** Return the string representation of its argument, in decimal. *) diff --git a/src/batList.mliv b/src/batList.mliv index fb67d1f2b..2deb83932 100644 --- a/src/batList.mliv +++ b/src/batList.mliv @@ -95,14 +95,14 @@ 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 NEXT_RELEASE + @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 NEXT_RELEASE + @since 2.7.0 *) val at : 'a list -> int -> 'a @@ -112,7 +112,7 @@ val at : 'a list -> int -> 'a 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 NEXT_RELEASE + @since 2.7.0 @raise Invalid_argument if the index is negative *) val rev : 'a list -> 'a list @@ -432,7 +432,7 @@ 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 NEXT_RELEASE *) + @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] @@ -563,7 +563,7 @@ val assoc_opt: 'a -> ('a * 'b) list -> 'b option 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 NEXT_RELEASE *) + @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 @@ -588,7 +588,7 @@ val assq : 'a -> ('a * 'b) list -> 'b 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 NEXT_RELEASE *) + @since 2.7.0 *) val assq_inv : 'b -> ('a * 'b) list -> 'a (** Same as {!List.assoc_inv}, but uses physical equality instead of structural @@ -913,7 +913,7 @@ val nth_opt: 'a list -> int -> 'a option 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 NEXT_RELEASE + @since 2.7.0 *) val takewhile : ('a -> bool) -> 'a list -> 'a list diff --git a/src/batNativeint.mliv b/src/batNativeint.mliv index 8d072aada..8b8d62861 100644 --- a/src/batNativeint.mliv +++ b/src/batNativeint.mliv @@ -206,7 +206,7 @@ external of_string : string -> nativeint = "caml_nativeint_of_string" val of_string_opt: string -> nativeint option (** Same as [of_string], but return [None] instead of raising. - @since NEXT_RELEASE *) + @since 2.7.0 *) val to_string : nativeint -> string (** Return the string representation of its argument, in decimal. *) diff --git a/src/batPrintexc.mliv b/src/batPrintexc.mliv index 7880a90ce..20c40268c 100644 --- a/src/batPrintexc.mliv +++ b/src/batPrintexc.mliv @@ -112,7 +112,7 @@ val print : _ BatInnerIO.output -> exn -> unit ##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 NEXT_RELEASE and OCaml 4.05.0 +##V>=4.5## @since 2.7.0 and OCaml 4.05.0 ##V>=4.5##*) ##V=4.1##(** {6 Current call stack} *) diff --git a/src/batString.mliv b/src/batString.mliv index e2679a09d..ec7316cc0 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -203,7 +203,7 @@ 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 NEXT_RELEASE *) + @since 2.7.0 *) val rindex : string -> char -> int (** [String.rindex s c] returns the character number of the last @@ -215,7 +215,7 @@ 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 NEXT_RELEASE *) + @since 2.7.0 *) val index_from : string -> int -> char -> int (** [String.index_from s i c] returns the character number of the @@ -233,7 +233,7 @@ val index_from_opt: string -> int -> char -> int option [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 NEXT_RELEASE + @since 2.7.0 *) val rindex_from : string -> int -> char -> int @@ -255,7 +255,7 @@ val rindex_from_opt: string -> int -> char -> int option Raise [Invalid_argument] if [i+1] is not a valid position in [s]. - @since NEXT_RELEASE + @since 2.7.0 *) val contains : string -> char -> bool diff --git a/src/batVect.mli b/src/batVect.mli index db88358d2..29efb4ba1 100644 --- a/src/batVect.mli +++ b/src/batVect.mli @@ -279,7 +279,7 @@ val find_opt : ('a -> bool) -> 'a t -> 'a option of vect [v] that satisfies the predicate [p], or [None] if no such element exists. - @since NEXT_RELEASE *) + @since 2.7.0 *) val mem : 'a -> 'a t -> bool (** [mem a v] is true if and only if [a] is equal to an element of [v]. *) @@ -633,7 +633,7 @@ val find_opt : ('a -> bool) -> 'a t -> 'a option of vect [a] that satisfies the predicate [p], or [None] if no such element exists. - @since NEXT_RELEASE + @since 2.7.0 *) val mem : 'a -> 'a t -> bool From 81504d0597d44b02f57256721f0563760db52848 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Wed, 16 Aug 2017 09:38:10 +0900 Subject: [PATCH 094/273] simplification to the opam file so that it is easier to compare with the one in the opam repository --- opam | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/opam b/opam index 3b8a3c894..4b9c42618 100644 --- a/opam +++ b/opam @@ -7,16 +7,12 @@ bug-reports: "https://github.com/ocaml-batteries-team/batteries-included/issues" dev-repo: "https://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"} "ocamlbuild" {build} @@ -25,6 +21,4 @@ depends: [ "bisect" {test} "num" ] -available: [ - ocaml-version >= "3.12.1" -] +available: [ocaml-version >= "3.12.1"] From afd55bf6ee57bf791866744628d7a1749b434885 Mon Sep 17 00:00:00 2001 From: mars0i Date: Tue, 29 Aug 2017 22:12:21 -0500 Subject: [PATCH 095/273] added note explaining that BatX is also Batteries.X --- build/intro.text | 2 ++ 1 file changed, 2 insertions(+) diff --git a/build/intro.text b/build/intro.text index 1dc4944ef..8d8e51113 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 an initial "Bat". + 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}, From 294e3d6fd16d6bf0ae52ae4bc6c642077ff198b5 Mon Sep 17 00:00:00 2001 From: mars0i Date: Tue, 29 Aug 2017 22:14:05 -0500 Subject: [PATCH 096/273] substitued the for a --- build/intro.text | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build/intro.text b/build/intro.text index 8d8e51113..17de9e1ff 100644 --- a/build/intro.text +++ b/build/intro.text @@ -21,7 +21,7 @@ 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 an initial "Bat". +Modules listed below can also be referenced as [Batteries.], where [] is the module name without the initial "Bat". Do you have suggestions? Remarks? Bug reports ? To contact us or to be kept informed, don't hesitate to visit our From 636c58c1c78e70846adbb35421fe732e08171cca Mon Sep 17 00:00:00 2001 From: mars0i Date: Tue, 29 Aug 2017 23:27:12 -0500 Subject: [PATCH 097/273] added explanation for case when Batteries is opened --- build/intro.text | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build/intro.text b/build/intro.text index 17de9e1ff..812d36080 100644 --- a/build/intro.text +++ b/build/intro.text @@ -21,7 +21,7 @@ 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". +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. Do you have suggestions? Remarks? Bug reports ? To contact us or to be kept informed, don't hesitate to visit our From b9dd83e58cfd54bc85eda6bc9985ba770495a721 Mon Sep 17 00:00:00 2001 From: mars0i Date: Wed, 30 Aug 2017 12:16:57 -0500 Subject: [PATCH 098/273] added example illustrating the BatX -> Batteries.X mapping. For an example, I think it's better to use module that's not listed in the "Extensions to the Standard Library" section. That section has its own specialized message about opening Batteries. Using a module from this section as an illustration has a slight risk of suggesting to users that the BatX->Batteries.X point applies only to this section. --- build/intro.text | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build/intro.text b/build/intro.text index 812d36080..22b71a0b3 100644 --- a/build/intro.text +++ b/build/intro.text @@ -21,7 +21,7 @@ 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. +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 From 8327cf0c8a6d9539d03b8dfaad9e478b19435a51 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 17 Apr 2016 13:51:35 -0400 Subject: [PATCH 099/273] safe-string: make Lexing safe --- src/batLexing.mli | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/batLexing.mli b/src/batLexing.mli index 9aec16122..78a2b94d5 100644 --- a/src/batLexing.mli +++ b/src/batLexing.mli @@ -60,7 +60,7 @@ val dummy_pos : position;; type lexbuf = Lexing.lexbuf = { refill_buff : lexbuf -> unit; - mutable lex_buffer : string; + mutable lex_buffer : bytes; mutable lex_buffer_len : int; mutable lex_abs_pos : int; mutable lex_start_pos : int; @@ -98,12 +98,12 @@ val from_string : string -> lexbuf the string. An end-of-input condition is generated when the end of the string is reached. *) -val from_function : (string -> int -> int) -> lexbuf +val from_function : (Bytes.t -> 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 + function, giving it a byte sequence [s] and a byte + count [n]. The function should put [n] bytes or less in [s], + starting at byte number 0, and return the number of byte provided. A return value of 0 means end of input. *) From 44a3a21e421a3be6b8d5cd337b68f0c094bfae11 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 17 Apr 2016 13:50:57 -0400 Subject: [PATCH 100/273] safe-string: make Big_int safe --- src/batBig_int.mliv | 2 +- src/batBig_int.mlv | 16 ++++++++++------ 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/src/batBig_int.mliv b/src/batBig_int.mliv index 4ce5b0e04..4693f08ca 100644 --- a/src/batBig_int.mliv +++ b/src/batBig_int.mliv @@ -345,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.mlv b/src/batBig_int.mlv index 0e4279c2f..c9f798eee 100644 --- a/src/batBig_int.mlv +++ b/src/batBig_int.mlv @@ -21,11 +21,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 + 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 @@ -65,7 +69,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 From 180f9b9980b26084f99f02aaea52014358abd47a Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 17 Apr 2016 13:51:13 -0400 Subject: [PATCH 101/273] safe-string: make Buffer safe --- src/batBuffer.mliv | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/batBuffer.mliv b/src/batBuffer.mliv index ad1e328c9..bd45e02fa 100644 --- a/src/batBuffer.mliv +++ b/src/batBuffer.mliv @@ -63,12 +63,13 @@ val to_bytes : t -> Bytes.t *) 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. *) +(** [Buffer.sub b off len] returns a copy of [len] bytes from the + current contents of the buffer [b], starting at offset [off]. -val blit : t -> int -> string -> int -> int -> unit + 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]. From d64443a92f9f0aed9bffc8e9b4d033c73e07bb23 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 17 Apr 2016 13:51:23 -0400 Subject: [PATCH 102/273] safe-string: make Digest safe --- src/batDigest.mlv | 19 ++++--------------- 1 file changed, 4 insertions(+), 15 deletions(-) diff --git a/src/batDigest.mlv b/src/batDigest.mlv index 86155358a..083c81c8a 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 \ @@ -78,11 +71,7 @@ let from_hex s = | _ -> raise (Invalid_argument "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 + String.init 16 (fun i -> Char.chr (byte (2 * i))) (*$Q Q.string (fun s -> \ From 8cbb5d5809b754841d6d278dea777e865404f724 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 17 Apr 2016 13:53:49 -0400 Subject: [PATCH 103/273] safe-string: make Genlex safe --- src/batGenlex.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) 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 From d12b5f15da0d880369185b3e62fd263f7d2285c9 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 17 Apr 2016 22:54:27 -0400 Subject: [PATCH 104/273] safe-string: make IO safe --- src/batBuffer.mlv | 2 +- src/batIO.ml | 46 ++++++++++++++++------------- src/batIO.mli | 73 ++++++++++++++++++++++++++-------------------- src/batInnerIO.ml | 51 ++++++++++++++++++++------------ src/batInnerIO.mli | 73 ++++++++++++++++++++++++++++------------------ 5 files changed, 144 insertions(+), 101 deletions(-) diff --git a/src/batBuffer.mlv b/src/batBuffer.mlv index db25e6f96..b10643686 100644 --- a/src/batBuffer.mlv +++ b/src/batBuffer.mlv @@ -75,7 +75,7 @@ let add_input t inp n = 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 diff --git a/src/batIO.ml b/src/batIO.ml index 65f6916df..3fe7a7157 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; + 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' = 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 f7d870da7..affb11ea2 100644 --- a/src/batIO.mli +++ b/src/batIO.mli @@ -189,13 +189,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 +205,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 +234,37 @@ 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 *) + +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 *) val flush : 'a output -> unit (** Flush an output. @@ -593,7 +602,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 +613,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 +631,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 +647,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 +666,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 +717,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 @@ -774,13 +783,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 diff --git a/src/batInnerIO.ml b/src/batInnerIO.ml index 328482c69..4360ef1d5 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 -> 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; + 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..16510b03c 100644 --- a/src/batInnerIO.mli +++ b/src/batInnerIO.mli @@ -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,29 @@ 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. *) -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 : '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 *) + +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 flush : 'a output -> unit (** Flush an output. *) @@ -136,7 +151,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 +162,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 +173,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 +188,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 +207,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 +219,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 +452,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 From 310259bb2494e8b54a3d8cf402f291a702e9d488 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Mon, 18 Apr 2016 22:59:38 -0400 Subject: [PATCH 105/273] safe-string: make Format safe --- src/batFormat.mlv | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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 From 6153feee1ee88ce56ee87cc81e544673292918b2 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 19 Apr 2016 08:41:15 -0400 Subject: [PATCH 106/273] safe-string: make Int32 safe --- src/batInt32.mliv | 20 +++++++------- src/batInt32.mlv | 69 ++++++++++++++++++++++++++--------------------- 2 files changed, 49 insertions(+), 40 deletions(-) diff --git a/src/batInt32.mliv b/src/batInt32.mliv index e1176c767..80c50af7f 100644 --- a/src/batInt32.mliv +++ b/src/batInt32.mliv @@ -217,20 +217,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 diff --git a/src/batInt32.mlv b/src/batInt32.mlv index e2b884bee..71e490ca6 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: 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] |> 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 From 1a9b9806c33e42489c61d9ca2f620a1592d7b967 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 19 Apr 2016 08:41:25 -0400 Subject: [PATCH 107/273] safe-string: make Marshal safe --- src/batMarshal.mlv | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) 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" From 4bbf6907f3026840652b86ad344674ddc8de131c Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 19 Apr 2016 08:46:41 -0400 Subject: [PATCH 108/273] safe-string: make Pervasives safe --- src/batPervasives.ml | 8 +++++--- src/batPervasives.mliv | 30 ++++++++++++++++++------------ 2 files changed, 23 insertions(+), 15 deletions(-) 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 062076bbc..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]. *) @@ -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 From 1c5f96a702ed329b0c4178cc94145ef8f9e79fff Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 19 Apr 2016 17:25:39 -0400 Subject: [PATCH 109/273] safe-string: make Printf safe --- src/batPrintf.mlv | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) 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 From aed6515c58b93aa62bc51c878d8e28a88c6086a4 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 19 Apr 2016 20:18:28 -0400 Subject: [PATCH 110/273] safe-string: make String safe (but String.Cap) --- src/batString.mliv | 31 ++++++++++++----------- src/batString.mlv | 61 ++++++++++++++++++++++++---------------------- 2 files changed, 47 insertions(+), 45 deletions(-) diff --git a/src/batString.mliv b/src/batString.mliv index ec7316cc0..393a7d3b4 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] @@ -698,12 +696,12 @@ val rev : string -> string (** {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}*) @@ -1207,9 +1205,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 8322996ce..d092b5753 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -36,7 +36,7 @@ let init len f = for i = 0 to len - 1 do Bytes.unsafe_set s i (f i) done; - s + Bytes.unsafe_to_string s (*$T init init 5 (fun i -> BatChar.chr (i + int_of_char '0')) = "01234"; @@ -376,7 +376,7 @@ 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) @@ -524,7 +524,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 = "" @@ -536,7 +536,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" @@ -549,7 +550,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 "" = "" @@ -562,7 +563,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) "" = "" @@ -685,9 +686,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 [] = "" @@ -719,11 +721,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" = "" @@ -740,7 +742,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 @@ -765,14 +767,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" @@ -780,21 +782,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 @@ -815,7 +817,7 @@ let rev s = for i = 0 to len - 1 do Bytes.unsafe_set reversed (len - i - 1) (String.unsafe_get s i) done; - reversed + Bytes.unsafe_to_string reversed (*$T rev rev "" = "" @@ -852,10 +854,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" @@ -1133,7 +1136,7 @@ struct let uncapitalize = uncapitalize let copy = copy let sub = sub - let fill = Bytes.fill + let fill = fill let blit = blit let concat = concat let escaped = escaped From dd4dbb42cdbaebcd829d242b1cf5a15ba0105d95 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 19 Apr 2016 20:19:30 -0400 Subject: [PATCH 111/273] safe-string: adapt String.Cap --- src/batString.mliv | 81 +++++++++++-- src/batString.mlv | 208 ++++++++++++++++++---------------- src/batteriesExceptionless.ml | 10 +- src/batteriesPrint.ml | 2 + 4 files changed, 191 insertions(+), 110 deletions(-) diff --git a/src/batString.mliv b/src/batString.mliv index 393a7d3b4..87898bd7f 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -955,7 +955,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 NEXT_RELEASE the interface and implementation of the Cap + module changed to accomodate 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 @@ -986,11 +994,66 @@ sig (** {6 Constructors}*) - external of_string : string -> _ t = "%identity" - (**Adopt a regular string.*) + external of_string : Bytes.t -> _ t = "%identity" + [@@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 NEXT_RELEASE + *) - 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" + [@@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 NEXT_RELEASE + *) external read_only : [> `Read] t -> [`Read] t = "%identity" (** Drop capabilities to read only.*) @@ -1080,7 +1143,7 @@ sig val rchop : ?n:int -> [> `Read] t -> _ t - val chop : ?l:int -> ?r:int -> [> `Read] t -> string + val chop : ?l:int -> ?r:int -> [> `Read] t -> _ t val trim : [> `Read] t -> _ t @@ -1127,11 +1190,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 @@ -1190,10 +1253,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 *) diff --git a/src/batString.mlv b/src/batString.mlv index d092b5753..9babb4ba4 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -227,7 +227,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 @@ -1090,88 +1091,99 @@ end (* String.Exceptionless *) 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 chop = chop - let strip = strip - let uppercase = uppercase - let lowercase = lowercase - let capitalize = capitalize - let uncapitalize = uncapitalize - let copy = copy - let sub = sub - let fill = 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" + 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 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 = 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" @@ -1188,18 +1200,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/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..35e4f98d5 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,6 +35,7 @@ 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) From bcb538ca84209c2d3ea251a455096b30dfc35627 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 19 Apr 2016 20:20:19 -0400 Subject: [PATCH 112/273] safe-string: make Unix safe --- src/batUnix.mlv | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/batUnix.mlv b/src/batUnix.mlv index e122e16fc..9b09a2895 100644 --- a/src/batUnix.mlv +++ b/src/batUnix.mlv @@ -38,7 +38,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; + Buffer.add_subbytes buff line_buff 0 !was_read; was_read := input ic line_buff 0 buff_size; done; close_in ic; From 5d67375f4c81b06238309965764353cf03cdd099 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 19 Apr 2016 20:21:07 -0400 Subject: [PATCH 113/273] safe-string: make Base64 safe --- src/batBase64.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From 4b50dcc5f1f2f68ff153cc541bec18311a267021 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 19 Apr 2016 21:27:13 -0400 Subject: [PATCH 114/273] safe-string: make BitSet safe --- src/batBitSet.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/batBitSet.ml b/src/batBitSet.ml index 89fb773b6..d835aa003 100644 --- a/src/batBitSet.ml +++ b/src/batBitSet.ml @@ -37,14 +37,15 @@ 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"); From b5cd62cdd79fcd8bec95cfa6863fc43b40cdc993 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 19 Apr 2016 21:32:00 -0400 Subject: [PATCH 115/273] safe-string: make Substring safe --- src/batSubstring.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/batSubstring.ml b/src/batSubstring.ml index 97ed3c22b..0ec78d551 100644 --- a/src/batSubstring.ml +++ b/src/batSubstring.ml @@ -85,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; + Buffer.add_subbytes buf tmp 0 !n; done; Buffer.contents buf, 0, Buffer.length buf @@ -197,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" From 7bc055015d53d479ec21952e61a86f279535d0c1 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 19 Apr 2016 21:32:07 -0400 Subject: [PATCH 116/273] safe-string: make Text safe --- src/batText.ml | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/batText.ml b/src/batText.ml index 27166077d..2ff557f66 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*) @@ -1022,7 +1023,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 From ea80aa778acca9c6be287dee44e5c861e7ede0d8 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 20 Apr 2016 09:45:35 -0400 Subject: [PATCH 117/273] _tags: actually enforce safe_string --- _tags | 2 ++ 1 file changed, 2 insertions(+) diff --git a/_tags b/_tags index 02dedf6df..b50a32e98 100644 --- a/_tags +++ b/_tags @@ -10,3 +10,5 @@ true: package(bytes), warn_-3, bin_annot ".git": -traverse "examples": -traverse : opaque +true: safe_string + From f788c7512255a10c805d7c70bc1d69d1a60d3855 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 23 Sep 2017 13:27:55 +0200 Subject: [PATCH 118/273] safe-string: make BatBytes safe --- src/batBytes.mlv | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/batBytes.mlv b/src/batBytes.mlv index 23aaf993d..6a00de363 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 |> uppercase_ascii |> to_string) "FIVE" - equal ("école" |> of_string |> uppercase_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 |> lowercase_ascii |> to_string) "five" - equal ("ÉCOLE" |> of_string |> lowercase_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,13 +66,13 @@ 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 |> capitalize_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 |> uncapitalize_ascii |> to_string) "five" - equal ("École" |> of_string |> uncapitalize_ascii |> to_string) "École" + String.equal ("Five" |> of_string |> uncapitalize_ascii |> to_string) "five" + String.equal ("École" |> of_string |> uncapitalize_ascii |> to_string) "École" *) From 2b67824504786febd34835d4610f007faba3923e Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 23 Sep 2017 14:14:02 +0200 Subject: [PATCH 119/273] -safe-string: Changelog --- ChangeLog | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/ChangeLog b/ChangeLog index 4530affe8..1f33cf15f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,16 @@ Changelog --------- +## 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) + ## v2.7.0 (minor release) This minor release is the first to support OCaml 4.05.0. As with From aaae4d940ab5a42703fc1744c0495afbaee74e2d Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Fri, 13 Oct 2017 12:32:28 +0200 Subject: [PATCH 120/273] [minor] exclude compattest.ml from qtest (Otherwise you cannot run the tests for an OCaml version that does not pass the compat-test.) --- Makefile | 1 + 1 file changed, 1 insertion(+) diff --git a/Makefile b/Makefile index 6fccc7342..24c51011a 100644 --- a/Makefile +++ b/Makefile @@ -169,6 +169,7 @@ clean-prefilter: # `_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) $(wildcard src/*.mlv)) From 8b4f02c47d5c5fcc26e8ded47a54862aa3b496d3 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Fri, 13 Oct 2017 13:56:58 +0200 Subject: [PATCH 121/273] add 4.06-only Array.Floatarray primitive module --- src/batArray.mliv | 10 ++++++++++ src/batHashcons.ml | 2 +- src/batVect.ml | 2 +- 3 files changed, 12 insertions(+), 2 deletions(-) diff --git a/src/batArray.mliv b/src/batArray.mliv index 103199572..b4aee6960 100644 --- a/src/batArray.mliv +++ b/src/batArray.mliv @@ -830,4 +830,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/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/batVect.ml b/src/batVect.ml index 5fe7f4109..8fcc0173b 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 From dbfaeb39c5c3597b57c39972c7fbb918b847f041 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Fri, 13 Oct 2017 15:46:26 +0200 Subject: [PATCH 122/273] add 4.06-only Uchar.t functions in Buffer It would be nicer to make sure that BatUChar is a superset of the stdlib Uchar module, and that the two types are compatible, but that requires more work. --- src/batBuffer.mliv | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/src/batBuffer.mliv b/src/batBuffer.mliv index bd45e02fa..17ebe9270 100644 --- a/src/batBuffer.mliv +++ b/src/batBuffer.mliv @@ -155,7 +155,28 @@ val output_buffer : t -> string BatInnerIO.output ##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## 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 NEXT_RELEASE 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 NEXT_RELEASE 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 NEXT_RELEASE and OCaml 4.06.0 *) (** {6 Boilerplate code}*) From a141a3e238ea5e89d4bf01b1e96388822ca921af Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Fri, 13 Oct 2017 16:39:44 +0200 Subject: [PATCH 123/273] 4.06 Bigarray functions --- src/batBigarray.mliv | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/src/batBigarray.mliv b/src/batBigarray.mliv index 178ac40d5..730ec2fcd 100644 --- a/src/batBigarray.mliv +++ b/src/batBigarray.mliv @@ -648,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}. @@ -792,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}. @@ -943,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}. From 6599409b517f267b975dcb54591a25525fd789d7 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Fri, 13 Oct 2017 16:40:13 +0200 Subject: [PATCH 124/273] 4.06 Unix functions --- src/batUnix.mliv | 76 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 76 insertions(+) diff --git a/src/batUnix.mliv b/src/batUnix.mliv index 1870fb9d8..3edd9aa94 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 NEXT_RELEASE 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 NEXT_RELEASE and 4.06.0 *) + val putenv : string -> string -> unit (** [Unix.putenv name value] sets the value associated to a variable in the process environment. @@ -498,6 +521,59 @@ 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##(** 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 NEXT_RELEASE and OCaml 4.06.0 *) + (** {6 Operations on file names} *) From 233194cf65bbf1c2e941f3dc2ab08693789ab135 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Fri, 13 Oct 2017 17:03:33 +0200 Subject: [PATCH 125/273] 4.06: Changes entry --- ChangeLog | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ChangeLog b/ChangeLog index 1f33cf15f..caa13cfb2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -11,6 +11,9 @@ strings and mutable byte sequences. #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 From e069e28678a0d15d338721e1ff5e480fe0ad26c5 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 15 Oct 2017 21:15:37 +0200 Subject: [PATCH 126/273] fix more FloatArray failures in the test targets --- src/extlib.ml | 4 ++-- testsuite/test_container.ml | 1 - 2 files changed, 2 insertions(+), 3 deletions(-) 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/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 From a171d877afd4bb2c458758f823d96b1d07852764 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Mon, 23 Oct 2017 11:18:52 +0900 Subject: [PATCH 127/273] added BatString.count_char --- src/batString.mliv | 7 +++++++ src/batString.mlv | 14 ++++++++++++++ 2 files changed, 21 insertions(+) diff --git a/src/batString.mliv b/src/batString.mliv index 87898bd7f..6e57cc176 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -559,6 +559,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 @@ -1137,6 +1142,8 @@ sig val exists : [> `Read] t -> [> `Read] t -> bool + val count_char : [> `Read] t -> char -> int + (** {6 Transformations}*) val lchop : ?n:int -> [> `Read] t -> _ t diff --git a/src/batString.mlv b/src/batString.mlv index 9babb4ba4..1a860b36c 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -611,6 +611,19 @@ let fold_left f init str = fold_left max 'a' "apples" = 's' *) +let count_char str char = + fold_left (fun acc c -> + if c = char then + acc + 1 + else + acc + ) 0 str +(*$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 = @@ -1129,6 +1142,7 @@ struct 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)) From 11714624c44b0ff7028a5108634cf370c48d079a Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Mon, 23 Oct 2017 11:59:20 +0900 Subject: [PATCH 128/273] added count_string --- src/batString.mliv | 4 ++++ src/batString.mlv | 23 ++++++++++++++++++++++- 2 files changed, 26 insertions(+), 1 deletion(-) diff --git a/src/batString.mliv b/src/batString.mliv index 87898bd7f..b674c06ab 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -540,6 +540,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 NEXT_RELEASE *) + val ends_with : string -> string -> bool (** [ends_with s x] returns [true] if the string [s] is ending with [x], [false] otherwise. diff --git a/src/batString.mlv b/src/batString.mlv index 9babb4ba4..d3d7bc182 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -205,7 +205,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 raise (Invalid_argument "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 From b89b8219348386d1144cb6c8c555546baabf1b24 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 29 Oct 2017 12:44:08 +0100 Subject: [PATCH 129/273] safe-string: fix compatibility with OCaml <=4.02 The safe-string compatibility fixes rely on the Bytes package, which we convincingly mock under OCaml<=4.02, but also on bytes-adapted functions or just convenience functions that are useful for code porting: Buffer.add_subbytes, String.init, etc. Before this commit, the codebase would simply not build on OCaml<=4.02 because of this. What the commit does is to introduce a new module, BatBytesCompat, meant to contain backward-compatibility implementation of those functions. --- src/batBig_int.mlv | 3 +-- src/batBuffer.mlv | 12 ++++++------ src/batBytesCompat.mlv | 26 ++++++++++++++++++++++++++ src/batDigest.mlv | 2 +- src/batIO.ml | 4 ++-- src/batInnerIO.ml | 4 ++-- src/batLexing.mli | 2 +- src/batString.mliv | 4 ++-- src/batString.mlv | 7 +------ src/batSubstring.ml | 2 +- src/batUnix.mlv | 2 +- src/batteries.mllib | 1 + 12 files changed, 45 insertions(+), 24 deletions(-) create mode 100644 src/batBytesCompat.mlv diff --git a/src/batBig_int.mlv b/src/batBig_int.mlv index c9f798eee..36ef6ad6c 100644 --- a/src/batBig_int.mlv +++ b/src/batBig_int.mlv @@ -19,11 +19,10 @@ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) - let big_int_base_default_symbols = let symbol offset base k = char_of_int (k - offset + (int_of_char base)) in - String.init (10 + 26*2) (fun k -> + BatBytesCompat.string_init (10 + 26*2) (fun k -> if k < 10 then symbol 0 '0' k else if k < 36 diff --git a/src/batBuffer.mlv b/src/batBuffer.mlv index b10643686..033b5af95 100644 --- a/src/batBuffer.mlv +++ b/src/batBuffer.mlv @@ -72,6 +72,12 @@ 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) @@ -82,9 +88,3 @@ let output_buffer buf = (*$Q output_buffer (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 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/batDigest.mlv b/src/batDigest.mlv index 083c81c8a..fab2e6d69 100644 --- a/src/batDigest.mlv +++ b/src/batDigest.mlv @@ -71,7 +71,7 @@ let from_hex s = | _ -> raise (Invalid_argument "Digest.from_hex") in let byte i = digit s.[i] lsl 4 + digit s.[i+1] in - String.init 16 (fun i -> Char.chr (byte (2 * i))) + BatBytesCompat.string_init 16 (fun i -> Char.chr (byte (2 * i))) (*$Q Q.string (fun s -> \ diff --git a/src/batIO.ml b/src/batIO.ml index 3fe7a7157..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_subbytes b s p l; + BatBytesCompat.buffer_add_subbytes b s p l; l ) ~close:(fun () -> @@ -579,7 +579,7 @@ let tab_out ?(tab=' ') n out = if is_newline c then Buffer.add_string buffer spaces done; - let s' = Buffer.to_bytes buffer in + let s' = BatBytesCompat.buffer_to_bytes buffer in really_output out s' 0 (Bytes.length s')) ~flush:noop ~close:noop diff --git a/src/batInnerIO.ml b/src/batInnerIO.ml index 4360ef1d5..f9191fb50 100644 --- a/src/batInnerIO.ml +++ b/src/batInnerIO.ml @@ -356,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_subbytes 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 @@ -435,7 +435,7 @@ let pipe() = Buffer.add_char output c in let output s p l = - Buffer.add_subbytes output s p l; + BatBytesCompat.buffer_add_subbytes output s p l; l in let input = create_in ~read ~input ~close:noop diff --git a/src/batLexing.mli b/src/batLexing.mli index 78a2b94d5..b052d3aff 100644 --- a/src/batLexing.mli +++ b/src/batLexing.mli @@ -60,7 +60,7 @@ val dummy_pos : position;; type lexbuf = Lexing.lexbuf = { refill_buff : lexbuf -> unit; - mutable lex_buffer : bytes; + mutable lex_buffer : Bytes.t; mutable lex_buffer_len : int; mutable lex_abs_pos : int; mutable lex_start_pos : int; diff --git a/src/batString.mliv b/src/batString.mliv index 87898bd7f..b607c3960 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -995,7 +995,7 @@ sig (** {6 Constructors}*) external of_string : Bytes.t -> _ t = "%identity" - [@@ocaml.deprecated "Use Cap.of_bytes instead"] +##V>=4.2## [@@ocaml.deprecated "Use Cap.of_bytes instead"] (**Adopt a regular byte sequence. One could give a perfectly safe semantics to @@ -1028,7 +1028,7 @@ sig *) external to_string : [`Read | `Write] t -> Bytes.t = "%identity" - [@@ocaml.deprecated "Use Cap.to_bytes instead"] +##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 diff --git a/src/batString.mlv b/src/batString.mlv index 9babb4ba4..4661820dc 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; - Bytes.unsafe_to_string s +let init = BatBytesCompat.string_init (*$T init init 5 (fun i -> BatChar.chr (i + int_of_char '0')) = "01234"; diff --git a/src/batSubstring.ml b/src/batSubstring.ml index 0ec78d551..ddda97efb 100644 --- a/src/batSubstring.ml +++ b/src/batSubstring.ml @@ -85,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_subbytes buf tmp 0 !n; + BatBytesCompat.buffer_add_subbytes buf tmp 0 !n; done; Buffer.contents buf, 0, Buffer.length buf diff --git a/src/batUnix.mlv b/src/batUnix.mlv index 9b09a2895..210d824ad 100644 --- a/src/batUnix.mlv +++ b/src/batUnix.mlv @@ -38,7 +38,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_subbytes 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; diff --git a/src/batteries.mllib b/src/batteries.mllib index a59fd1097..30ab679a6 100644 --- a/src/batteries.mllib +++ b/src/batteries.mllib @@ -6,6 +6,7 @@ BatInnerPervasives BatBool BatBounded BatBuffer + BatBytesCompat BatBytes BatChar BatComplex From 60ffa0fec2c1b7e245fec532da530a1c0c5ac64b Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 29 Oct 2017 18:08:49 +0100 Subject: [PATCH 130/273] a prebaked patch to try our inline tests on older OCaml versions The following command should get Batteries (temporarily) testable with old qtest versions: git apply build/make-our-inline-tests-compatible-with-older-OCaml-versions.patch --- ...compatible-with-older-OCaml-versions.patch | 128 ++++++++++++++++++ 1 file changed, 128 insertions(+) create mode 100644 build/make-our-inline-tests-compatible-with-older-OCaml-versions.patch 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..035d9b849 --- /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 (*BISECT-VISIT*) + ) + (*$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 + From 0ae9a359261196ba8f085936a3d782172b5a4cca Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Wed, 8 Nov 2017 09:36:16 +0900 Subject: [PATCH 131/273] mention count_string --- ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ChangeLog b/ChangeLog index caa13cfb2..77e931a85 100644 --- a/ChangeLog +++ b/ChangeLog @@ -7,6 +7,10 @@ This minor release supports the -safe-string mode for OCaml compilation, enforcing a type-level separation between (immutable) strings and mutable byte sequences. +- add `BatString.count_string: string -> string -> int` + #799 + (Francois Berenger) + - support -safe-string compilation #673 (Gabriel Scherer) From 10e2dd160bc5d35b2ea19998b18944c0511351c3 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 11 Nov 2017 16:43:52 +0100 Subject: [PATCH 132/273] Revert "added count_string" This reverts commit 11714624c44b0ff7028a5108634cf370c48d079a. The idea is to do the next minor release without the count_* functions that are not yet ready for inclusion. The commit should be merged back right after the release. --- src/batString.mliv | 4 ---- src/batString.mlv | 23 +---------------------- 2 files changed, 1 insertion(+), 26 deletions(-) diff --git a/src/batString.mliv b/src/batString.mliv index 6da4fad11..b607c3960 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -540,10 +540,6 @@ 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 NEXT_RELEASE *) - val ends_with : string -> string -> bool (** [ends_with s x] returns [true] if the string [s] is ending with [x], [false] otherwise. diff --git a/src/batString.mlv b/src/batString.mlv index d84613205..4661820dc 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -200,28 +200,7 @@ 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 raise (Invalid_argument "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 From 7c5e3ca54f030a0b60c02478ddcc2e5da882094b Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 12 Nov 2017 21:28:53 +0100 Subject: [PATCH 133/273] missing @since tags --- src/batIO.mli | 8 ++++++-- src/batInnerIO.mli | 12 +++++++++--- 2 files changed, 15 insertions(+), 5 deletions(-) diff --git a/src/batIO.mli b/src/batIO.mli index affb11ea2..7a6317e16 100644 --- a/src/batIO.mli +++ b/src/batIO.mli @@ -247,7 +247,9 @@ val output : 'a output -> Bytes.t -> int -> int -> int val output_substring : 'a output -> string -> int -> int -> int (** like [output] above, but outputs from a substring instead of - a subsequence of bytes *) + 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 @@ -264,7 +266,9 @@ val really_output : 'a output -> Bytes.t -> int -> int -> int 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 *) + of a subsequence of bytes + + @since 2.8.0 *) val flush : 'a output -> unit (** Flush an output. diff --git a/src/batInnerIO.mli b/src/batInnerIO.mli index 16510b03c..52d08558e 100644 --- a/src/batInnerIO.mli +++ b/src/batInnerIO.mli @@ -100,7 +100,9 @@ val nwrite : 'a output -> string -> unit (** Write a string to an output. *) val nwrite_bytes : 'a output -> Bytes.t -> unit -(** Write a byte sequence to an output. *) +(** 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 @@ -110,7 +112,9 @@ val output : 'a output -> Bytes.t -> int -> int -> int val output_substring : 'a output -> string -> int -> int -> int (** like [output] above, but outputs from a substring instead of - a subsequence of bytes *) + 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 @@ -121,7 +125,9 @@ val really_output : 'a output -> Bytes.t -> int -> int -> int 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 *) + of a subsequence of bytes + + @since 2.8.0 *) val flush : 'a output -> unit (** Flush an output. *) From 3589ab382e2b0fe6b4787ed988ba9ce856552d7d Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 12 Nov 2017 21:31:05 +0100 Subject: [PATCH 134/273] update scripts/replace_since.sh --- scripts/replace_since.sh | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/scripts/replace_since.sh b/scripts/replace_since.sh index c7455cf3b..6a1e83af9 100755 --- a/scripts/replace_since.sh +++ b/scripts/replace_since.sh @@ -7,8 +7,9 @@ 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 From 0d70684963e369bd9d2569d806d575e7513ec8aa Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 12 Nov 2017 21:31:23 +0100 Subject: [PATCH 135/273] refresh @since NEXT_RELEASE tags with new version --- src/batBuffer.mliv | 6 +++--- src/batString.mliv | 6 +++--- src/batUnix.mliv | 6 +++--- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/batBuffer.mliv b/src/batBuffer.mliv index 17ebe9270..8beb62a02 100644 --- a/src/batBuffer.mliv +++ b/src/batBuffer.mliv @@ -162,21 +162,21 @@ val output_buffer : t -> string BatInnerIO.output ##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 NEXT_RELEASE and OCaml 4.06.0 *) +##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 NEXT_RELEASE and OCaml 4.06.0 *) +##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 NEXT_RELEASE and OCaml 4.06.0 *) +##V>=4.6## @since 2.8.0 and OCaml 4.06.0 *) (** {6 Boilerplate code}*) diff --git a/src/batString.mliv b/src/batString.mliv index b607c3960..c28a2d66b 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -955,7 +955,7 @@ 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. - @since NEXT_RELEASE the interface and implementation of the Cap + @since 2.8.0 the interface and implementation of the Cap module changed to accomodate 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 @@ -1024,7 +1024,7 @@ sig or make a copy of it at adoption time: [Cap.of_bytes (Bytes.copy buf)]. - @since NEXT_RELEASE + @since 2.8.0 *) external to_string : [`Read | `Write] t -> Bytes.t = "%identity" @@ -1052,7 +1052,7 @@ sig external to_bytes : [`Read | `Write] t -> Bytes.t = "%identity" (** Return a capability string as a regular byte sequence. - @since NEXT_RELEASE + @since 2.8.0 *) external read_only : [> `Read] t -> [`Read] t = "%identity" diff --git a/src/batUnix.mliv b/src/batUnix.mliv index 3edd9aa94..92fa517fc 100644 --- a/src/batUnix.mliv +++ b/src/batUnix.mliv @@ -144,7 +144,7 @@ val environment : unit -> string array ##V>=4.6## privileges. See the documentation for {!unsafe_getenv} for more ##V>=4.6## details. ##V>=4.6## -##V>=4.6## @since NEXT_RELEASE and OCaml 4.06.0 *) +##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 @@ -163,7 +163,7 @@ val getenv : string -> string ##V>=4.6## like. ##V>=4.6## ##V>=4.6## @raise Not_found if the variable is unbound. -##V>=4.6## @since NEXT_RELEASE and 4.06.0 *) +##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 @@ -572,7 +572,7 @@ end ##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 NEXT_RELEASE and OCaml 4.06.0 *) +##V>=4.6## @since 2.8.0 and OCaml 4.06.0 *) (** {6 Operations on file names} *) From 1adc778ec3561294df64454bcc76542a4c4936da Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 12 Nov 2017 21:32:08 +0100 Subject: [PATCH 136/273] bump _oasis version number --- _oasis | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/_oasis b/_oasis index ca74e8279..24ba5e775 100644 --- a/_oasis +++ b/_oasis @@ -1,7 +1,7 @@ OASISFormat: 0.4 OCamlVersion: >= 3.12.1 Name: batteries -Version: 2.7.0 +Version: 2.8.0 Authors: Batteries Included Team License: LGPL-2.1 with OCaml linking exception LicenseFile: LICENSE From b060974225b5628348b7aefa0f9c97bf42a879bb Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 14 Nov 2017 06:57:40 +0100 Subject: [PATCH 137/273] Update setup.ml based on _oasis --- setup.ml | 48 ++++++++++++++++++++---------------------------- 1 file changed, 20 insertions(+), 28 deletions(-) diff --git a/setup.ml b/setup.ml index 4e2bc2e8a..25612a1de 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: adb4e4363b81cc88c590c82403607f51) *) +(* DO NOT EDIT (digest: 36bed8df785978c282829ca538024e8c) *) (* - Regenerated by OASIS v0.4.8 + Regenerated by OASIS v0.4.10 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 = @@ -3162,7 +3156,7 @@ module OASISFileUtil = struct end -# 3165 "setup.ml" +# 3159 "setup.ml" module BaseEnvLight = struct (* # 22 "src/base/BaseEnvLight.ml" *) @@ -3242,7 +3236,7 @@ module BaseEnvLight = struct end -# 3245 "setup.ml" +# 3239 "setup.ml" module BaseContext = struct (* # 22 "src/base/BaseContext.ml" *) @@ -5665,7 +5659,7 @@ module BaseCompat = struct end -# 5668 "setup.ml" +# 5662 "setup.ml" module InternalConfigurePlugin = struct (* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *) @@ -6016,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 = @@ -6471,7 +6462,7 @@ module InternalInstallPlugin = struct end -# 6474 "setup.ml" +# 6465 "setup.ml" module CustomPlugin = struct (* # 22 "src/plugins/custom/CustomPlugin.ml" *) @@ -6603,7 +6594,7 @@ module CustomPlugin = struct end -# 6606 "setup.ml" +# 6597 "setup.ml" open OASISTypes;; let setup_t = @@ -6751,7 +6742,7 @@ let setup_t = { oasis_version = "0.4"; ocaml_version = Some (OASISVersion.VGreaterEqual "3.12.1"); - version = "2.5.4"; + version = "2.8.0"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -7027,8 +7018,9 @@ let setup_t = plugin_data = [] }; oasis_fn = Some "_oasis"; - oasis_version = "0.4.8"; - oasis_digest = Some "\200e\186\249\186.\167q\012\193\239N\023k\129."; + oasis_version = "0.4.10"; + oasis_digest = + Some "\154\242\029\231r\200\220\152K\201\139\180T2\232\189"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -7036,7 +7028,7 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 7040 "setup.ml" +# 7032 "setup.ml" let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t open BaseCompat.Compat_0_4 (* OASIS_STOP *) From bc10ba1b4aae8d4e8b76ac5e0a26a53f5b5503c2 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 14 Nov 2017 07:06:53 +0100 Subject: [PATCH 138/273] Revert "mention count_string" This reverts commit 0ae9a359261196ba8f085936a3d782172b5a4cca. This has to be pushed again after v2.8.0, in the right Changelog section --- ChangeLog | 4 ---- 1 file changed, 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index 77e931a85..caa13cfb2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -7,10 +7,6 @@ This minor release supports the -safe-string mode for OCaml compilation, enforcing a type-level separation between (immutable) strings and mutable byte sequences. -- add `BatString.count_string: string -> string -> int` - #799 - (Francois Berenger) - - support -safe-string compilation #673 (Gabriel Scherer) From e7333747390651c17cd3cd28951c7a4411fb7cf7 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 14 Nov 2017 07:20:26 +0100 Subject: [PATCH 139/273] batString: safe-string-ready map_first_char --- src/batString.mlv | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/batString.mlv b/src/batString.mlv index 4661820dc..5fb840288 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -931,10 +931,10 @@ let numeric_compare s1 s2 = *) ##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 From 2947712e7cfb39d4c120a1c73d7f8195f0a3310f Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 14 Nov 2017 07:34:41 +0100 Subject: [PATCH 140/273] first commit after v2.8.0 --- ChangeLog | 2 ++ _oasis | 2 +- howto/release.md | 3 ++- scripts/replace_since.sh | 1 + 4 files changed, 6 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index caa13cfb2..7b79a8b16 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,8 @@ Changelog --------- +## NEXT_RELEASE + ## v2.8.0 (minor release) This minor release supports the -safe-string mode for OCaml diff --git a/_oasis b/_oasis index 24ba5e775..70aa351b0 100644 --- a/_oasis +++ b/_oasis @@ -1,7 +1,7 @@ OASISFormat: 0.4 OCamlVersion: >= 3.12.1 Name: batteries -Version: 2.8.0 +Version: NEXT_RELEASE Authors: Batteries Included Team License: LGPL-2.1 with OCaml linking exception LicenseFile: LICENSE diff --git a/howto/release.md b/howto/release.md index d52a2a6ca..3e7e0e231 100644 --- a/howto/release.md +++ b/howto/release.md @@ -111,6 +111,7 @@ practices. # Post-release work -- create a Changelog section for NEXT_RELEASE +- 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/scripts/replace_since.sh b/scripts/replace_since.sh index 6a1e83af9..0b6418758 100755 --- a/scripts/replace_since.sh +++ b/scripts/replace_since.sh @@ -14,3 +14,4 @@ if [ -z "$VERSION" ] ; then fi find src/ -name '*.ml*' -exec sed -i'' "s/NEXT_RELEASE/$VERSION/g" {} \; +sed _oasis -i'' "s/NEXT_RELEASE/$VERSION/g" From ede4c7eec8147572303532e83fa6da745b6d130f Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 14 Nov 2017 07:25:20 +0100 Subject: [PATCH 141/273] Revert "Revert "added count_string"" This reverts commit 10e2dd160bc5d35b2ea19998b18944c0511351c3. --- src/batString.mliv | 4 ++++ src/batString.mlv | 23 ++++++++++++++++++++++- 2 files changed, 26 insertions(+), 1 deletion(-) diff --git a/src/batString.mliv b/src/batString.mliv index c28a2d66b..0a640a061 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -540,6 +540,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 NEXT_RELEASE *) + val ends_with : string -> string -> bool (** [ends_with s x] returns [true] if the string [s] is ending with [x], [false] otherwise. diff --git a/src/batString.mlv b/src/batString.mlv index 5fb840288..27cc951e3 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -200,7 +200,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 raise (Invalid_argument "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 From 6016193fad9b3eb7938d9928ba2d46e77a88fdff Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 14 Nov 2017 07:25:30 +0100 Subject: [PATCH 142/273] Revert "Revert "mention count_string"" This reverts commit bc10ba1b4aae8d4e8b76ac5e0a26a53f5b5503c2. --- ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ChangeLog b/ChangeLog index 7b79a8b16..f05d302dc 100644 --- a/ChangeLog +++ b/ChangeLog @@ -9,6 +9,10 @@ This minor release supports the -safe-string mode for OCaml compilation, enforcing a type-level separation between (immutable) strings and mutable byte sequences. +- add `BatString.count_string: string -> string -> int` + #799 + (Francois Berenger) + - support -safe-string compilation #673 (Gabriel Scherer) From de9d8a9f4bf534f8d06f3d06cd85bd2874c54f08 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 14 Nov 2017 07:35:41 +0100 Subject: [PATCH 143/273] move count_string's ChangeLog entry into the new section --- ChangeLog | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index f05d302dc..c57fcc729 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,16 +3,16 @@ Changelog ## NEXT_RELEASE +- add `BatString.count_string: string -> string -> int` + #799 + (Francois Berenger) + ## 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. -- add `BatString.count_string: string -> string -> int` - #799 - (Francois Berenger) - - support -safe-string compilation #673 (Gabriel Scherer) From 7b382ecaae31de6304944977746fab8a5bdd2a39 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Sun, 19 Nov 2017 23:56:00 +0500 Subject: [PATCH 144/273] BatInt.Safe_int.mul performance improvements The fast-path was made less expensive, by getting rid of absolute value computation (which incurs branching). The downside is that the fast-path supports only non-negative integers from now on. --- src/batInt.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/batInt.ml b/src/batInt.ml index 340bea068..f80fac069 100644 --- a/src/batInt.ml +++ b/src/batInt.ml @@ -255,7 +255,7 @@ module BaseSafeInt = struct let mul (a: int) (b: int) : int = let open Pervasives in - if ((abs a) lor (abs b)) asr mul_shift_bits <> 0 + if (a lor b) asr mul_shift_bits <> 0 then begin match (a > 0, b > 0) with | (true, true) when a > (max_int / b) -> raise BatNumber.Overflow From 0659a9059f5fe8c2613e48ec68e2d55fcdebc9d8 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Sat, 2 Dec 2017 18:09:47 +0500 Subject: [PATCH 145/273] Add ChangeLog entry --- ChangeLog | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ChangeLog b/ChangeLog index c57fcc729..f38ceae15 100644 --- a/ChangeLog +++ b/ChangeLog @@ -6,6 +6,9 @@ Changelog - add `BatString.count_string: string -> string -> int` #799 (Francois Berenger) +- Int: optimized implementation of Safe_int.mul + #808 + (Max Mouratov) ## v2.8.0 (minor release) From e86cc0f7fa2b51d1c1b57c7d838ad4a03362efcb Mon Sep 17 00:00:00 2001 From: Milo Turner Date: Sat, 2 Dec 2017 18:07:39 -0500 Subject: [PATCH 146/273] disable print_string_cap_ro/rw to match #673 --- battop.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/battop.ml b/battop.ml index 2d2764b03..c81db4637 100644 --- a/battop.ml +++ b/battop.ml @@ -63,8 +63,10 @@ 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;; From 98ea9474cda0e89cb54a324e30657cb62b356936 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Sun, 3 Dec 2017 22:09:39 +0500 Subject: [PATCH 147/273] Fix: incorrect behaviour of Map.union In case of binding conflicts, [Map.union m1 m2] should prefer the value from [m2], as stated in documentation. --- src/batMap.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/batMap.ml b/src/batMap.ml index 5f3745bd9..001cc64d4 100644 --- a/src/batMap.ml +++ b/src/batMap.ml @@ -683,7 +683,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 From f6f282fdef568809939a3c3729b8ab299f7822c7 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Sun, 3 Dec 2017 22:29:02 +0500 Subject: [PATCH 148/273] Add a test case for Map.union --- src/batMap.ml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/batMap.ml b/src/batMap.ml index 001cc64d4..04282c79f 100644 --- a/src/batMap.ml +++ b/src/batMap.ml @@ -1080,6 +1080,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 From cb537074504a2475554e13f4de0910867fa582e0 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Mon, 4 Dec 2017 14:37:27 +0500 Subject: [PATCH 149/273] Add ChangeLog entry --- ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ChangeLog b/ChangeLog index f38ceae15..5b4801b70 100644 --- a/ChangeLog +++ b/ChangeLog @@ -9,6 +9,10 @@ Changelog - Int: optimized implementation of Safe_int.mul #808 (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) ## v2.8.0 (minor release) From 4d236e57dcda8b482aad2b2671449524319c6bf3 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Wed, 20 Dec 2017 14:46:26 +0900 Subject: [PATCH 150/273] added BatSeq.{to_buffer|to_string|of_string} --- src/batSeq.ml | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++ src/batSeq.mli | 20 +++++++++++++++++++ 2 files changed, 74 insertions(+) diff --git a/src/batSeq.ml b/src/batSeq.ml index 8d872ee14..549e6c1bc 100644 --- a/src/batSeq.ml +++ b/src/batSeq.ml @@ -334,6 +334,60 @@ 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 []) = "[]" +*) + +exception Wrong_prefix of string +exception Wrong_suffix of string + +let of_string ?(first="[") ?(last="]") ?(sep=";") of_str s = + if not (BatString.starts_with s first) then + raise (Wrong_prefix (first ^ " not prefix of " ^ s)); + if not (BatString.ends_with s last) then + raise (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 (Wrong_prefix _) -> true + try equal (of_string ~last:"}" int_of_string "[1;2;3]") (of_list []) with (Wrong_suffix _) -> true +*) + module Infix = struct (** Infix operators matching those provided by {!BatEnum.Infix} *) diff --git a/src/batSeq.mli b/src/batSeq.mli index 0ba41c04c..45c776a25 100644 --- a/src/batSeq.mli +++ b/src/batSeq.mli @@ -275,6 +275,26 @@ 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 NEXT_RELEASE +*) + +val to_string : ?first:string -> ?last:string -> ?sep:string -> ('a -> string) -> 'a t -> string +(** Convert the sequence to a string; eager. + @since NEXT_RELEASE +*) + +exception Wrong_prefix of string +exception Wrong_suffix of string + +val of_string : ?first:string -> ?last:string -> ?sep:string -> (string -> 'a) -> string -> 'a t +(** Create a sequence by parsing a string. + @raise Wrong_prefix if the string is not prefixed by [first]. + @raise Wrong_suffix if the string is not suffixed by [last]. + @since NEXT_RELEASE +*) + module Infix : sig (** Infix operators matching those provided by {!BatEnum.Infix} *) From 7814de372986df82b79910064dca4bdb993aa623 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Wed, 27 Dec 2017 21:40:32 +0500 Subject: [PATCH 151/273] Cosmetic tweaks in BatMap.mli --- src/batMap.mli | 161 ++++++++++++++++++++++++++----------------------- 1 file changed, 84 insertions(+), 77 deletions(-) diff --git a/src/batMap.mli b/src/batMap.mli index ae9dfda05..e3b8d6929 100644 --- a/src/batMap.mli +++ b/src/batMap.mli @@ -176,23 +176,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 @@ -206,24 +206,26 @@ 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: - split @@ -262,7 +264,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]. @@ -276,13 +277,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}. *) @@ -327,7 +328,7 @@ 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 @@ -341,10 +342,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. @@ -403,10 +404,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. *) @@ -430,7 +431,7 @@ val find : 'a -> ('a, 'b) t -> 'b 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. *) + 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 @@ -486,7 +487,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. *) @@ -496,7 +497,7 @@ 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). *) val choose : ('key, 'a) t -> ('key * 'a) @@ -525,37 +526,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 @@ -565,7 +568,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] @@ -607,8 +611,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 @@ -643,14 +647,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 *) @@ -704,16 +708,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. *) @@ -793,7 +797,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. *) @@ -803,7 +807,7 @@ 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). *) val choose : ('key, 'a) t -> ('key * 'a) @@ -831,38 +835,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 @@ -872,12 +878,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]) *) @@ -885,8 +892,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 *) @@ -913,8 +920,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 @@ -942,7 +949,7 @@ 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 *) @@ -960,10 +967,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 *) From 32354bc0a59e9b8ac110aca320264eed7a914337 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Tue, 9 Jan 2018 06:35:01 +0100 Subject: [PATCH 152/273] Document that Map.extract can raise Not_found. (#825) --- src/batMap.mli | 1 + 1 file changed, 1 insertion(+) diff --git a/src/batMap.mli b/src/batMap.mli index e3b8d6929..f03e9768d 100644 --- a/src/batMap.mli +++ b/src/batMap.mli @@ -136,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 *) From 51666cffc5cccd524d22473a6e7a9e1b0db87dd8 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Fri, 12 Jan 2018 17:58:52 +0900 Subject: [PATCH 153/273] added BatArray.split --- src/batArray.mliv | 4 ++++ src/batArray.mlv | 20 ++++++++++++++++++++ 2 files changed, 24 insertions(+) diff --git a/src/batArray.mliv b/src/batArray.mliv index b4aee6960..773b5fd75 100644 --- a/src/batArray.mliv +++ b/src/batArray.mliv @@ -166,6 +166,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]. *) @@ -741,6 +744,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} *) diff --git a/src/batArray.mlv b/src/batArray.mlv index 005c4df03..6615686c8 100644 --- a/src/batArray.mlv +++ b/src/batArray.mlv @@ -765,6 +765,25 @@ let shuffle ?state a = 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 @@ -866,6 +885,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 From 56ec05c118ba0af9dd34f2103c6d9c391a545f86 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Fri, 12 Jan 2018 18:01:49 +0900 Subject: [PATCH 154/273] updated ChangeLog --- ChangeLog | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ChangeLog b/ChangeLog index 5b4801b70..b180d228a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,9 @@ Changelog ## NEXT_RELEASE +- add `BatArray.split: ('a * 'b) array -> 'a array * 'b array` + #826 + (Francois Berenger) - add `BatString.count_string: string -> string -> int` #799 (Francois Berenger) From 478e71e79258a85d446576166e7fc0832983a9fc Mon Sep 17 00:00:00 2001 From: Marshall Abrams Date: Fri, 12 Jan 2018 04:13:29 -0600 Subject: [PATCH 155/273] Clarified documentation for `next` in LazyList (#810) --- src/batLazyList.mli | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/batLazyList.mli b/src/batLazyList.mli index 35e470464..2f99d46bf 100644 --- a/src/batLazyList.mli +++ b/src/batLazyList.mli @@ -287,7 +287,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. From f8c9239f8430595b99cb99d8a6d343fde73632f3 Mon Sep 17 00:00:00 2001 From: Marshall Abrams Date: Fri, 12 Jan 2018 04:14:35 -0600 Subject: [PATCH 156/273] Revised docs for seq, unfold, from_loop in LazyList (#806) seq: Revised basic description to fit first part of from_loop doc, which seems clearer. Also added note that you can create an infinite list by passing a function that constantly returns true. from_loop: Gave additional detail about what the next function is supposed to do, and noted that its result pair might contain different types. Added a simple example where the types are the same. (This example could be done more simpy using seq. I still don't understand the purpose of from_loop.) I moved seq before from_loop because it's a more basic version of this kind of operation. from_loop is more specialized, and complicated, but its name might suggest that it's the normal way of making a lazy list by repeated application of a function. Users should see seq first before trying to work out what from_loop is for. --- src/batLazyList.ml | 2 -- src/batLazyList.mli | 39 ++++++++++++++++++++++++++++----------- 2 files changed, 28 insertions(+), 13 deletions(-) diff --git a/src/batLazyList.ml b/src/batLazyList.ml index 688e0d09c..5ec75329c 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) diff --git a/src/batLazyList.mli b/src/batLazyList.mli index 2f99d46bf..bbe204aad 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 From dbc839e6525f483862149f5409475dccaaa226c1 Mon Sep 17 00:00:00 2001 From: sapristi Date: Tue, 16 Jan 2018 10:31:47 +0100 Subject: [PATCH 157/273] improve MultiPMap documentation (#827) --- src/batMultiPMap.mli | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) 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 From def3ef8c027512ee000b8abfcbef91d79feb02f6 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Mon, 22 Jan 2018 09:27:36 +0900 Subject: [PATCH 158/273] simpler (and faster?) implementation of BatArray.partition (#829) * simpler and faster implementation of BatArray.partition (at the cost of using more memory) --- src/batArray.mlv | 55 ++++++++++++++++++++++++------------------------ 1 file changed, 28 insertions(+), 27 deletions(-) diff --git a/src/batArray.mlv b/src/batArray.mlv index 6615686c8..bbde495bd 100644 --- a/src/batArray.mlv +++ b/src/batArray.mlv @@ -248,33 +248,34 @@ 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.Observable.int Q.bool)) (fun (a, Q.Fun(_,f)) -> \ let b1, b2 = partition f a in \ From 1e80fcf0c61e90d44bfb5af29e8f5d3f4c06e667 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Mon, 22 Jan 2018 09:29:42 +0900 Subject: [PATCH 159/273] updated changelog --- ChangeLog | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ChangeLog b/ChangeLog index b180d228a..5419a79de 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,9 @@ Changelog ## NEXT_RELEASE +- faster BatArray.partition + #829 + (Francois Berenger, Gabriel Scherer) - add `BatArray.split: ('a * 'b) array -> 'a array * 'b array` #826 (Francois Berenger) From e042945452b7fd890485896866b1dd901bf89d4f Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Tue, 23 Jan 2018 08:34:56 +0900 Subject: [PATCH 160/273] removed previously added exception types --- src/batSeq.ml | 15 ++++++++------- src/batSeq.mli | 3 --- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/src/batSeq.ml b/src/batSeq.ml index 549e6c1bc..6535d1c9a 100644 --- a/src/batSeq.ml +++ b/src/batSeq.ml @@ -363,14 +363,15 @@ let to_string ?(first="[") ?(last="]") ?(sep=";") to_str s = to_string string_of_int (of_list []) = "[]" *) -exception Wrong_prefix of string -exception Wrong_suffix of string - let of_string ?(first="[") ?(last="]") ?(sep=";") of_str s = if not (BatString.starts_with s first) then - raise (Wrong_prefix (first ^ " not prefix of " ^ s)); + raise + (Invalid_argument + ("Seq.of_string: wrong prefix: " ^ first ^ " not prefix of " ^ s)); if not (BatString.ends_with s last) then - raise (Wrong_suffix (last ^ " not suffix of " ^ s)); + 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 @@ -384,8 +385,8 @@ let of_string ?(first="[") ?(last="]") ?(sep=";") of_str s = 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 (Wrong_prefix _) -> true - try equal (of_string ~last:"}" int_of_string "[1;2;3]") (of_list []) with (Wrong_suffix _) -> true + 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 diff --git a/src/batSeq.mli b/src/batSeq.mli index 45c776a25..12f6b920d 100644 --- a/src/batSeq.mli +++ b/src/batSeq.mli @@ -285,9 +285,6 @@ val to_string : ?first:string -> ?last:string -> ?sep:string -> ('a -> string) - @since NEXT_RELEASE *) -exception Wrong_prefix of string -exception Wrong_suffix of string - val of_string : ?first:string -> ?last:string -> ?sep:string -> (string -> 'a) -> string -> 'a t (** Create a sequence by parsing a string. @raise Wrong_prefix if the string is not prefixed by [first]. From a0fdd83f0639b76eacf489a1d4720f4ab30f4eb7 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Tue, 23 Jan 2018 17:34:18 +0900 Subject: [PATCH 161/273] updated ocamldoc for BatSeq.of_string --- src/batSeq.mli | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/batSeq.mli b/src/batSeq.mli index 12f6b920d..d7aeaead4 100644 --- a/src/batSeq.mli +++ b/src/batSeq.mli @@ -287,8 +287,8 @@ val to_string : ?first:string -> ?last:string -> ?sep:string -> ('a -> string) - val of_string : ?first:string -> ?last:string -> ?sep:string -> (string -> 'a) -> string -> 'a t (** Create a sequence by parsing a string. - @raise Wrong_prefix if the string is not prefixed by [first]. - @raise Wrong_suffix if the string is not suffixed by [last]. + @raise Invalid_argument if the string is not prefixed by [first]. + @raise Invalid_argument if the string is not suffixed by [last]. @since NEXT_RELEASE *) From ba89393cc773a7509c9fabac7a078784801ea13a Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Wed, 7 Feb 2018 06:09:14 +0100 Subject: [PATCH 162/273] Compile Batteries with -no-alias-deps The size cost of using batteries has always been a problem. OCaml 4.02 introduced --no-deps-libs for this exact purpose (see http://caml.inria.fr/pub/docs/manual-ocaml/extn.html#s%3Amodule-alias). I couldn't find any discussion relative to this but I'm well aware this is unlikely to not have been considered already. Simple test: ``` % cat toto1.ml open Batteries let () = Printf.printf "hello\n" % cat toto2.ml let () = BatPrintf.printf "hello\n" % for f in toto1 toto2 ; do \ ocamlfind ocamlopt $f.ml -o $f.opt -package batteries -linkpkg ; done % ls -l toto*opt ``` Before the patch: ``` -rwxr-xr-x 1 rixed 5272428 Feb 7 05:43 toto1.opt* -rwxr-xr-x 1 rixed 2006588 Feb 7 05:43 toto2.opt* ``` After: ``` -rwxr-xr-x 1 rixed 3098452 Feb 7 05:38 toto1.opt* -rwxr-xr-x 1 rixed 2006588 Feb 7 05:38 toto2.opt* ``` That's a 40% reduction in size of a program using only BatPrintf from Batteries, still bigger than a program using explicitly only BatPrintf because of batPervasives, I assume. There are several ways i can imagine this patch would break other programs: - it might break the build of some programs relying on some of their direct dependencies to link in others of their direct dependencies, which I would qualify as a bug in those builds; - this could prevent the dynamic linkage of some plugins if it expects the whole of batteries to be available from the main program; - programs relying on any side effects of some otherwise unused batteries module initialization code, but that sounds very unlikely. Note that I'm not familiar with this option so there might be others, more obvious issues. I'm confident you will know :-) Note: I have no idea if/how the "pack" option that seems to be present in the setup.ml could be used for the same purpose. --- _tags | 1 + 1 file changed, 1 insertion(+) diff --git a/_tags b/_tags index b50a32e98..c74904414 100644 --- a/_tags +++ b/_tags @@ -11,4 +11,5 @@ true: package(bytes), warn_-3, bin_annot "examples": -traverse : opaque true: safe_string +true: no_alias_deps From a046dda9a5456c1476eaa940e8ad5ba8e2a75af5 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Thu, 15 Feb 2018 05:41:26 +0500 Subject: [PATCH 163/273] Fix: Map.update was broken Searching for the node to update was broken, as the keys were compared in wrong order. --- ChangeLog | 3 +++ src/batMap.ml | 3 ++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 5419a79de..6c2de58e1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -19,6 +19,9 @@ Changelog 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) ## v2.8.0 (minor release) diff --git a/src/batMap.ml b/src/batMap.ml index 04282c79f..749c6aa7b 100644 --- a/src/batMap.ml +++ b/src/batMap.ml @@ -195,7 +195,7 @@ module Concrete = struct 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 @@ -1171,6 +1171,7 @@ module PMap = struct (*$< PMap *) 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 *) (*$Q find ; add From 217b47ee86f1fff04b0e3385434082634714a039 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Thu, 15 Feb 2018 06:00:09 +0500 Subject: [PATCH 164/273] Fix: Map.update did not throw an exception on failure The docstring says "@raise Not_found if [k1] is not bound in [m]", but there was no raise if [k1] and [k2] were different. --- ChangeLog | 4 ++++ src/batMap.ml | 20 +++++++++++++++++++- 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 6c2de58e1..d298b415a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -22,6 +22,10 @@ Changelog - 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) ## v2.8.0 (minor release) diff --git a/src/batMap.ml b/src/batMap.ml index 749c6aa7b..f66a87565 100644 --- a/src/batMap.ml +++ b/src/batMap.ml @@ -188,9 +188,25 @@ 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 @@ -1172,6 +1188,8 @@ module PMap = struct (*$< PMap *) 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 From 88c5358d4cea0086d37f0af6a38bb7bc8ce732ba Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Thu, 15 Feb 2018 07:07:02 +0500 Subject: [PATCH 165/273] Fix: Set.update did not throw an exception on failure The docstring says "@raise Not_found if [x] is not in [s]", but there was no raise if [x] and [y] were different. --- ChangeLog | 4 ++++ src/batSet.ml | 17 ++++++++++++++++- 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index d298b415a..5165cc632 100644 --- a/ChangeLog +++ b/ChangeLog @@ -26,6 +26,10 @@ Changelog 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) ## v2.8.0 (minor release) diff --git a/src/batSet.ml b/src/batSet.ml index dea16ec39..3f4345db8 100644 --- a/src/batSet.ml +++ b/src/batSet.ml @@ -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 @@ -1067,6 +1080,8 @@ 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 From f9b60e4f95735ce679743c1ff89f531efa481597 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Fri, 16 Feb 2018 05:12:21 +0500 Subject: [PATCH 166/273] Fix typo --- src/batPathGen.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/batPathGen.ml b/src/batPathGen.ml index 46a97ba31..e35a43d89 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 From 85e6812b04e3e4b56adda3268c12e273625a7dec Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Fri, 16 Feb 2018 05:18:11 +0500 Subject: [PATCH 167/273] Simplify Set.cartesian_product --- src/batSet.ml | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/batSet.ml b/src/batSet.ml index dea16ec39..fa1e5c471 100644 --- a/src/batSet.ml +++ b/src/batSet.ml @@ -419,16 +419,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 From 17dfbeba2235652328f76c61581e747837558278 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Fri, 16 Feb 2018 16:44:06 +0500 Subject: [PATCH 168/273] Remove a redundant exception from BatOption.ml --- src/batOption.ml | 1 - 1 file changed, 1 deletion(-) 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 From 5154d544de76fc32110f20838ff6de1d30b5bc58 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Fri, 16 Feb 2018 05:11:23 +0500 Subject: [PATCH 169/273] Simplify Text.concat --- src/batText.ml | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/batText.ml b/src/batText.ml index 2ff557f66..6c3f40366 100644 --- a/src/batText.ml +++ b/src/batText.ml @@ -871,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 From 6a03d73349ba3e50b33aaf41ea829db3808c7f1f Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Tue, 20 Feb 2018 13:30:32 +0500 Subject: [PATCH 170/273] Fix typos (#838) --- src/batIO.mli | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/batIO.mli b/src/batIO.mli index 7a6317e16..e3675ae63 100644 --- a/src/batIO.mli +++ b/src/batIO.mli @@ -771,10 +771,10 @@ val to_input_channel : input -> in_channel (** {6 Generic BatIO Object Wrappers} - Theses OO Wrappers have been written to provide easy support of + These OO Wrappers have been written to provide easy support of BatIO by external librairies. 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. From eca92a5466231ef9101b867b9c661b26613b44c5 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Mon, 26 Feb 2018 18:27:36 +0500 Subject: [PATCH 171/273] Fix: Array.insert error message improvement The function now throws a more relevant message on invalid indices instead of the generic [invalid_arg "index out of bounds]. The assertion is now documented. --- ChangeLog | 5 +++++ src/batArray.mliv | 5 ++++- src/batArray.mlv | 6 ++++-- 3 files changed, 13 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index 5165cc632..05a1b2c91 100644 --- a/ChangeLog +++ b/ChangeLog @@ -30,6 +30,11 @@ Changelog as stated in documentation. #833 (Max Mouratov) +- Fix: [Array.insert] now throws 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) ## v2.8.0 (minor release) diff --git a/src/batArray.mliv b/src/batArray.mliv index 773b5fd75..02cea860c 100644 --- a/src/batArray.mliv +++ b/src/batArray.mliv @@ -516,7 +516,10 @@ 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}*) diff --git a/src/batArray.mlv b/src/batArray.mlv index bbde495bd..dfb82acf9 100644 --- a/src/batArray.mlv +++ b/src/batArray.mlv @@ -703,8 +703,10 @@ let bsearch 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 xs.(j) else if j > i then xs.(j-1) else x) (*$T insert insert [|1;2;3|] 4 0 = [|4;1;2;3|] From d49092d5d350083bb81005b3f88af10267a91e89 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Mon, 26 Feb 2018 18:43:21 +0500 Subject: [PATCH 172/273] Implementation of Array.insert now uses unsafe_{get,set} --- ChangeLog | 3 +++ src/batArray.mlv | 8 +++++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 05a1b2c91..c1caa9ba8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -35,6 +35,9 @@ Changelog The assertion is now documented. #841 (Max Mouratov) +- Implementation of Array.insert now uses [unsafe_get] and [unsafe_set]. + #841 + (Max Mouratov) ## v2.8.0 (minor release) diff --git a/src/batArray.mlv b/src/batArray.mlv index dfb82acf9..5ab646b6d 100644 --- a/src/batArray.mlv +++ b/src/batArray.mlv @@ -706,7 +706,13 @@ let insert xs x i = 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 xs.(j) else if j > i then xs.(j-1) else x) + 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|] From 022c40df29ff8869391f88c196d2055c66f2f534 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Thu, 1 Mar 2018 11:07:15 +0100 Subject: [PATCH 173/273] Do not depend upon bisect any longer Rational: bisect is not very actively maintained any more and code coverage have not been useful (or is not useful any more). --- .gitignore | 1 - Makefile | 11 +--- README.md | 2 - ...compatible-with-older-OCaml-versions.patch | 2 +- howto/coverage.md | 12 ----- myocamlbuild.ml | 53 +------------------ opam | 1 - src/batArray.mlv | 10 ++-- src/batBool.ml | 2 - src/batChar.mlv | 6 --- src/batComplex.ml | 2 +- src/batDllist.ml | 2 +- src/batEnum.ml | 2 +- src/batFingerTree.ml | 26 +++++---- src/batFloat.ml | 2 +- src/batGlobal.ml | 3 -- src/batUnit.ml | 4 -- src/batUref.ml | 10 ++-- src/batVect.ml | 4 +- 19 files changed, 29 insertions(+), 126 deletions(-) delete mode 100644 howto/coverage.md diff --git a/.gitignore b/.gitignore index bc27b88b6..3b6a13063 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 diff --git a/Makefile b/Makefile index 24c51011a..2285f27c0 100644 --- a/Makefile +++ b/Makefile @@ -86,7 +86,7 @@ else endif endif -.PHONY: all clean doc install uninstall reinstall test qtest qtest-clean camfail camfailunk coverage man test_install +.PHONY: all clean doc install uninstall reinstall test qtest qtest-clean camfail camfailunk man test_install all: @echo "Build mode:" $(MODE) @@ -289,12 +289,3 @@ 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 github gh-pages - -############################################################################### -# CODE COVERAGE REPORTS -############################################################################### - -coverage/index.html: $(TESTDEPS) $(QTESTDIR)/all_tests.ml - $(OCAMLBUILD) $(OCAMLBUILDFLAGS) coverage/index.html - -coverage: coverage/index.html diff --git a/README.md b/README.md index 6500f2ac7..cdd4fdf51 100644 --- a/README.md +++ b/README.md @@ -28,7 +28,6 @@ You will need the following libraries: * [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 @@ -36,7 +35,6 @@ You will need the following libraries: [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 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 index 035d9b849..c80c682b2 100644 --- a/build/make-our-inline-tests-compatible-with-older-OCaml-versions.patch +++ b/build/make-our-inline-tests-compatible-with-older-OCaml-versions.patch @@ -42,7 +42,7 @@ index 005c4df0..79ee6f94 100644 let f (`a x) = f x in\ try let elt = find f a in \ @@ -217,7 +217,7 @@ let filter p xs = - assert false (*BISECT-VISIT*) + assert false ) (*$Q filter - (Q.pair (Q.array Q.small_int) (Q.fun1 Q.Observable.int Q.bool)) (fun (a, Q.Fun(_,f)) -> \ 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/myocamlbuild.ml b/myocamlbuild.ml index a719effb3..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 -> @@ -198,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"; diff --git a/opam b/opam index 4b9c42618..95111823b 100644 --- a/opam +++ b/opam @@ -18,7 +18,6 @@ depends: [ "ocamlbuild" {build} "qtest" {test & >= "2.5"} "qcheck" {test & >= "0.6"} - "bisect" {test} "num" ] available: [ocaml-version >= "3.12.1"] diff --git a/src/batArray.mlv b/src/batArray.mlv index 5ab646b6d..f3478c368 100644 --- a/src/batArray.mlv +++ b/src/batArray.mlv @@ -214,7 +214,7 @@ 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.Observable.int Q.bool)) (fun (a, Q.Fun(_,f)) -> \ @@ -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 @@ -356,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) @@ -906,7 +906,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 @@ -947,10 +946,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 = @@ -997,4 +994,3 @@ struct let findi ~f e = findi f e end end -(*BISECT-IGNORE-END*) diff --git a/src/batBool.ml b/src/batBool.ml index ed0e7a03a..12ebf2e7e 100644 --- a/src/batBool.ml +++ b/src/batBool.ml @@ -46,7 +46,6 @@ module BaseBool = struct let add = ( || ) let mul = ( && ) let sub _ = not (*Weird extrapolation*) - (*BISECT-IGNORE-BEGIN*) let div _ _= raise (Invalid_argument "Bool.div") @@ -55,7 +54,6 @@ module BaseBool = struct let pow _ _ = raise (Invalid_argument "Bool.pow") - (*BISECT-IGNORE-END*) let compare = compare 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/batDllist.ml b/src/batDllist.ml index 624e68262..d29f35f73 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 diff --git a/src/batEnum.ml b/src/batEnum.ml index 344000aad..25d2cfc3d 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 diff --git a/src/batFingerTree.ml b/src/batFingerTree.ml index 4475d1360..6b32fc56d 100644 --- a/src/batFingerTree.ml +++ b/src/batFingerTree.ml @@ -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) 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/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/batUnit.ml b/src/batUnit.ml index bc1cb389e..529a3fb6d 100644 --- a/src/batUnit.ml +++ b/src/batUnit.ml @@ -18,8 +18,6 @@ * Foundation, Inc. *) -(*BISECT-IGNORE-BEGIN*) - let unit_string = "()" type t = unit @@ -31,5 +29,3 @@ 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/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 8fcc0173b..d36fc07cf 100644 --- a/src/batVect.ml +++ b/src/batVect.ml @@ -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 @@ -857,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 From 970c224636f1ed6021d05c20c9c1a256bc20093b Mon Sep 17 00:00:00 2001 From: FkHina <36575050+FkHina@users.noreply.github.com> Date: Fri, 2 Mar 2018 01:07:22 +0100 Subject: [PATCH 174/273] Corrected documentation for batList {last, hd} (#840) --- ChangeLog | 4 ++++ src/batList.mliv | 13 +++++++------ 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/ChangeLog b/ChangeLog index c1caa9ba8..f0368fcbe 100644 --- a/ChangeLog +++ b/ChangeLog @@ -30,6 +30,10 @@ Changelog 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] now throws a more relevant message on invalid indices instead of the generic [invalid_arg "index out of bounds]. The assertion is now documented. diff --git a/src/batList.mliv b/src/batList.mliv index 2deb83932..041731cdd 100644 --- a/src/batList.mliv +++ b/src/batList.mliv @@ -73,19 +73,20 @@ val is_empty : 'a list -> bool 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]). *) - 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 From 19e8fbf8e553458d147a47dc9b7d0119c93b5f8c Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Thu, 15 Mar 2018 10:40:33 +0500 Subject: [PATCH 175/273] Fix docstring of String.right (#849) * Fix docstring of String.right --- ChangeLog | 5 ++++- src/batString.mliv | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index f0368fcbe..6968415b4 100644 --- a/ChangeLog +++ b/ChangeLog @@ -39,9 +39,12 @@ Changelog The assertion is now documented. #841 (Max Mouratov) -- Implementation of Array.insert now uses [unsafe_get] and [unsafe_set]. +- 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) ## v2.8.0 (minor release) diff --git a/src/batString.mliv b/src/batString.mliv index 0a640a061..c83802163 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -638,7 +638,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"] From dbc4de991c7c7ad383c6d810004d6234cfcf8256 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Sat, 9 Dec 2017 02:15:56 +0500 Subject: [PATCH 176/273] BatInt.Safe_int.mul performance improvements The previous overflow test from CERT C is notable for avoiding an overflow while checking for overflow; hovewer, since overflows are perfectly defined in OCaml, a shorter test from Hacker's Delight is a better option. --- src/batInt.ml | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/src/batInt.ml b/src/batInt.ml index f80fac069..9c5bf9c67 100644 --- a/src/batInt.ml +++ b/src/batInt.ml @@ -253,21 +253,15 @@ 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 (a lor 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 || b = 0 || c / b = a then + c + else + raise BatNumber.Overflow let pow a b = if b < 0 From 94b226943f19c50ee650a7f387656ec4cc3984b4 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Tue, 20 Mar 2018 08:41:50 +0500 Subject: [PATCH 177/273] Update ChangeLog --- ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index f38ceae15..e9ce95315 100644 --- a/ChangeLog +++ b/ChangeLog @@ -7,7 +7,7 @@ Changelog #799 (Francois Berenger) - Int: optimized implementation of Safe_int.mul - #808 + #808, #851 (Max Mouratov) ## v2.8.0 (minor release) From 56ef4241b1b1d3c969c1c7bdaf86163bbc3f8110 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Fri, 16 Feb 2018 05:10:59 +0500 Subject: [PATCH 178/273] A clean-up of invalid_arg uses This patch makes uses of `invalid_arg` more uniform, fixing the following kinds of irregularities: * Lack of module name in a message (e.g. `Enum.arg_min` threw "arg_min"); * Lack of function name in a message (e.g. `List.reduce` threw "Empty list"); * Wrong module name in a message (e.g. `PathGen` functions threw messages with "Path"); * Wrong function name in a message (e.g. `List.fold_left2` threw a message with "fold_right2"); * Minor style issues: capitalization, punctuation, "Bat" prefixes; * Use of `raise (Invalid_argument "...")` instead of `invalid_arg "..."`. --- src/batArray.mlv | 10 +++++----- src/batBig_int.mlv | 2 +- src/batBitSet.ml | 6 +++--- src/batBool.ml | 8 ++++---- src/batDigest.mlv | 4 ++-- src/batEnum.ml | 8 ++++---- src/batFile.ml | 4 ++-- src/batFingerTree.ml | 9 ++++++--- src/batHeap.ml | 4 ++-- src/batISet.ml | 2 +- src/batInt.ml | 4 ++-- src/batInt32.mlv | 4 ++-- src/batLazyList.ml | 4 ++-- src/batList.mlv | 35 +++++++++++++++++++---------------- src/batPathGen.ml | 22 +++++++++++----------- src/batRefList.ml | 4 ++-- src/batSeq.ml | 18 +++++++++--------- src/batString.mlv | 19 ++++++++++--------- src/batSubstring.ml | 2 +- src/batText.ml | 4 ++-- src/batUnit.ml | 2 +- src/batUnix.mlv | 6 +++--- src/batVect.ml | 4 ++-- 23 files changed, 96 insertions(+), 89 deletions(-) diff --git a/src/batArray.mlv b/src/batArray.mlv index f3478c368..1037a0cc1 100644 --- a/src/batArray.mlv +++ b/src/batArray.mlv @@ -382,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 @@ -406,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 @@ -430,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) @@ -450,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 @@ -467,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 diff --git a/src/batBig_int.mlv b/src/batBig_int.mlv index 36ef6ad6c..f79742cf2 100644 --- a/src/batBig_int.mlv +++ b/src/batBig_int.mlv @@ -138,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 diff --git a/src/batBitSet.ml b/src/batBitSet.ml index d835aa003..4a1346eda 100644 --- a/src/batBitSet.ml +++ b/src/batBitSet.ml @@ -48,7 +48,7 @@ let capacity t = (Bytes.length !t) * 8 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) @@ -71,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 @@ -105,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 12ebf2e7e..25c88ba20 100644 --- a/src/batBool.ml +++ b/src/batBool.ml @@ -47,13 +47,13 @@ module BaseBool = struct let mul = ( && ) let sub _ = not (*Weird extrapolation*) 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") + invalid_arg "Bool.pow" let compare = compare @@ -74,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/batDigest.mlv b/src/batDigest.mlv index fab2e6d69..e85a49aa9 100644 --- a/src/batDigest.mlv +++ b/src/batDigest.mlv @@ -62,13 +62,13 @@ 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 BatBytesCompat.string_init 16 (fun i -> Char.chr (byte (2 * i))) diff --git a/src/batEnum.ml b/src/batEnum.ml index 25d2cfc3d..0b706c294 100644 --- a/src/batEnum.ml +++ b/src/batEnum.ml @@ -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/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/batFingerTree.ml b/src/batFingerTree.ml index 6b32fc56d..29e54b7f5 100644 --- a/src/batFingerTree.ml +++ b/src/batFingerTree.ml @@ -1171,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 \ @@ -1185,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 \ @@ -1198,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/batHeap.ml b/src/batHeap.ml index 723bbb0a2..a011b5bc9 100644 --- a/src/batHeap.ml +++ b/src/batHeap.ml @@ -108,7 +108,7 @@ let find_min bh = match bh.mind with let rec find_min_tree ts k = match ts with - | [] -> failwith "find_min_tree" + | [] -> invalid_arg "del_min" | [t] -> k t | t :: ts -> find_min_tree ts begin @@ -285,7 +285,7 @@ module Make (Ord : BatInterfaces.OrderedType) = struct | Some d -> d let rec find_min_tree ts k = match ts with - | [] -> failwith "find_min_tree" + | [] -> invalid_arg "del_min" | [t] -> k t | t :: ts -> find_min_tree ts begin 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/batInt.ml b/src/batInt.ml index f80fac069..e55be1e4c 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 @@ -271,7 +271,7 @@ module BaseSafeInt = struct 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/batInt32.mlv b/src/batInt32.mlv index 71e490ca6..5b150f01c 100644 --- a/src/batInt32.mlv +++ b/src/batInt32.mlv @@ -102,9 +102,9 @@ let unpack str pos = let unpack_big str pos = if Bytes.length str < pos + 4 then - invalid_arg "Int32.unpack: pos + 4 not within string"; + invalid_arg "Int32.unpack_big: pos + 4 not within string"; if pos < 0 then - invalid_arg "Int32.unpack: pos negative"; + 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 (Bytes.unsafe_get str pos) |> shift diff --git a/src/batLazyList.ml b/src/batLazyList.ml index 5ec75329c..714b184f6 100644 --- a/src/batLazyList.ml +++ b/src/batLazyList.ml @@ -90,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 (** diff --git a/src/batList.mlv b/src/batList.mlv index 9208b7659..e31ec2755 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -132,8 +132,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; @@ -282,7 +282,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 @@ -573,7 +573,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: Different_list_size" in let dummy = Acc.dummy () in loop dummy l1 l2; @@ -585,7 +585,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: Different_list_size" in let dummy = Acc.dummy () in loop 0 dummy l1 l2; @@ -606,14 +606,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: Different_list_size" 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: Different_list_size" in loop 0 l1 l2 (*$T iter2i @@ -633,14 +633,14 @@ 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: Different_list_size" 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: Different_list_size" in let rec loop n l1 l2 = match l1, l2 with @@ -650,7 +650,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: Different_list_size" in loop 0 l1 l2 @@ -659,7 +659,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: Different_list_size" in loop l1 l2 @@ -668,7 +668,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: Different_list_size" in loop l1 l2 @@ -700,7 +700,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 @@ -708,7 +708,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; @@ -1342,8 +1342,11 @@ 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 diff --git a/src/batPathGen.ml b/src/batPathGen.ml index e35a43d89..f1d1bc58b 100644 --- a/src/batPathGen.ml +++ b/src/batPathGen.ml @@ -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/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/batSeq.ml b/src/batSeq.ml index 8d872ee14..170661dd7 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 -> diff --git a/src/batString.mlv b/src/batString.mlv index 27cc951e3..07b08f70f 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -83,7 +83,7 @@ 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 let rec find ~str ~sub i = if i > len - sublen then raise Not_found @@ -125,7 +125,7 @@ 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"; if sublen = 0 then pos + 1 else let rec find ~str ~sub i = if i < 0 then raise Not_found @@ -203,7 +203,7 @@ let find_all str sub = *) let count_string str sub = - if sub = "" then raise (Invalid_argument "String.count_string"); + if sub = "" then invalid_arg "String.count_string"; let m = length str in let n = length sub in let rec loop acc i = @@ -336,7 +336,7 @@ let rsplit str ~by:sep = *) let nsplit str ~by:sep = if str = "" then [] - else if sep = "" then invalid_arg "nsplit: empty sep not allowed" + else if sep = "" then invalid_arg "String.nsplit: empty sep not allowed" else (* str is non empty *) let seplen = String.length sep in @@ -417,7 +417,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) @@ -432,7 +432,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) @@ -446,9 +446,9 @@ let rchop ?(n = 1) s = let chop ?(l = 1) ?(r = 1) s = if l < 0 then - invalid_arg "chop: number of characters to chop on the left is negative"; + invalid_arg "String.chop: number of characters to chop on the left is negative"; if r < 0 then - invalid_arg "chop: number of characters to chop on the right is negative"; + 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) @@ -769,7 +769,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 diff --git a/src/batSubstring.ml b/src/batSubstring.ml index ddda97efb..b6321ef0b 100644 --- a/src/batSubstring.ml +++ b/src/batSubstring.ml @@ -153,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 diff --git a/src/batText.ml b/src/batText.ml index 6c3f40366..6a5228701 100644 --- a/src/batText.ml +++ b/src/batText.ml @@ -173,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 @@ -917,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 diff --git a/src/batUnit.ml b/src/batUnit.ml index 529a3fb6d..1a6e4da2b 100644 --- a/src/batUnit.ml +++ b/src/batUnit.ml @@ -24,7 +24,7 @@ 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 diff --git a/src/batUnix.mlv b/src/batUnix.mlv index 210d824ad..a628c2eea 100644 --- a/src/batUnix.mlv +++ b/src/batUnix.mlv @@ -115,14 +115,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 +191,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/batVect.ml b/src/batVect.ml index d36fc07cf..1ab88f556 100644 --- a/src/batVect.ml +++ b/src/batVect.ml @@ -622,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 @@ -1284,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 From 6fcda534b08e55cffc45a1dd25acc09f9da8b37a Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Sat, 17 Mar 2018 11:29:02 +0500 Subject: [PATCH 179/273] Add ChangeLog entry --- ChangeLog | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 6968415b4..d018702cf 100644 --- a/ChangeLog +++ b/ChangeLog @@ -34,7 +34,7 @@ Changelog raised exceptions #840, #754 (FkHina) -- Fix: [Array.insert] now throws a more relevant message on invalid indices +- 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 @@ -45,6 +45,13 @@ Changelog - 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) ## v2.8.0 (minor release) From c6074f5e6a5120dd62167def24b26218ad7622a5 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Tue, 20 Mar 2018 11:24:29 +0500 Subject: [PATCH 180/273] Restructuring of Heap.del_min Utility functions [find_min_tree] and [del_min_tree] are extended with an additional argument so as to make it more obvious to the reader that error messages are correct. --- src/batHeap.ml | 126 ++++++++++++++++++++++++++++--------------------- 1 file changed, 72 insertions(+), 54 deletions(-) diff --git a/src/batHeap.ml b/src/batHeap.ml index a011b5bc9..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 - | [] -> invalid_arg "del_min" - | [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 - | [] -> invalid_arg "del_min" - | [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 = From af81afb3038c6e4d3238065414a777d89cebad53 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Sat, 17 Mar 2018 12:40:36 +0500 Subject: [PATCH 181/273] Optimization of List.unique_cmp A set should be more efficient than [bool PMap.t]. --- src/batList.mlv | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/batList.mlv b/src/batList.mlv index e31ec2755..982334131 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -473,10 +473,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 From f744be4246205557f9d74e01056771949536c445 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Thu, 22 Mar 2018 06:19:54 +0500 Subject: [PATCH 182/273] Add ChangeLog entry --- ChangeLog | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ChangeLog b/ChangeLog index d018702cf..91c1dee55 100644 --- a/ChangeLog +++ b/ChangeLog @@ -52,6 +52,9 @@ Changelog - More uniform and correct [Invalid_argument] messages. #850 (Max Mouratov) +- Optimization of List.unique_cmp (using Set instead of Map). + #852 + (Max Mouratov) ## v2.8.0 (minor release) From f171727d8e362adceae054263093494e0e20c79c Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Sat, 24 Mar 2018 10:43:11 +0500 Subject: [PATCH 183/273] Fix docstrings of List.append and List.concat Stack usage estimates are invalid. --- ChangeLog | 4 ++++ src/batList.mliv | 10 +++++----- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/ChangeLog b/ChangeLog index 91c1dee55..445362af9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -55,6 +55,10 @@ Changelog - 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) ## v2.8.0 (minor release) diff --git a/src/batList.mliv b/src/batList.mliv index 041731cdd..8abb0dc88 100644 --- a/src/batList.mliv +++ b/src/batList.mliv @@ -74,7 +74,7 @@ val cons : 'a -> 'a list -> 'a list (** [cons h t] returns the list starting with [h] and continuing as [t]. *) val hd : 'a list -> 'a -(** Returns the first element of the list, or @raise Failure if +(** Returns the first element of the list, or @raise Failure if the list is empty. *) @@ -132,8 +132,9 @@ val shuffle : ?state:Random.State.t -> 'a list -> 'a list *) 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]. *) @@ -141,8 +142,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]. *) From 07ec09442aca53e83291a46730022e249bef405b Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Mon, 19 Feb 2018 09:47:59 +0500 Subject: [PATCH 184/273] BatString.ml should use unsafe versions of set and get --- ChangeLog | 3 +++ src/batString.mlv | 20 ++++++++++---------- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/ChangeLog b/ChangeLog index 445362af9..a4e7c43cd 100644 --- a/ChangeLog +++ b/ChangeLog @@ -59,6 +59,9 @@ Changelog 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) ## v2.8.0 (minor release) diff --git a/src/batString.mlv b/src/batString.mlv index 07b08f70f..cea0cea59 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -66,7 +66,7 @@ let ends_with str p = else let rec loop str p diff i = if i = el then true - else if get str (diff + i) <> get p i then false + else 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 @@ -377,7 +377,7 @@ let split_on_char sep str = (* 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 + 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 @@ -619,7 +619,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 @@ -631,7 +631,7 @@ 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]) + 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')] @@ -645,7 +645,7 @@ let fold_right f str init = if i = 0 then result else let i' = i - 1 in - loop i' (f str.[i'] result) + loop i' (f (unsafe_get str i') result) in loop n init (*$T fold_right @@ -659,7 +659,7 @@ let fold_righti f str init = if i = 0 then result else let i' = i - 1 in - loop i' (f i' str.[i'] result) + 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')] @@ -667,7 +667,7 @@ 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 = @@ -687,7 +687,7 @@ 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 + if i < 0 then l else exp (i - 1) (unsafe_get s i :: l) in exp (String.length s - 1) [] (*$T explode explode "foo" = ['f'; 'o'; 'o'] @@ -833,7 +833,7 @@ 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; Bytes.unsafe_to_string reversed @@ -999,7 +999,7 @@ 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 + 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; From 3da2c6e9040aae317681ba13ecbc858755922710 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 20 Feb 2018 09:20:09 +0100 Subject: [PATCH 185/273] batString: annotate unsafe_{get,set} with static reasoning in comments (partial) --- src/batString.mlv | 37 +++++++++++++++++++++++++++++-------- 1 file changed, 29 insertions(+), 8 deletions(-) diff --git a/src/batString.mlv b/src/batString.mlv index cea0cea59..d166793a9 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -41,10 +41,13 @@ let starts_with str p = let len = length p in if length str < len then false else + (* length str >= length p *) let rec loop str p i = if i = len then true - else if unsafe_get str i <> unsafe_get p i then false - else loop str p (i + 1) + 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" @@ -62,12 +65,17 @@ 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 + (* diff >= 0 *) let rec loop str p diff i = if i = el then true - else if unsafe_get str (diff + i) <> unsafe_get p i then false - else loop str p diff (i + 1) + 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" @@ -88,10 +96,15 @@ let find_from str pos sub = 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 if unsafe_get str (i + j) <> unsafe_get sub j then find ~str ~sub (i + 1) - else loop ~str ~sub i (j + 1) + 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 @@ -126,14 +139,22 @@ let rfind_from str pos sub = let sublen = length sub and len = length str in 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 + (* 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 if unsafe_get str (i + j) <> unsafe_get sub j then find ~str ~sub (i - 1) - else loop ~str ~sub i (j + 1) + 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 From b3dd69447d28372ebf3b1118ce69152b7428d65a Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Wed, 7 Mar 2018 20:54:23 +0500 Subject: [PATCH 186/273] BatString.ml: annotate unsafe_{get,set} with static assertions --- src/batString.mlv | 26 ++++++++++++++++++++------ 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/src/batString.mlv b/src/batString.mlv index d166793a9..0e3540fe7 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -398,6 +398,7 @@ let split_on_char sep str = (* str is non empty *) let rec loop acc ofs limit = if ofs < 0 then sub str 0 limit :: acc + (* 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 @@ -652,6 +653,7 @@ let fold_lefti f init str = let n = String.length str in let rec loop i result = if i = n then result + (* i >= 0 && i < len str *) else loop (i + 1) (f result i (unsafe_get str i)) in loop 0 init (*$T fold_lefti @@ -665,7 +667,9 @@ 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 + (* i' >= 0 && i' < len str *) loop i' (f (unsafe_get str i') result) in loop n init @@ -679,7 +683,9 @@ 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 + (* i' >= 0 && i' < len str *) loop i' (f i' (unsafe_get str i') result) in loop n init (*$T fold_righti @@ -688,8 +694,9 @@ let fold_righti f str init = *) let iteri f str = - for i = 0 to (String.length str) - 1 do f i (unsafe_get 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 @@ -707,9 +714,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) (unsafe_get 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 "" = [] @@ -1020,7 +1032,9 @@ let edit_distance s1 s2 = (* try add/delete/replace operations *) for j = 0 to String.length s2 - 1 do - let cost = if (unsafe_get s1 i) = (unsafe_get 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; From cd8053be4049bd0af9326d5eb25edd4210414300 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Sun, 25 Mar 2018 22:22:27 +0200 Subject: [PATCH 187/273] Remove mention of IO.flush_out that does not exist. --- src/batIO.mli | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/batIO.mli b/src/batIO.mli index e3675ae63..7bad328f4 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 From d3c350a9ffb475ba555fdeef8fee648d0245228d Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Mon, 2 Apr 2018 20:01:21 +0500 Subject: [PATCH 188/273] List.mli: remove erroneous mentions of Different_list_size --- src/batList.mliv | 32 +++++++++++++------------------- 1 file changed, 13 insertions(+), 19 deletions(-) diff --git a/src/batList.mliv b/src/batList.mliv index 8abb0dc88..a4029501d 100644 --- a/src/batList.mliv +++ b/src/batList.mliv @@ -332,26 +332,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 @@ -361,15 +359,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}*) @@ -404,14 +400,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] @@ -786,8 +780,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}*) From 97f9859705d4fd9b9be6f0c52b2a73bb508b00a8 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Mon, 2 Apr 2018 20:01:51 +0500 Subject: [PATCH 189/273] List.ml: clean-up invalid_arg messages --- src/batList.mlv | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/src/batList.mlv b/src/batList.mlv index 982334131..a5f202880 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -573,7 +573,7 @@ let map2 f l1 l2 = | [], [] -> () | h1 :: t1, h2 :: t2 -> loop (Acc.accum dst (f h1 h2)) t1 t2 - | _ -> invalid_arg "List.map2: Different_list_size" + | _ -> invalid_arg "List.map2: list lengths differ" in let dummy = Acc.dummy () in loop dummy l1 l2; @@ -585,7 +585,7 @@ let map2i f l1 l2 = | [], [] -> () | h1 :: t1, h2 :: t2 -> loop (succ i) (Acc.accum dst (f i h1 h2)) t1 t2 - | _ -> invalid_arg "List.map2i: Different_list_size" + | _ -> invalid_arg "List.map2i: list lengths differ" in let dummy = Acc.dummy () in loop 0 dummy l1 l2; @@ -606,14 +606,14 @@ let rec iter2 f l1 l2 = match l1, l2 with | [], [] -> () | h1 :: t1, h2 :: t2 -> f h1 h2; iter2 f t1 t2 - | _ -> invalid_arg "List.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 "List.iter2i: Different_list_size" + | _ -> invalid_arg "List.iter2i: list lengths differ" in loop 0 l1 l2 (*$T iter2i @@ -633,14 +633,14 @@ 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 "List.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 "List.fold_right2: Different_list_size" + | _ -> invalid_arg "List.fold_right2: list lengths differ" in let rec loop n l1 l2 = match l1, l2 with @@ -650,7 +650,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 "List.fold_right2: Different_list_size" + | _ -> invalid_arg "List.fold_right2: list lengths differ" in loop 0 l1 l2 @@ -659,7 +659,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 "List.for_all2: Different_list_size" + | _ -> invalid_arg "List.for_all2: list lengths differ" in loop l1 l2 @@ -668,7 +668,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 "List.exists2: Different_list_size" + | _ -> invalid_arg "List.exists2: list lengths differ" in loop l1 l2 @@ -817,7 +817,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 -> @@ -825,9 +824,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 [] [] = [] From d63e8835c120d11708d03c76e1a9170f96f90f53 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Mon, 2 Apr 2018 20:34:11 +0500 Subject: [PATCH 190/273] Add ChangeLog entry --- ChangeLog | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ChangeLog b/ChangeLog index a4e7c43cd..a01372e17 100644 --- a/ChangeLog +++ b/ChangeLog @@ -62,6 +62,9 @@ Changelog - 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) ## v2.8.0 (minor release) From c6ea18cb70a60af173ffcc25b68fc4bf062a03f5 Mon Sep 17 00:00:00 2001 From: FkHina <36575050+FkHina@users.noreply.github.com> Date: Wed, 2 May 2018 02:45:53 +0200 Subject: [PATCH 191/273] Add String.cut (#856) * Add `String.index_after_n : char -> int -> string -> int` * Add ChangeLog entry for `String.index_after_n` * fix index_after_n doc * Add String.cut * Update documentation for String.{index_after_n,cut} * Remove spurious empty line before BatString.index_after_n * Add Changelog entry for String.cut * Update #856 Changelog with PR number * Clarify documentation of String.{index_after_n,cut} * Rename String.cut to cut_on_char --- ChangeLog | 5 +++++ src/batString.mliv | 41 +++++++++++++++++++++++++++++++++++++ src/batString.mlv | 51 ++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 97 insertions(+) diff --git a/ChangeLog b/ChangeLog index a01372e17..125f624a7 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,11 @@ Changelog ## NEXT_RELEASE +- add `BatString.cut : 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) diff --git a/src/batString.mliv b/src/batString.mliv index c83802163..9e27e0a62 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -256,6 +256,24 @@ val rindex_from_opt: string -> int -> char -> int option @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 Occurences are numbered from 1}: [n] = 1 returns the index of + the character located immediately after the first occurence 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 NEXT_RELEASE +*) + val contains : string -> char -> bool (** [String.contains s c] tests if character [c] appears in the string [s]. *) @@ -755,6 +773,29 @@ val nsplit : string -> by:string -> string 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] occurences of [chr] in str. + @raise Invalid_argument if [n < 0]. + + @since NEXT_RELEASE +*) + val join : string -> string list -> string (** Same as {!concat} *) diff --git a/src/batString.mlv b/src/batString.mlv index 0e3540fe7..8b0d1af71 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -187,6 +187,34 @@ 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 "index out of bounds") + 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 () = @@ -411,6 +439,29 @@ let split_on_char sep str = 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 = + match index_from_opt str i chr with + | None -> length str + | Some valid_index -> valid_index + 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 = From dea2aad5d00dee64d93ed6fadbe01224f03abdce Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Wed, 2 May 2018 09:51:49 +0900 Subject: [PATCH 192/273] better exception string in BatString.index_after_n --- src/batString.mlv | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/batString.mlv b/src/batString.mlv index 8b0d1af71..85da7724a 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -188,16 +188,15 @@ let rfind str sub = rfind_from str (String.length str - 1) sub *) let index_after_n chr n str = - if n < 0 - then raise (Invalid_argument "index out of bounds") + if n < 0 then raise (Invalid_argument "String.index_after_n: n < 0") else let rec loop n i = - if n = 0 - then 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 + in + loop n 0 (*$T index_after_n index_after_n ',' 0 "aa,bb,cc" = 0 @@ -441,8 +440,7 @@ let split_on_char sep str = let cut_on_char chr pos str = let i = index_after_n chr pos str in - let j = - match index_from_opt str i chr with + let j = match index_from_opt str i chr with | None -> length str | Some valid_index -> valid_index in From 54c3796d4048143c6aae9cb681fcef8a45090ab2 Mon Sep 17 00:00:00 2001 From: Francois BERENGER Date: Wed, 2 May 2018 10:03:13 +0900 Subject: [PATCH 193/273] better ocamldoc for BatHashtbl.find_default (#859) * better ocamldoc for BatHashtbl.find_default so much better with an example * better ocamldoc for find_default --- src/batHashtbl.mli | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/batHashtbl.mli b/src/batHashtbl.mli index f3092f9fa..2535fe010 100644 --- a/src/batHashtbl.mli +++ b/src/batHashtbl.mli @@ -146,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 From e7becccfad26626004c39b5158fcf48ec6c26722 Mon Sep 17 00:00:00 2001 From: Thibault Suzanne Date: Fri, 4 May 2018 15:52:59 +0200 Subject: [PATCH 194/273] Rename cut to cut_on_char in Changelog --- ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 125f624a7..b14d94cf0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,7 +3,7 @@ Changelog ## NEXT_RELEASE -- add `BatString.cut : char -> int -> string -> string` +- 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` From 8463bdbb2c054da899464c204cbf7ef0ae1119c7 Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Sat, 5 May 2018 06:10:51 +0500 Subject: [PATCH 195/273] Fix build on OCaml < 4.05 --- src/batString.mlv | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/batString.mlv b/src/batString.mlv index 85da7724a..e63213087 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -440,10 +440,7 @@ let split_on_char sep str = let cut_on_char chr pos str = let i = index_after_n chr pos str in - let j = match index_from_opt str i chr with - | None -> length str - | Some valid_index -> valid_index - in + let j = try index_from str i chr with Not_found -> length str in sub str i (j - i) (*$T cut_on_char From e700ba3ce2429a0fc48e89d2e3aec249e31fe86d Mon Sep 17 00:00:00 2001 From: Max Mouratov Date: Mon, 7 May 2018 19:40:39 +0500 Subject: [PATCH 196/273] Fix a regression in BatInt.Safe_int.mul --- src/batInt.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/batInt.ml b/src/batInt.ml index 9c5bf9c67..6a889c8f3 100644 --- a/src/batInt.ml +++ b/src/batInt.ml @@ -258,7 +258,8 @@ module BaseSafeInt = struct let mul (a: int) (b: int) : int = let open Pervasives in let c = a * b in - if (a lor b) asr mul_shift_bits = 0 || b = 0 || c / b = a then + 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 From 660d93c1e2dc324f5499fc70db6834c1b1ed9511 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Mon, 28 May 2018 07:06:57 +0200 Subject: [PATCH 197/273] Make doc of String.index_from a bit clearer (#864) --- src/batString.mliv | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/batString.mliv b/src/batString.mliv index 9e27e0a62..d883897cd 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -217,7 +217,7 @@ val rindex_opt: string -> char -> int option 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]. From 2996924ea342026b2843f2e526e10d418f4cf2fc Mon Sep 17 00:00:00 2001 From: Ralf Vogler Date: Wed, 30 May 2018 15:44:26 +0200 Subject: [PATCH 198/273] Map.equal used (=) instead of argument --- src/batMap.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/batMap.ml b/src/batMap.ml index f66a87565..909a13e86 100644 --- a/src/batMap.ml +++ b/src/batMap.ml @@ -1118,7 +1118,7 @@ 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 From c98c16cb001d671fd40a92085dfe2b9b780677dd Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 31 May 2018 07:08:26 +0200 Subject: [PATCH 199/273] Changelog entry for #865 --- ChangeLog | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ChangeLog b/ChangeLog index 49e9e1f58..fb09cf15a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -70,6 +70,9 @@ Changelog - 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) ## v2.8.0 (minor release) From 5f9ec0c08549015640ce28d8e79fc11669b33f64 Mon Sep 17 00:00:00 2001 From: Arlen Cox Date: Wed, 20 Jun 2018 20:49:44 -0400 Subject: [PATCH 200/273] Adding ocamlfind plugin support (#867) --- META.in | 4 ++++ 1 file changed, 4 insertions(+) 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" From 9906569cfd503c793350738d148e97055a4fd333 Mon Sep 17 00:00:00 2001 From: UnixJunkie Date: Thu, 21 Jun 2018 09:51:31 +0900 Subject: [PATCH 201/273] changelog update for PR 867 --- ChangeLog | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index fb09cf15a..12896b04d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,7 +2,9 @@ Changelog --------- ## NEXT_RELEASE - +- ocamlfind plugin support in META file + (Arlen Cox) + #867 - add `BatString.cut_on_char : char -> int -> string -> string` (Kahina Fekir, Thibault Suzanne, request by François Bérenger) #807, #856 From 7183691ec927324991bcc8d4772f02b7612a4658 Mon Sep 17 00:00:00 2001 From: yaseersheriff Date: Fri, 31 Aug 2018 20:58:37 +0100 Subject: [PATCH 202/273] Update batVect.mli Typo in description of sub. Ordering r m n required to be consistent with function definition --- src/batVect.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/batVect.mli b/src/batVect.mli index 29efb4ba1..6168f3acc 100644 --- a/src/batVect.mli +++ b/src/batVect.mli @@ -516,7 +516,7 @@ val destructive_set : 'a t -> int -> 'a -> unit 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. *) From 801acb49f3d13d3a00480075f16c84542e35177d Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 8 Sep 2018 18:24:05 +0200 Subject: [PATCH 203/273] batInnerWeaktbl: separate interface from Hashtbl for compatibility --- src/batInnerWeaktbl.ml | 34 +++++++++++++++++++++++++++++++++- src/batInnerWeaktbl.mli | 37 +++++++++++++++++++++++++++++++++++-- 2 files changed, 68 insertions(+), 3 deletions(-) diff --git a/src/batInnerWeaktbl.ml b/src/batInnerWeaktbl.ml index 67f133500..d9ea316ec 100644 --- a/src/batInnerWeaktbl.ml +++ b/src/batInnerWeaktbl.ml @@ -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 + 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 diff --git a/src/batInnerWeaktbl.mli b/src/batInnerWeaktbl.mli index 7239f0e1e..107a30a5d 100644 --- a/src/batInnerWeaktbl.mli +++ b/src/batInnerWeaktbl.mli @@ -101,8 +101,41 @@ 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 + 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 From cc98a78c5f734e2616e8d3daec53192c1998c9ac Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 8 Sep 2018 18:24:17 +0200 Subject: [PATCH 204/273] 4.07 compatibility fixes --- src/batMarshal.mliv | 6 ++++-- src/batUnix.mliv | 12 ++++++++---- 2 files changed, 12 insertions(+), 6 deletions(-) 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/batUnix.mliv b/src/batUnix.mliv index 92fa517fc..4e50efa91 100644 --- a/src/batUnix.mliv +++ b/src/batUnix.mliv @@ -523,10 +523,14 @@ end ##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) 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], From 4fc4f7f13e828c84d9c26e12fa666be4ed1e2dfe Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 8 Sep 2018 18:29:49 +0200 Subject: [PATCH 205/273] testsuite: remove test_interface.ml, subsumed by 'make test-compat' --- testsuite/main.ml | 2 -- testsuite/test_interface.ml | 50 ------------------------------------- 2 files changed, 52 deletions(-) delete mode 100644 testsuite/test_interface.ml 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_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? *) - *) From aab5c43dc0059c524d823044893ea32faf0599ec Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 8 Sep 2018 18:39:24 +0200 Subject: [PATCH 206/273] beef up Travis checking --- .travis.sh | 30 +++++++++++++----------------- .travis.yml | 15 +++++++++------ 2 files changed, 22 insertions(+), 23 deletions(-) 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..777eb4f7f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,12 +1,15 @@ 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 # notifications: # email: From b00fd24bd589541acad8a6e41c9e09bf319ebfd0 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 8 Sep 2018 18:52:39 +0200 Subject: [PATCH 207/273] prepare release 2.9.0 --- howto/release.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/howto/release.md b/howto/release.md index 3e7e0e231..73a45b07c 100644 --- a/howto/release.md +++ b/howto/release.md @@ -5,6 +5,8 @@ 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) From 5dd231c0521d1db3879b53256247ffc6ef7e1d79 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 8 Sep 2018 19:17:39 +0200 Subject: [PATCH 208/273] Update setup.ml based on _oasis --- setup.ml | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/setup.ml b/setup.ml index 25612a1de..8ffaa9b24 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: 36bed8df785978c282829ca538024e8c) *) +(* DO NOT EDIT (digest: 4b6f60c10acd68f71ea157585764174c) *) (* - Regenerated by OASIS v0.4.10 + Regenerated by OASIS v0.4.11 Visit http://oasis.forge.ocamlcore.org for more information and documentation about functions used in this file. *) @@ -6742,7 +6742,7 @@ let setup_t = { oasis_version = "0.4"; ocaml_version = Some (OASISVersion.VGreaterEqual "3.12.1"); - version = "2.8.0"; + version = "NEXT_RELEASE"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -7018,9 +7018,8 @@ let setup_t = plugin_data = [] }; oasis_fn = Some "_oasis"; - oasis_version = "0.4.10"; - oasis_digest = - Some "\154\242\029\231r\200\220\152K\201\139\180T2\232\189"; + oasis_version = "0.4.11"; + oasis_digest = Some "\213\224`\200&\030.\216\132\181`\225mU\251\189"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -7028,7 +7027,7 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 7032 "setup.ml" +# 7031 "setup.ml" let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t open BaseCompat.Compat_0_4 (* OASIS_STOP *) From f05949385e0baa3c03cde8c02c5b5d70e0a02686 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 8 Sep 2018 19:21:12 +0200 Subject: [PATCH 209/273] prepare the 2.9.0 release --- ChangeLog | 35 +++++++++++++++++++++++++++++++---- Makefile | 2 +- _oasis | 2 +- scripts/replace_since.sh | 4 ++-- src/batString.mliv | 6 +++--- 5 files changed, 38 insertions(+), 11 deletions(-) diff --git a/ChangeLog b/ChangeLog index 12896b04d..218e15024 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,81 +1,108 @@ Changelog --------- -## NEXT_RELEASE -- ocamlfind plugin support in META file - (Arlen Cox) - #867 +## 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. + - 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 diff --git a/Makefile b/Makefile index 2285f27c0..ddd86a52e 100644 --- a/Makefile +++ b/Makefile @@ -277,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 diff --git a/_oasis b/_oasis index 70aa351b0..e221733a2 100644 --- a/_oasis +++ b/_oasis @@ -1,7 +1,7 @@ OASISFormat: 0.4 OCamlVersion: >= 3.12.1 Name: batteries -Version: NEXT_RELEASE +Version: 2.9.0 Authors: Batteries Included Team License: LGPL-2.1 with OCaml linking exception LicenseFile: LICENSE diff --git a/scripts/replace_since.sh b/scripts/replace_since.sh index 0b6418758..bcba99909 100755 --- a/scripts/replace_since.sh +++ b/scripts/replace_since.sh @@ -13,5 +13,5 @@ if [ -z "$VERSION" ] ; then exit 1 fi -find src/ -name '*.ml*' -exec sed -i'' "s/NEXT_RELEASE/$VERSION/g" {} \; -sed _oasis -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/src/batString.mliv b/src/batString.mliv index d883897cd..d0a680ccc 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -271,7 +271,7 @@ val index_after_n : char -> int -> string -> int @raise Not_found if there are strictly less than [n] occurrences of [chr] in [str]. - @since NEXT_RELEASE + @since 2.9.0 *) val contains : string -> char -> bool @@ -560,7 +560,7 @@ val find_all : string -> string -> int BatEnum.t val count_string : string -> string -> int (** [count_string s x] count how many times [x] is found in [s]. - @since NEXT_RELEASE *) + @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. @@ -793,7 +793,7 @@ val cut_on_char : char -> int -> string -> string @raise Not_found if there are strictly less than [n] occurences of [chr] in str. @raise Invalid_argument if [n < 0]. - @since NEXT_RELEASE + @since 2.9.0 *) val join : string -> string list -> string From ab70758368a6d640ec0c75ec4c4541c4bfe4dd30 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 8 Sep 2018 19:21:25 +0200 Subject: [PATCH 210/273] Update setup.ml based on _oasis --- setup.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/setup.ml b/setup.ml index 8ffaa9b24..2bece1991 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.2.0 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 4b6f60c10acd68f71ea157585764174c) *) +(* DO NOT EDIT (digest: 7d84cba1f5cf0ad1c123fc524bb4361c) *) (* Regenerated by OASIS v0.4.11 Visit http://oasis.forge.ocamlcore.org for more information and @@ -6742,7 +6742,7 @@ let setup_t = { oasis_version = "0.4"; ocaml_version = Some (OASISVersion.VGreaterEqual "3.12.1"); - version = "NEXT_RELEASE"; + version = "2.9.0"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -7019,7 +7019,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.11"; - oasis_digest = Some "\213\224`\200&\030.\216\132\181`\225mU\251\189"; + oasis_digest = Some ")\254R1\139\147\b\202/\219\210\239\179N`\156"; oasis_exec = None; oasis_setup_args = []; setup_update = false From 45b48f74c3342a160094de227ee4c786463f6fb6 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 8 Sep 2018 19:24:04 +0200 Subject: [PATCH 211/273] first commit after 2.9.0 --- ChangeLog | 4 ++++ _oasis | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 218e15024..922abf6c1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,10 @@ Changelog --------- +## NEXT_RELEASE + + + ## v2.9.0 (minor release) This minor release adds support for OCaml 4.07.0, as well as a certain diff --git a/_oasis b/_oasis index e221733a2..70aa351b0 100644 --- a/_oasis +++ b/_oasis @@ -1,7 +1,7 @@ OASISFormat: 0.4 OCamlVersion: >= 3.12.1 Name: batteries -Version: 2.9.0 +Version: NEXT_RELEASE Authors: Batteries Included Team License: LGPL-2.1 with OCaml linking exception LicenseFile: LICENSE From c9560c93233032506ff44ce0812b9d561b31e3e2 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 12 Sep 2018 02:56:17 +0200 Subject: [PATCH 212/273] extend the Changelog (#877) --- ChangeLog | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/ChangeLog b/ChangeLog index 922abf6c1..7dba1701b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -12,6 +12,20 @@ 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 From 6ec08dfd444a00b47865b295e38ad1ca000f2b69 Mon Sep 17 00:00:00 2001 From: Virgile Robles Date: Sun, 9 Dec 2018 16:50:20 +0100 Subject: [PATCH 213/273] Fix Dllist.skip skip had the same behavior no matter the sign of the parameter --- src/batDllist.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/batDllist.ml b/src/batDllist.ml index d29f35f73..75347fe7a 100644 --- a/src/batDllist.ml +++ b/src/batDllist.ml @@ -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 = From 116f73f859da2d1afdfb9741155923f4f72a48fa Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 12 Feb 2019 15:06:52 +0100 Subject: [PATCH 214/273] batNum: fix the testsuite --- src/batNum.ml | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/batNum.ml b/src/batNum.ml index 721269579..ba529fccc 100644 --- a/src/batNum.ml +++ b/src/batNum.ml @@ -108,10 +108,10 @@ let of_float_string a = else add ipart fpart with Not_found -> of_string a - (**T - of_float_string "2.5" = of_string "5/2" - of_float_string "-2.5" = of_string "-5/2" - of_float_string "-2.1" = of_string "-21/10" - 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") +*) From 57077fe60839dcba8491086f085da3e96dbbfb9e Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 12 Feb 2019 15:11:28 +0100 Subject: [PATCH 215/273] fix a batNum.of_float_sting bug on inputs in ]-1; 0[. (fixes #886) --- ChangeLog | 5 ++++- src/batNum.ml | 18 +++++++----------- 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7dba1701b..777b8c678 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,7 +3,10 @@ Changelog ## NEXT_RELEASE - +- fix `BatNum.of_float_string` on inputs between -1 and 0: + "-0.5" or "-.5" would be interpreted as "0.5" or ".5". + (Gabriel Scherer, report by Marcel Hark) + #886, #887 ## v2.9.0 (minor release) diff --git a/src/batNum.ml b/src/batNum.ml index ba529fccc..ee2dfebd2 100644 --- a/src/batNum.ml +++ b/src/batNum.ml @@ -95,17 +95,11 @@ 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 - if lt_num ipart zero then sub ipart fpart - else 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 @@ -114,4 +108,6 @@ let of_float_string a = 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") *) From 162208b9ccf564c344b89353973fbb2a4512ab0d Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Thu, 4 Apr 2019 12:28:53 +0900 Subject: [PATCH 216/273] added BatList.fold_while (#889) * added BatList.fold_while --- ChangeLog | 5 +++++ src/batList.mliv | 8 ++++++++ src/batList.mlv | 17 +++++++++++++++++ 3 files changed, 30 insertions(+) diff --git a/ChangeLog b/ChangeLog index 777b8c678..5cd19c9f1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,11 @@ Changelog ## NEXT_RELEASE +- 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". (Gabriel Scherer, report by Marcel Hark) diff --git a/src/batList.mliv b/src/batList.mliv index a4029501d..f8da8587a 100644 --- a/src/batList.mliv +++ b/src/batList.mliv @@ -702,6 +702,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 NEXT_RELEASE +*) val nsplit : ('a -> bool) -> 'a list -> 'a list list (** [nsplit], applied to a predicate [p] and a list [xs], returns a diff --git a/src/batList.mlv b/src/batList.mlv index a5f202880..b0e3990fd 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -348,6 +348,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 From acc7d2ed79f1b720e5e67e7cab456268cda21485 Mon Sep 17 00:00:00 2001 From: Fourchaux Date: Wed, 10 Apr 2019 12:04:43 +0200 Subject: [PATCH 217/273] Fixing basic typos (#890) --- .travis.yml | 2 +- ChangeLog | 2 +- battop.ml | 2 +- benchsuite/bench_nreplace.ml | 2 +- build/odoc_batteries_factored.ml | 2 +- build/odoc_generator_batlib.ml | 2 +- build/optcomp/pa_optcomp.ml | 8 ++++---- build/optcomp/sample.ml | 4 ++-- examples/euler/euler012.ml | 2 +- examples/pleac/strings.ml | 4 ++-- howto/release.md | 2 +- setup.ml | 2 +- src/batArray.mliv | 2 +- src/batConcreteQueue_403.ml | 2 +- src/batEnum.mli | 4 ++-- src/batFingerTree.ml | 4 ++-- src/batFingerTree.mli | 6 +++--- src/batFloat.mli | 4 ++-- src/batGc.mliv | 2 +- src/batHashtbl.mli | 2 +- src/batIO.mli | 18 +++++++++--------- src/batInnerIO.mli | 2 +- src/batInnerWeaktbl.ml | 2 +- src/batInt.mli | 16 ++++++++-------- src/batList.mliv | 4 ++-- src/batMap.ml | 4 ++-- src/batOptParse.mli | 2 +- src/batOrd.mli | 2 +- src/batParserCo.mli | 4 ++-- src/batPathGen.ml | 4 ++-- src/batPathGen.mli | 2 +- src/batResult.mli | 4 ++-- src/batScanf.mli | 8 ++++---- src/batSet.ml | 2 +- src/batStream.mli | 2 +- src/batString.mliv | 10 +++++----- src/batText.mli | 2 +- src/batUChar.mli | 2 +- src/batVect.mli | 4 ++-- testsuite/test_print.ml | 2 +- testsuite/test_uref.ml | 2 +- 41 files changed, 79 insertions(+), 79 deletions(-) diff --git a/.travis.yml b/.travis.yml index 777eb4f7f..4af867e36 100644 --- a/.travis.yml +++ b/.travis.yml @@ -14,4 +14,4 @@ env: # 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 5cd19c9f1..ffd23a213 100644 --- a/ChangeLog +++ b/ChangeLog @@ -448,7 +448,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/battop.ml b/battop.ml index c81db4637..2900ccc1f 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 diff --git a/benchsuite/bench_nreplace.ml b/benchsuite/bench_nreplace.ml index cf05258ef..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 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/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/release.md b/howto/release.md index 73a45b07c..0368e0dd6 100644 --- a/howto/release.md +++ b/howto/release.md @@ -74,7 +74,7 @@ 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 commited. +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 diff --git a/setup.ml b/setup.ml index 2bece1991..2efa5da86 100644 --- a/setup.ml +++ b/setup.ml @@ -2653,7 +2653,7 @@ module OASISFindlib = struct (fun lib_name status mp -> match status with | `Solved _ -> - (* Solved initialy, no need to go further *) + (* Solved initially, no need to go further *) mp | `Unsolved _ -> let _, mp = solve SetString.empty mp lib_name "" in diff --git a/src/batArray.mliv b/src/batArray.mliv index 02cea860c..111509594 100644 --- a/src/batArray.mliv +++ b/src/batArray.mliv @@ -525,7 +525,7 @@ val insert : 'a array -> 'a -> int -> 'a array 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. 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/batEnum.mli b/src/batEnum.mli index cb8dd5e81..aaa03d7b0 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 @@ -792,7 +792,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/batFingerTree.ml b/src/batFingerTree.ml index 29e54b7f5..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). *) @@ -735,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. diff --git a/src/batFingerTree.mli b/src/batFingerTree.mli index c66f22ee0..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 @@ -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.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/batGc.mliv b/src/batGc.mliv index 04220f735..cfdb7c005 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. diff --git a/src/batHashtbl.mli b/src/batHashtbl.mli index 2535fe010..92c0e301d 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}*) diff --git a/src/batIO.mli b/src/batIO.mli index 7bad328f4..dc546d98f 100644 --- a/src/batIO.mli +++ b/src/batIO.mli @@ -364,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. *) @@ -381,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 @@ -389,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 @@ -771,7 +771,7 @@ val to_input_channel : input -> in_channel (** {6 Generic BatIO Object Wrappers} These OO Wrappers have been written to provide easy support of - BatIO by external librairies. If you want your library to support + BatIO by external libraries. If you want your library to support BatIO without actually requiring Batteries to compile, you can implement the classes [in_channel], [out_channel], [poly_in_channel] and/or [poly_out_channel] which are the common @@ -880,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. *) @@ -892,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. *) @@ -952,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 @@ -973,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 @@ -993,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/batInnerIO.mli b/src/batInnerIO.mli index 52d08558e..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 diff --git a/src/batInnerWeaktbl.ml b/src/batInnerWeaktbl.ml index d9ea316ec..99ead148f 100644 --- a/src/batInnerWeaktbl.ml +++ b/src/batInnerWeaktbl.ml @@ -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; 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/batList.mliv b/src/batList.mliv index f8da8587a..c8d351033 100644 --- a/src/batList.mliv +++ b/src/batList.mliv @@ -375,7 +375,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 *) @@ -828,7 +828,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). diff --git a/src/batMap.ml b/src/batMap.ml index 909a13e86..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. @@ -408,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 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/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 f1d1bc58b..647989b6d 100644 --- a/src/batPathGen.ml +++ b/src/batPathGen.ml @@ -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 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/batResult.mli b/src/batResult.mli index fbb1ffbba..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 diff --git a/src/batScanf.mli b/src/batScanf.mli index 84f00a27d..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 @@ -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/batSet.ml b/src/batSet.ml index d93a458b9..01a58bf2a 100644 --- a/src/batSet.ml +++ b/src/batSet.ml @@ -648,7 +648,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) 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 d0a680ccc..9e8dc67ff 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -260,8 +260,8 @@ 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 Occurences are numbered from 1}: [n] = 1 returns the index of - the character located immediately after the first occurence of + - {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 @@ -691,7 +691,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")] *) @@ -790,7 +790,7 @@ val cut_on_char : char -> int -> string -> string {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] occurences of [chr] in str. + @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 @@ -1001,7 +1001,7 @@ end (* String.Exceptionless *) Read-only strings may then be safely shared and distributed. @since 2.8.0 the interface and implementation of the Cap - module changed to accomodate the -safe-string transition. OCaml + 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 diff --git a/src/batText.mli b/src/batText.mli index 4306c8cb9..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 } *) 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/batVect.mli b/src/batVect.mli index 6168f3acc..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 @@ -475,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 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); From fb252bc55951eeb0caccb4680dd917a6f8504ea8 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 11 Jul 2019 14:51:09 +0200 Subject: [PATCH 218/273] Gc: add new 4.08 fields --- src/batGc.mliv | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/src/batGc.mliv b/src/batGc.mliv index cfdb7c005..b5b3a9ae6 100644 --- a/src/batGc.mliv +++ b/src/batGc.mliv @@ -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 NEXT_RELEASE 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 NEXT_RELEASE 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 NEXT_RELEASE 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 From 6227355cba2b31527c83831da87a29b8c45d26da Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 11 Jul 2019 14:51:27 +0200 Subject: [PATCH 219/273] Array: reorder type and include to avoid error --- src/batArray.mlv | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/batArray.mlv b/src/batArray.mlv index 1037a0cc1..64efbcb55 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 From 7b935051d1ac1e8ff3b5735522a613e89f99a3be Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 11 Jul 2019 14:59:30 +0200 Subject: [PATCH 220/273] re-export Bigarray.*.map_file functions removed in 4.08 --- src/batBigarray.mlv | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/batBigarray.mlv b/src/batBigarray.mlv index e498164d3..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 = @@ -314,6 +316,10 @@ let array1_of_genarray = Bigarray.array1_of_genarray 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 = @@ -371,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 = @@ -425,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 = From 65cf7cad0393f1dd5ed97e5727f6e83f9209b5c5 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 11 Jul 2019 15:03:35 +0200 Subject: [PATCH 221/273] Int32: incorrect primitive names --- src/batInt32.mliv | 4 ++-- src/batInt32.mlv | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/batInt32.mliv b/src/batInt32.mliv index 80c50af7f..a00dbf4bd 100644 --- a/src/batInt32.mliv +++ b/src/batInt32.mliv @@ -175,12 +175,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. *) diff --git a/src/batInt32.mlv b/src/batInt32.mlv index 5b150f01c..836e0a2e2 100644 --- a/src/batInt32.mlv +++ b/src/batInt32.mlv @@ -159,8 +159,8 @@ external of_string : string -> int32 = "caml_int32_of_string" ##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] From f52962636a0069ccbdd3e60d0bec9519e9f13909 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 11 Jul 2019 15:07:40 +0200 Subject: [PATCH 222/273] Lexing: no support for disabling position-tracking --- src/batLexing.ml | 4 ++++ src/batLexing.mli | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/src/batLexing.ml b/src/batLexing.ml index 499e99923..0ac3185ba 100644 --- a/src/batLexing.ml +++ b/src/batLexing.ml @@ -22,6 +22,10 @@ open BatIO include Lexing + +let from_string s : lexbuf = Lexing.from_string s +let from_function f : lexbuf = Lexing.from_function f + let from_input inp = from_function (fun s n -> try input inp s 0 n with No_more_input -> 0) diff --git a/src/batLexing.mli b/src/batLexing.mli index b052d3aff..8b93bfbd0 100644 --- a/src/batLexing.mli +++ b/src/batLexing.mli @@ -85,6 +85,10 @@ 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]). + + 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. *) val from_input : BatIO.input -> lexbuf From e6cbf3dbc65fe74e0578a5bb2649d1bb9a8a1ae0 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 11 Jul 2019 15:10:50 +0200 Subject: [PATCH 223/273] Unix: we don't support the new (link ?follow) parameter on older OCamls --- src/batUnix.mliv | 22 +++++++++++++++++++--- src/batUnix.mlv | 3 +++ 2 files changed, 22 insertions(+), 3 deletions(-) diff --git a/src/batUnix.mliv b/src/batUnix.mliv index 4e50efa91..029dd9501 100644 --- a/src/batUnix.mliv +++ b/src/batUnix.mliv @@ -587,9 +587,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 NEXT_RELEASE 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} *) diff --git a/src/batUnix.mlv b/src/batUnix.mlv index a628c2eea..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 From 3bd87d7c2db073987eabc1e6bcf30f48980bc1ad Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Thu, 11 Jul 2019 15:19:22 +0200 Subject: [PATCH 224/273] add CI testing for 4.08 --- .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index 4af867e36..4b1c8cb77 100644 --- a/.travis.yml +++ b/.travis.yml @@ -10,6 +10,7 @@ env: - OCAML_VERSION=4.05.0 - OCAML_VERSION=4.06.0 - OCAML_VERSION=4.07.0 + - OCAML_VERSION=4.08.0 # notifications: # email: From 24563683896383eff139fde7a36682f250805e74 Mon Sep 17 00:00:00 2001 From: Zachary Palmer Date: Tue, 16 Jul 2019 13:20:36 -0400 Subject: [PATCH 225/273] Corrected BatDeque.is_empty documentation. --- src/batDeque.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/batDeque.mli b/src/batDeque.mli index e70804441..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 From 283ac271ece08fab1a4b7c2853f18a5517c4d82c Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Mon, 29 Jul 2019 10:59:08 +0200 Subject: [PATCH 226/273] Hashtbl merge (#892) * Addition of Hashtbl.merge and merge_all Closes #891 --- ChangeLog | 4 + src/batHashtbl.mli | 44 ++++++++++ src/batHashtbl.mlv | 198 +++++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 239 insertions(+), 7 deletions(-) diff --git a/ChangeLog b/ChangeLog index ffd23a213..66d6d6913 100644 --- a/ChangeLog +++ b/ChangeLog @@ -13,6 +13,10 @@ Changelog (Gabriel Scherer, report by Marcel Hark) #886, #887 +- 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 diff --git a/src/batHashtbl.mli b/src/batHashtbl.mli index 92c0e301d..eaf789107 100644 --- a/src/batHashtbl.mli +++ b/src/batHashtbl.mli @@ -241,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 NEXT_RELEASE +*) + +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 NEXT_RELEASE +*) + (** {6 The polymorphic hash primitive}*) val hash : 'a -> int @@ -336,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} *) @@ -392,6 +419,10 @@ 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 @@ -464,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 @@ -554,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}*) @@ -597,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 603a4b263..90c2fcd18 100644 --- a/src/batHashtbl.mlv +++ b/src/batHashtbl.mlv @@ -174,10 +174,15 @@ 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 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 = @@ -320,10 +325,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] *) @@ -334,7 +339,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] *) @@ -357,10 +362,135 @@ 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 -> + match find h1 k with + | exception Not_found -> + may_add_res k None (Some v2) + | _ -> () (* done above *) + ) 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) (f k v1 v2 |> List.rev) 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) *) @@ -394,6 +524,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 @@ -429,6 +561,10 @@ 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 @@ -489,6 +625,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 @@ -712,6 +852,44 @@ 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 -> + match find b k with + | exception Not_found -> + may_add_res k (Some v1) None + | v2 -> + may_add_res k (Some v1) (Some v2) + ) a ; + iter (fun k v2 -> + match find a k with + | exception Not_found -> + may_add_res k None (Some v2) + | _ -> () (* done above *) + ) 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) (f k v1 v2 |> List.rev) 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 @@ -730,6 +908,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 = @@ -791,6 +971,8 @@ struct 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 @@ -809,6 +991,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 = From f320d279e9dadabf0418feb882be3d4004435f3b Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Mon, 29 Jul 2019 18:56:32 +0900 Subject: [PATCH 227/273] BatString.count_char uses a while loop instead of fold --- src/batString.mlv | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/batString.mlv b/src/batString.mlv index 1a860b36c..5b4db27aa 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -612,12 +612,13 @@ let fold_left f init str = *) let count_char str char = - fold_left (fun acc c -> - if c = char then - acc + 1 - else - acc - ) 0 str + 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 From 3180492544b35536ddd0cb0958c2fcf4ae7d4a1c Mon Sep 17 00:00:00 2001 From: Catalin Hritcu Date: Wed, 31 Jul 2019 02:59:11 +0200 Subject: [PATCH 228/273] Current module name seems Extlib, not Extlibcompat (#873) https://github.com/ocaml-batteries-team/batteries-included/blob/master/src/extlib.ml --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index cdd4fdf51..f01cd556d 100644 --- a/README.md +++ b/README.md @@ -81,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. From 60a0bcf10247f168cdc1588915a0ca619e2699e2 Mon Sep 17 00:00:00 2001 From: Marshall Abrams Date: Tue, 30 Jul 2019 20:27:37 -0500 Subject: [PATCH 229/273] Add lazylist equal predicate (#811) added LazyList.equal --- src/batLazyList.ml | 15 +++++++++++++++ src/batLazyList.mli | 22 ++++++++++++++++++++++ 2 files changed, 37 insertions(+) diff --git a/src/batLazyList.ml b/src/batLazyList.ml index 714b184f6..6c4fe715e 100644 --- a/src/batLazyList.ml +++ b/src/batLazyList.ml @@ -617,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 bbe204aad..324f038b1 100644 --- a/src/batLazyList.mli +++ b/src/batLazyList.mli @@ -582,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 From a1ebfdeff7a49a376e09848d9e21fd082b6e1f7c Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 10:30:11 +0900 Subject: [PATCH 230/273] updated ChangeLog --- ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ChangeLog b/ChangeLog index 66d6d6913..b0fa0e5a0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,10 @@ Changelog ## NEXT_RELEASE +- 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 From f2849af39bb7583f973342d082ed516c75bac38e Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 12:19:10 +0900 Subject: [PATCH 231/273] get rid of >=4.02 syntax in BatHashtbl.merge --- src/batHashtbl.mlv | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) diff --git a/src/batHashtbl.mlv b/src/batHashtbl.mlv index 90c2fcd18..2833c3c2c 100644 --- a/src/batHashtbl.mlv +++ b/src/batHashtbl.mlv @@ -377,10 +377,8 @@ let merge f h1 h2 = may_add_res k (Some v1) (find_option h2 k) ) h1 ; iter (fun k v2 -> - match find h1 k with - | exception Not_found -> + if not (mem h1 k) then may_add_res k None (Some v2) - | _ -> () (* done above *) ) h2 ; res @@ -857,17 +855,11 @@ struct let may_add_res k v1 v2 = BatOption.may (add res k) (f k v1 v2) in iter (fun k v1 -> - match find b k with - | exception Not_found -> - may_add_res k (Some v1) None - | v2 -> - may_add_res k (Some v1) (Some v2) - ) a ; + may_add_res k (Some v1) (find_option b k) + ) a ; iter (fun k v2 -> - match find a k with - | exception Not_found -> + if not (mem a k) then may_add_res k None (Some v2) - | _ -> () (* done above *) ) b ; res From eabac787adf948e395034ee0cfcba0e0b84b59fe Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 12:26:13 +0900 Subject: [PATCH 232/273] BatHashtbl: avoid |> when possible --- src/batHashtbl.mlv | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/batHashtbl.mlv b/src/batHashtbl.mlv index 2833c3c2c..858b8c9ed 100644 --- a/src/batHashtbl.mlv +++ b/src/batHashtbl.mlv @@ -176,6 +176,7 @@ let map_inplace f h = (* 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 *) @@ -444,7 +445,7 @@ let merge f h1 h2 = 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) (f k v1 v2 |> List.rev) in + 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 @@ -866,7 +867,7 @@ struct 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) (f k v1 v2 |> List.rev) in + 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 From 6d8e30d2e72d0cd7523a2491a9d947fb0feac77b Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 12:34:47 +0900 Subject: [PATCH 233/273] some more files need preprocessing Hashtbl.statistics is from 4.00.0 and was used in batInnerWeaktbl.ml{i} --- src/{batInnerWeaktbl.mli => batInnerWeaktbl.mliv} | 3 ++- src/{batInnerWeaktbl.ml => batInnerWeaktbl.mlv} | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) rename src/{batInnerWeaktbl.mli => batInnerWeaktbl.mliv} (99%) rename src/{batInnerWeaktbl.ml => batInnerWeaktbl.mlv} (99%) diff --git a/src/batInnerWeaktbl.mli b/src/batInnerWeaktbl.mliv similarity index 99% rename from src/batInnerWeaktbl.mli rename to src/batInnerWeaktbl.mliv index 107a30a5d..69ed66298 100644 --- a/src/batInnerWeaktbl.mli +++ b/src/batInnerWeaktbl.mliv @@ -130,8 +130,9 @@ module type S = sig val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val length : 'a t -> int - val stats: 'a t -> Hashtbl.statistics +##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. *) diff --git a/src/batInnerWeaktbl.ml b/src/batInnerWeaktbl.mlv similarity index 99% rename from src/batInnerWeaktbl.ml rename to src/batInnerWeaktbl.mlv index 99ead148f..fff1a6d71 100644 --- a/src/batInnerWeaktbl.ml +++ b/src/batInnerWeaktbl.mlv @@ -91,7 +91,7 @@ module type S = sig val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val length : 'a t -> int - val stats: 'a t -> Hashtbl.statistics +##V>=4## val stats: 'a t -> Hashtbl.statistics end open Obj (* Recover polymorphism from standard monomorphic (Weak)Hashtbl *) From 96bd3d6857efeee9d9ce20c0aac5c8cf6c4df09f Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 15:29:48 +0900 Subject: [PATCH 234/273] BatArray: 4.07 compat --- src/batArray.mliv | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/batArray.mliv b/src/batArray.mliv index 111509594..cef396232 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}. *) From 9dfe850beced10b9995d8ca72f0ca09e339681b1 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 15:30:45 +0900 Subject: [PATCH 235/273] BatBuffer: 4.07 and 4.08 compat --- src/batBuffer.mliv | 124 +++++++++++++++++++++++++++++++++++++++++++++ src/batBuffer.mlv | 20 ++++++++ 2 files changed, 144 insertions(+) diff --git a/src/batBuffer.mliv b/src/batBuffer.mliv index 8beb62a02..00da02bad 100644 --- a/src/batBuffer.mliv +++ b/src/batBuffer.mliv @@ -190,3 +190,127 @@ 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 4.07 *) +##V>=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 4.07 *) +##V>=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 4.07 *) +##V>=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 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## +##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 4.08 +##V>=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 4.08 +##V>=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 4.08 +##V>=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 4.08 +##V>=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 4.08 +##V>=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 4.08 +##V>=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 4.08 +##V>=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 4.08 +##V>=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 4.08 +##V>=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 4.08 +##V>=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 4.08 +##V>=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 4.08 +##V>=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 4.08 +##V>=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 4.08 +##V>=4.08##*) diff --git a/src/batBuffer.mlv b/src/batBuffer.mlv index 033b5af95..635095b1a 100644 --- a/src/batBuffer.mlv +++ b/src/batBuffer.mlv @@ -88,3 +88,23 @@ let output_buffer buf = (*$Q output_buffer (Q.string) (fun s -> let b = create 10 in let oc = output_buffer b in IO.nwrite oc s; IO.close_out oc = s) *) + +##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 From 37d8ec5cca59bd436964f0a968d499ce38bd9a41 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 15:31:23 +0900 Subject: [PATCH 236/273] BatBytes: 4.07 and 4.08 compat --- src/batBytes.mliv | 210 ++++++++++++++++++++++++++++++++++++++++++++++ src/batBytes.mlv | 33 ++++++++ 2 files changed, 243 insertions(+) diff --git a/src/batBytes.mliv b/src/batBytes.mliv index 5ab71f332..4546709c5 100644 --- a/src/batBytes.mliv +++ b/src/batBytes.mliv @@ -441,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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 6a00de363..901a79111 100644 --- a/src/batBytes.mlv +++ b/src/batBytes.mlv @@ -80,3 +80,36 @@ include Bytes ##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 From 02bf956b81a86635d01db551af3e1adee1db8ef9 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 15:32:04 +0900 Subject: [PATCH 237/273] BatInt32: 4.08 compat --- src/batInt32.mliv | 24 ++++++++++++++++++++++++ src/batInt32.mlv | 6 ++++-- 2 files changed, 28 insertions(+), 2 deletions(-) diff --git a/src/batInt32.mliv b/src/batInt32.mliv index a00dbf4bd..e258a9505 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 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 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 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, @@ -239,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 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 836e0a2e2..a0240b8de 100644 --- a/src/batInt32.mlv +++ b/src/batInt32.mlv @@ -168,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 From 6e7ee352344647b8e7210b41ba9286ce1453064d Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 15:32:57 +0900 Subject: [PATCH 238/273] BatInt64: 4.08 compat --- src/batInt64.mliv | 25 +++++++++++++++++++++++++ src/batInt64.mlv | 4 ++++ 2 files changed, 29 insertions(+) diff --git a/src/batInt64.mliv b/src/batInt64.mliv index 01e72ffc5..748803948 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 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 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 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, @@ -220,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 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 c650d686e..b6d8c5575 100644 --- a/src/batInt64.mlv +++ b/src/batInt64.mlv @@ -64,6 +64,10 @@ 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 From 1878c50b4c9b1a8f4c6dfb12dcf20c06d3e20311 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 15:33:59 +0900 Subject: [PATCH 239/273] BatLexing: 4.08 compat --- src/{batLexing.mli => batLexing.mliv} | 67 +++++++++++++++++++-------- src/{batLexing.ml => batLexing.mlv} | 4 +- 2 files changed, 50 insertions(+), 21 deletions(-) rename src/{batLexing.mli => batLexing.mliv} (69%) rename src/{batLexing.ml => batLexing.mlv} (91%) diff --git a/src/batLexing.mli b/src/batLexing.mliv similarity index 69% rename from src/batLexing.mli rename to src/batLexing.mliv index 8b93bfbd0..a0c28d29e 100644 --- a/src/batLexing.mli +++ b/src/batLexing.mliv @@ -91,25 +91,54 @@ type lexbuf = Lexing.lexbuf = need this, please get in touch with the Batteries maintainers. *) -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 : (Bytes.t -> 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 byte sequence [s] and a byte - count [n]. The function should put [n] bytes or less in [s], - starting at byte number 0, and return the number of byte - provided. A return value of 0 means end of input. *) - +##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 91% rename from src/batLexing.ml rename to src/batLexing.mlv index 0ac3185ba..1426064fd 100644 --- a/src/batLexing.ml +++ b/src/batLexing.mlv @@ -23,8 +23,8 @@ open BatIO include Lexing -let from_string s : lexbuf = Lexing.from_string s -let from_function f : lexbuf = Lexing.from_function f +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) From 2273fa89806acd415c6380a545cd4d2d390797d9 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 15:34:55 +0900 Subject: [PATCH 240/273] BatList: 4.08 compat --- src/batList.mliv | 15 ++++++++++++--- src/batList.mlv | 5 ++++- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/src/batList.mliv b/src/batList.mliv index c8d351033..5514a3634 100644 --- a/src/batList.mliv +++ 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 @@ -324,7 +326,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 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 4.07 *) (** {6 Iterators on two lists} *) @@ -1065,6 +1075,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 b0e3990fd..b60454c0b 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -53,6 +53,8 @@ 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 @@ -104,7 +106,8 @@ type 'a mut_list = { 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 From 5e336d379da8d6b9a97f8afefc01255bbc6d84bb Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 15:35:48 +0900 Subject: [PATCH 241/273] BatNativeint: 4.08 compat --- src/batNativeint.mliv | 25 +++++++++++++++++++++++++ src/batNativeint.mlv | 4 ++++ 2 files changed, 29 insertions(+) diff --git a/src/batNativeint.mliv b/src/batNativeint.mliv index 8b8d62861..c5c47b7cf 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 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 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 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, @@ -219,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 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 3df1935d9..6771ffe79 100644 --- a/src/batNativeint.mlv +++ b/src/batNativeint.mlv @@ -77,6 +77,10 @@ external of_string : string -> nativeint = "caml_nativeint_of_string" ##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 From 103b462dc6eb547f010e1af08304bae0814b1881 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 15:36:27 +0900 Subject: [PATCH 242/273] BatPrintexc: 4.08 compat --- src/batPrintexc.mliv | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/batPrintexc.mliv b/src/batPrintexc.mliv index 20c40268c..cd6246f95 100644 --- a/src/batPrintexc.mliv +++ b/src/batPrintexc.mliv @@ -345,3 +345,6 @@ val print : _ BatInnerIO.output -> exn -> unit ##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. *) From a712c0d740f6aceb6ff4aac816507ea00b312f9e Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 15:38:17 +0900 Subject: [PATCH 243/273] BatQueue: 4.07 and 4.08 compat Note to other maintainers: I am not sure take_opt and peek_opt should be introduced by preprocessing. Maybe we want them added to all OCaml versions? --- src/{batQueue.mli => batQueue.mliv} | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) rename src/{batQueue.mli => batQueue.mliv} (82%) diff --git a/src/batQueue.mli b/src/batQueue.mliv similarity index 82% rename from src/batQueue.mli rename to src/batQueue.mliv index a471b2eb9..71d275a0e 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 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 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 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 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 4.07 *) + (** {6 Boilerplate code}*) (** {7 Printing}*) From 1c4eb97415198ae7b648ff5268a31753317bdb94 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 15:39:55 +0900 Subject: [PATCH 244/273] BatString: 4.08 compat --- src/batString.mliv | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/batString.mliv b/src/batString.mliv index 974d10987..1825e392d 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -748,6 +748,21 @@ val split_on_char: char -> string -> string list @since 2.5.3 *) +##V>=4.08##(** {1 Iterators} *) + +##V>=4.08##val to_seq : t -> char Seq.t +##V>=4.08##(** Iterate on the string, in increasing index order. Modifications of the +##V>=4.08## string during iteration will be reflected in the iterator. +##V>=4.08## @since 4.07 *) + +##V>=4.08##val to_seqi : t -> (int * char) Seq.t +##V>=4.08##(** Iterate on the string, in increasing order, yielding indices along chars +##V>=4.08## @since 4.07 *) + +##V>=4.08##val of_seq : char Seq.t -> t +##V>=4.08##(** Create a string from the generator +##V>=4.08## @since 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 From bd76e833d8d8f9731e24c90ebfa2aa8577677f07 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 15:40:24 +0900 Subject: [PATCH 245/273] BatSys: 4.08 compat --- src/batSys.mliv | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/batSys.mliv b/src/batSys.mliv index accf642ea..b7a4f9333 100644 --- a/src/batSys.mliv +++ b/src/batSys.mliv @@ -152,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} *) From cfd174db7adde8508293c76fee6b173687f4ed43 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Wed, 31 Jul 2019 15:40:56 +0900 Subject: [PATCH 246/273] BatUnix: 4.08 compat --- src/batUnix.mliv | 63 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) diff --git a/src/batUnix.mliv b/src/batUnix.mliv index 029dd9501..5a4def970 100644 --- a/src/batUnix.mliv +++ b/src/batUnix.mliv @@ -311,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] @@ -805,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 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 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 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 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 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 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 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 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, From 9fded5ae2fa4d75df4325817ab6b975007cf22d6 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Thu, 1 Aug 2019 15:42:16 +0900 Subject: [PATCH 247/273] BatString: to_seq{i} and of_seq are from OCaml 4.07, not 4.08 also added NEXT_RELEASE tag for them --- src/batString.mliv | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/batString.mliv b/src/batString.mliv index 1825e392d..bba936568 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -748,20 +748,20 @@ val split_on_char: char -> string -> string list @since 2.5.3 *) -##V>=4.08##(** {1 Iterators} *) +##V>=4.07##(** {1 Iterators} *) -##V>=4.08##val to_seq : t -> char Seq.t -##V>=4.08##(** Iterate on the string, in increasing index order. Modifications of the -##V>=4.08## string during iteration will be reflected in the iterator. -##V>=4.08## @since 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 NEXT_RELEASE and OCaml 4.07 *) -##V>=4.08##val to_seqi : t -> (int * char) Seq.t -##V>=4.08##(** Iterate on the string, in increasing order, yielding indices along chars -##V>=4.08## @since 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 NEXT_RELEASE and OCaml 4.07 *) -##V>=4.08##val of_seq : char Seq.t -> t -##V>=4.08##(** Create a string from the generator -##V>=4.08## @since 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 NEXT_RELEASE and OCaml 4.07 *) val split : string -> by:string -> string * string (** [split s sep] splits the string [s] between the first From ff27a6835d1db19dbcaef06c76504e566708c882 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Thu, 1 Aug 2019 15:43:51 +0900 Subject: [PATCH 248/273] added missing NEXT_RELEASE tags in many places --- src/batBuffer.mliv | 70 +++++++++++++++++++++---------------------- src/batBytes.mliv | 62 +++++++++++++++++++------------------- src/batInt32.mliv | 8 ++--- src/batInt64.mliv | 8 ++--- src/batList.mliv | 4 +-- src/batNativeint.mliv | 8 ++--- src/batQueue.mliv | 10 +++---- src/batUnix.mliv | 16 +++++----- 8 files changed, 93 insertions(+), 93 deletions(-) diff --git a/src/batBuffer.mliv b/src/batBuffer.mliv index 00da02bad..5034c0bf0 100644 --- a/src/batBuffer.mliv +++ b/src/batBuffer.mliv @@ -196,20 +196,20 @@ val print: 'a BatInnerIO.output -> t -> unit ##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 4.07 *) -##V>=4.07## +##V>=4.07## @since NEXT_RELEASE 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 4.07 *) -##V>=4.07## +##V>=4.07## @since NEXT_RELEASE 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 4.07 *) -##V>=4.07## +##V>=4.07## @since NEXT_RELEASE 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 4.07 *) +##V>=4.07## @since NEXT_RELEASE and OCaml 4.07 *) ##V>=4.08##(** {1 Binary encoding of integers} *) ##V>=4.08## @@ -230,87 +230,87 @@ val print: 'a BatInnerIO.output -> t -> unit ##V>=4.08## encode these values truncate their inputs to their least ##V>=4.08## significant bytes. ##V>=4.08##*) -##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 4.08 +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 ##V>=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 4.08 +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 ##V>=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 4.08 +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 ##V>=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 4.08 +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 ##V>=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 4.08 +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 ##V>=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 4.08 +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 ##V>=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 4.08 +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 ##V>=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 4.08 +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 ##V>=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 4.08 +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 ##V>=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 4.08 +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 ##V>=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 4.08 +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 ##V>=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 4.08 +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 ##V>=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 4.08 +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 ##V>=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 4.08 +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 ##V>=4.08##*) diff --git a/src/batBytes.mliv b/src/batBytes.mliv index 4546709c5..c7b3d6170 100644 --- a/src/batBytes.mliv +++ b/src/batBytes.mliv @@ -446,15 +446,15 @@ let s = Bytes.of_string "hello" ##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 4.07 *) +##V>=4.07## @since NEXT_RELEASE 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 4.07 *) +##V>=4.07## @since NEXT_RELEASE 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 4.07 *) +##V>=4.07## @since NEXT_RELEASE and OCaml 4.07 *) ##V>=4.08##(** {1 Binary encoding/decoding of integers} *) ##V>=4.08## @@ -487,168 +487,168 @@ let s = Bytes.of_string "hello" ##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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE 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 4.08 +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 ##V>=4.08##*) (**/**) diff --git a/src/batInt32.mliv b/src/batInt32.mliv index e258a9505..b0d19b41a 100644 --- a/src/batInt32.mliv +++ b/src/batInt32.mliv @@ -79,7 +79,7 @@ external div : int32 -> int32 -> int32 = "%int32_div" ##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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08.0 *) external rem : int32 -> int32 -> int32 = "%int32_mod" (** Integer remainder. If [y] is not zero, the result @@ -91,7 +91,7 @@ external rem : int32 -> int32 -> int32 = "%int32_mod" ##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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08.0 *) val modulo : int32 -> int32 -> int32 val pow : int32 -> int32 -> int32 @@ -170,7 +170,7 @@ external to_int : int32 -> int = "%int32_to_int" ##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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08.0 *) external of_float : float -> int32 = "caml_int32_of_float" ##V>=4.3## "caml_int32_of_float_unboxed" [@@unboxed] [@@noalloc] @@ -261,7 +261,7 @@ val 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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08.0 *) val equal : t -> t -> bool (** Equality function for 32-bit integers, useful for {!HashedType}. *) diff --git a/src/batInt64.mliv b/src/batInt64.mliv index 748803948..405dbb7dd 100644 --- a/src/batInt64.mliv +++ b/src/batInt64.mliv @@ -81,7 +81,7 @@ external div : int64 -> int64 -> int64 = "%int64_div" ##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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08.0 *) external rem : int64 -> int64 -> int64 = "%int64_mod" (** Integer remainder. If [y] is not zero, the result @@ -93,7 +93,7 @@ external rem : int64 -> int64 -> int64 = "%int64_mod" ##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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08.0 *) val succ : int64 -> int64 (** Successor. [Int64.succ x] is [Int64.add x Int64.one]. *) @@ -167,7 +167,7 @@ external to_int : int64 -> int = "%int64_to_int" ##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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08.0 *) external of_float : float -> int64 = "caml_int64_of_float" ##V>=4.3## "caml_int64_of_float_unboxed" [@@unboxed] [@@noalloc] @@ -243,7 +243,7 @@ val 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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08.0 *) val equal : t -> t -> bool (** Equality function for 64-bit integers, useful for {!HashedType}. *) diff --git a/src/batList.mliv b/src/batList.mliv index 5514a3634..da3a40e5d 100644 --- a/src/batList.mliv +++ b/src/batList.mliv @@ -330,11 +330,11 @@ val min_max : ?cmp:('a -> 'a -> int) -> 'a list -> 'a * 'a ##V>=4.07##val to_seq : 'a list -> 'a Seq.t ##V>=4.07##(** Iterate on the list -##V>=4.07## @since 4.07 *) +##V>=4.07## @since NEXT_RELEASE 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 4.07 *) +##V>=4.07## @since NEXT_RELEASE and OCaml 4.07 *) (** {6 Iterators on two lists} *) diff --git a/src/batNativeint.mliv b/src/batNativeint.mliv index c5c47b7cf..95ed9e54e 100644 --- a/src/batNativeint.mliv +++ b/src/batNativeint.mliv @@ -82,7 +82,7 @@ external div : nativeint -> nativeint -> nativeint = "%nativeint_div" ##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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08.0 *) external rem : nativeint -> nativeint -> nativeint = "%nativeint_mod" (** Integer remainder. If [y] is not zero, the result @@ -95,7 +95,7 @@ external rem : nativeint -> nativeint -> nativeint = "%nativeint_mod" ##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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08.0 *) val succ : nativeint -> nativeint (** Successor. @@ -180,7 +180,7 @@ external to_int : nativeint -> int = "%nativeint_to_int" ##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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08.0 *) external of_float : float -> nativeint = "caml_nativeint_of_float" ##V>=4.3## "caml_nativeint_of_float_unboxed" [@@unboxed] [@@noalloc] @@ -242,7 +242,7 @@ val 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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08.0 *) val equal : t -> t -> bool (** Equality function for 64-bit integers, useful for {!HashedType}. *) diff --git a/src/batQueue.mliv b/src/batQueue.mliv index 71d275a0e..6509e87d4 100644 --- a/src/batQueue.mliv +++ b/src/batQueue.mliv @@ -51,7 +51,7 @@ val take : 'a t -> 'a ##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 4.08 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 *) val pop : 'a t -> 'a (** [pop] is a synonym for [take]. *) @@ -63,7 +63,7 @@ val peek : 'a t -> 'a ##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 4.08 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08 *) val top : 'a t -> 'a (** [top] is a synonym for [peek]. *) @@ -147,15 +147,15 @@ val of_enum : 'a BatEnum.t -> 'a 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 4.07 *) +##V>=4.07## @since NEXT_RELEASE 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 4.07 *) +##V>=4.07## @since NEXT_RELEASE 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 4.07 *) +##V>=4.07## @since NEXT_RELEASE and OCaml 4.07 *) (** {6 Boilerplate code}*) diff --git a/src/batUnix.mliv b/src/batUnix.mliv index 5a4def970..ac5947ed0 100644 --- a/src/batUnix.mliv +++ b/src/batUnix.mliv @@ -815,7 +815,7 @@ val open_process_full : ##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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE 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 @@ -824,7 +824,7 @@ val open_process_full : ##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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE 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 @@ -832,7 +832,7 @@ val open_process_full : ##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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08.0 *) ##V>=4.08##val open_process_args_full : ##V>=4.08## string -> string array -> string array -> @@ -842,31 +842,31 @@ val open_process_full : ##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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE 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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE 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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE 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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE 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 4.08.0 *) +##V>=4.08## @since NEXT_RELEASE and OCaml 4.08.0 *) val close_process_in : BatInnerIO.input -> process_status (** Close {!type:input} opened by {!Unix.open_process_in}, From fd1ca0ff8bccffb11d0360ba94105292ee98a7cc Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Mon, 19 Aug 2019 11:50:45 +0900 Subject: [PATCH 249/273] next release will be 2.10.0 --- ChangeLog | 22 +++++++++++---- _oasis | 2 +- src/batBuffer.mliv | 36 ++++++++++++------------- src/batBytes.mliv | 62 +++++++++++++++++++++---------------------- src/batGc.mliv | 6 ++--- src/batHashtbl.mli | 4 +-- src/batInt32.mliv | 8 +++--- src/batInt64.mliv | 8 +++--- src/batList.mliv | 6 ++--- src/batNativeint.mliv | 8 +++--- src/batQueue.mliv | 10 +++---- src/batSeq.mli | 6 ++--- src/batString.mliv | 6 ++--- src/batUnix.mliv | 18 ++++++------- 14 files changed, 107 insertions(+), 95 deletions(-) diff --git a/ChangeLog b/ChangeLog index b0fa0e5a0..afa8d5372 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,7 +1,19 @@ Changelog --------- -## NEXT_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 @@ -13,13 +25,13 @@ Changelog (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". - (Gabriel Scherer, report by Marcel Hark) + "-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) + #891 + (Cedric Cellier, Francois Berenger, Gabriel Scherer) ## v2.9.0 (minor release) diff --git a/_oasis b/_oasis index 70aa351b0..11fedd39c 100644 --- a/_oasis +++ b/_oasis @@ -1,7 +1,7 @@ OASISFormat: 0.4 OCamlVersion: >= 3.12.1 Name: batteries -Version: NEXT_RELEASE +Version: 2.10.0 Authors: Batteries Included Team License: LGPL-2.1 with OCaml linking exception LicenseFile: LICENSE diff --git a/src/batBuffer.mliv b/src/batBuffer.mliv index 5034c0bf0..2378e4f4b 100644 --- a/src/batBuffer.mliv +++ b/src/batBuffer.mliv @@ -196,20 +196,20 @@ val print: 'a BatInnerIO.output -> t -> unit ##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 NEXT_RELEASE and OCaml 4.07 *) +##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 NEXT_RELEASE and OCaml 4.07 *) +##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 NEXT_RELEASE and OCaml 4.07 *) +##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 NEXT_RELEASE and OCaml 4.07 *) +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) ##V>=4.08##(** {1 Binary encoding of integers} *) ##V>=4.08## @@ -234,83 +234,83 @@ val print: 'a BatInnerIO.output -> t -> unit ##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##V>=4.08## @since 2.10.0 and OCaml 4.08 ##V>=4.08##*) diff --git a/src/batBytes.mliv b/src/batBytes.mliv index c7b3d6170..386a7b72f 100644 --- a/src/batBytes.mliv +++ b/src/batBytes.mliv @@ -446,15 +446,15 @@ let s = Bytes.of_string "hello" ##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 NEXT_RELEASE and OCaml 4.07 *) +##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 NEXT_RELEASE and OCaml 4.07 *) +##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 NEXT_RELEASE and OCaml 4.07 *) +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) ##V>=4.08##(** {1 Binary encoding/decoding of integers} *) ##V>=4.08## @@ -487,168 +487,168 @@ let s = Bytes.of_string "hello" ##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##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 NEXT_RELEASE and OCaml 4.08 +##V>=4.08## @since 2.10.0 and OCaml 4.08 ##V>=4.08##*) (**/**) diff --git a/src/batGc.mliv b/src/batGc.mliv index b5b3a9ae6..906739ab0 100644 --- a/src/batGc.mliv +++ b/src/batGc.mliv @@ -172,7 +172,7 @@ type control = Gc.control = ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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 @@ -182,7 +182,7 @@ type control = Gc.control = ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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 @@ -193,7 +193,7 @@ type control = Gc.control = ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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 diff --git a/src/batHashtbl.mli b/src/batHashtbl.mli index eaf789107..b89f6559f 100644 --- a/src/batHashtbl.mli +++ b/src/batHashtbl.mli @@ -250,7 +250,7 @@ val merge: ('a -> 'b option -> 'c option -> 'd option) -> 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 NEXT_RELEASE + @since 2.10.0 *) val merge_all: ('a -> 'b list -> 'c list -> 'd list) -> @@ -261,7 +261,7 @@ val merge_all: ('a -> 'b list -> 'c list -> 'd list) -> 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 NEXT_RELEASE + @since 2.10.0 *) (** {6 The polymorphic hash primitive}*) diff --git a/src/batInt32.mliv b/src/batInt32.mliv index b0d19b41a..b1f2ea618 100644 --- a/src/batInt32.mliv +++ b/src/batInt32.mliv @@ -79,7 +79,7 @@ external div : int32 -> int32 -> int32 = "%int32_div" ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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 @@ -91,7 +91,7 @@ external rem : int32 -> int32 -> int32 = "%int32_mod" ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) val modulo : int32 -> int32 -> int32 val pow : int32 -> int32 -> int32 @@ -170,7 +170,7 @@ external to_int : int32 -> int = "%int32_to_int" ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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] @@ -261,7 +261,7 @@ val 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 NEXT_RELEASE and OCaml 4.08.0 *) +##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/batInt64.mliv b/src/batInt64.mliv index 405dbb7dd..581b8a8f6 100644 --- a/src/batInt64.mliv +++ b/src/batInt64.mliv @@ -81,7 +81,7 @@ external div : int64 -> int64 -> int64 = "%int64_div" ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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 @@ -93,7 +93,7 @@ external rem : int64 -> int64 -> int64 = "%int64_mod" ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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]. *) @@ -167,7 +167,7 @@ external to_int : int64 -> int = "%int64_to_int" ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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] @@ -243,7 +243,7 @@ val 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 NEXT_RELEASE and OCaml 4.08.0 *) +##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/batList.mliv b/src/batList.mliv index da3a40e5d..b2aba6b8e 100644 --- a/src/batList.mliv +++ b/src/batList.mliv @@ -330,11 +330,11 @@ val min_max : ?cmp:('a -> 'a -> int) -> 'a list -> 'a * 'a ##V>=4.07##val to_seq : 'a list -> 'a Seq.t ##V>=4.07##(** Iterate on the list -##V>=4.07## @since NEXT_RELEASE and OCaml 4.07 *) +##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 NEXT_RELEASE and OCaml 4.07 *) +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) (** {6 Iterators on two lists} *) @@ -718,7 +718,7 @@ val fold_while : ('acc -> 'a -> bool) -> ('acc -> 'a -> 'acc) -> 'acc -> 'a list At the end, the accumulated value along with the remaining part of the list are returned. - @since NEXT_RELEASE + @since 2.10.0 *) val nsplit : ('a -> bool) -> 'a list -> 'a list list diff --git a/src/batNativeint.mliv b/src/batNativeint.mliv index 95ed9e54e..2a29bbb23 100644 --- a/src/batNativeint.mliv +++ b/src/batNativeint.mliv @@ -82,7 +82,7 @@ external div : nativeint -> nativeint -> nativeint = "%nativeint_div" ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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 @@ -95,7 +95,7 @@ external rem : nativeint -> nativeint -> nativeint = "%nativeint_mod" ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##V>=4.08## @since 2.10.0 and OCaml 4.08.0 *) val succ : nativeint -> nativeint (** Successor. @@ -180,7 +180,7 @@ external to_int : nativeint -> int = "%nativeint_to_int" ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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] @@ -242,7 +242,7 @@ val 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 NEXT_RELEASE and OCaml 4.08.0 *) +##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/batQueue.mliv b/src/batQueue.mliv index 6509e87d4..90ce161c0 100644 --- a/src/batQueue.mliv +++ b/src/batQueue.mliv @@ -51,7 +51,7 @@ val take : 'a t -> 'a ##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 NEXT_RELEASE and OCaml 4.08 *) +##V>=4.08## @since 2.10.0 and OCaml 4.08 *) val pop : 'a t -> 'a (** [pop] is a synonym for [take]. *) @@ -63,7 +63,7 @@ val peek : 'a t -> 'a ##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 NEXT_RELEASE and OCaml 4.08 *) +##V>=4.08## @since 2.10.0 and OCaml 4.08 *) val top : 'a t -> 'a (** [top] is a synonym for [peek]. *) @@ -147,15 +147,15 @@ val of_enum : 'a BatEnum.t -> 'a 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 NEXT_RELEASE and OCaml 4.07 *) +##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 NEXT_RELEASE and OCaml 4.07 *) +##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 NEXT_RELEASE and OCaml 4.07 *) +##V>=4.07## @since 2.10.0 and OCaml 4.07 *) (** {6 Boilerplate code}*) diff --git a/src/batSeq.mli b/src/batSeq.mli index d7aeaead4..93fc8e59a 100644 --- a/src/batSeq.mli +++ b/src/batSeq.mli @@ -277,19 +277,19 @@ val print : ?first:string -> ?last:string -> ?sep:string -> ('a BatInnerIO.outpu 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 NEXT_RELEASE + @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 NEXT_RELEASE + @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 NEXT_RELEASE + @since 2.10.0 *) module Infix : sig diff --git a/src/batString.mliv b/src/batString.mliv index bba936568..c33673315 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -753,15 +753,15 @@ val split_on_char: char -> string -> string list ##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 NEXT_RELEASE and OCaml 4.07 *) +##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 NEXT_RELEASE and OCaml 4.07 *) +##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 NEXT_RELEASE and OCaml 4.07 *) +##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 diff --git a/src/batUnix.mliv b/src/batUnix.mliv index ac5947ed0..4e7dd990e 100644 --- a/src/batUnix.mliv +++ b/src/batUnix.mliv @@ -603,7 +603,7 @@ val rename : string -> string -> unit ##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 NEXT_RELEASE and OCaml 4.08. +##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. @@ -815,7 +815,7 @@ val open_process_full : ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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 @@ -824,7 +824,7 @@ val open_process_full : ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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 @@ -832,7 +832,7 @@ val open_process_full : ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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 -> @@ -842,31 +842,31 @@ val open_process_full : ##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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 NEXT_RELEASE and OCaml 4.08.0 *) +##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}, From c3a880aa4cdd7b9b115e7f8c58df676e6890ea48 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Mon, 19 Aug 2019 11:51:22 +0900 Subject: [PATCH 250/273] Update setup.ml based on _oasis --- setup.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/setup.ml b/setup.ml index 2efa5da86..8df1e0dde 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.2.0 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 7d84cba1f5cf0ad1c123fc524bb4361c) *) +(* DO NOT EDIT (digest: 8eacb5fc3c01b3f2ec2fa94f8db2c52a) *) (* Regenerated by OASIS v0.4.11 Visit http://oasis.forge.ocamlcore.org for more information and @@ -2653,7 +2653,7 @@ module OASISFindlib = struct (fun lib_name status mp -> match status with | `Solved _ -> - (* Solved initially, no need to go further *) + (* Solved initialy, no need to go further *) mp | `Unsolved _ -> let _, mp = solve SetString.empty mp lib_name "" in @@ -6742,7 +6742,7 @@ let setup_t = { oasis_version = "0.4"; ocaml_version = Some (OASISVersion.VGreaterEqual "3.12.1"); - version = "2.9.0"; + version = "2.10.0"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -7019,7 +7019,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.11"; - oasis_digest = Some ")\254R1\139\147\b\202/\219\210\239\179N`\156"; + oasis_digest = Some "\031B\"\198\141\157`Yd\200\159F\169\162\127\022"; oasis_exec = None; oasis_setup_args = []; setup_update = false From 9c4a1805f5fafc395e66f0a50f00d6155144715c Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Mon, 19 Aug 2019 12:01:10 +0900 Subject: [PATCH 251/273] updated opam file with bits from the one in opam-repository --- opam | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/opam b/opam index 95111823b..f40435a67 100644 --- a/opam +++ b/opam @@ -1,10 +1,14 @@ -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: [ @@ -14,10 +18,14 @@ build: [ 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.5"} - "qcheck" {test & >= "0.6"} + "qtest" {with-test & >= "2.5"} + "qcheck" {with-test & >= "0.6"} "num" ] -available: [ocaml-version >= "3.12.1"] +#url { +# src: "https://github.com/ocaml-batteries-team/batteries-included/releases/download/vXXX/batteries-XXX.tar.gz" +# checksum: "md5=XXX" +#} From badd9709685dcd70b05cb6729de96926dcda5a05 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Mon, 19 Aug 2019 17:13:06 +0900 Subject: [PATCH 252/273] repaired upload-docs target in Makefile and make it more readable too --- Makefile | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index ddd86a52e..d7752f426 100644 --- a/Makefile +++ b/Makefile @@ -288,4 +288,13 @@ 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 github gh-pages + 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 From 613a336c91acc1cad1efefcefaf9fbab2b29eb4f Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Mon, 19 Aug 2019 17:15:37 +0900 Subject: [PATCH 253/273] start of next release --- ChangeLog | 4 ++++ _oasis | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index afa8d5372..240f0ec90 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,10 @@ Changelog --------- +## NEXT_RELEASE + +... cool features to come. + ## v2.10.0 (minor release) This minor release adds support for OCaml 4.08.0. diff --git a/_oasis b/_oasis index 11fedd39c..70aa351b0 100644 --- a/_oasis +++ b/_oasis @@ -1,7 +1,7 @@ OASISFormat: 0.4 OCamlVersion: >= 3.12.1 Name: batteries -Version: 2.10.0 +Version: NEXT_RELEASE Authors: Batteries Included Team License: LGPL-2.1 with OCaml linking exception LicenseFile: LICENSE From 9d3ab53cc06f2aee0920c6b350b3c297d00f0370 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Fri, 27 Sep 2019 10:16:09 +0200 Subject: [PATCH 254/273] Fix compilation by BER MetaOCaml (#909) Set.Infix used to have operators `<.` and `>.` (for strict subset and strict superset), but `>.` is also used as a code block end-quote by BER. It's been decided to jettison the whole BatSet.Infix module, as a simple and future proof fix. Ref #908 --- src/batSet.ml | 43 ------------------------------------------- src/batSet.mli | 39 --------------------------------------- 2 files changed, 82 deletions(-) diff --git a/src/batSet.ml b/src/batSet.ml index 01a58bf2a..f1b071222 100644 --- a/src/batSet.ml +++ b/src/batSet.ml @@ -586,16 +586,6 @@ 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 @@ -727,17 +717,6 @@ 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 @@ -882,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 @@ -1083,17 +1051,6 @@ let disjoint s1 s2 = Concrete.disjoint Pervasives.compare s1 s2 *) -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 (*$T op_map diff --git a/src/batSet.mli b/src/batSet.mli index 8b8dfdd24..3cd62dec8 100644 --- a/src/batSet.mli +++ b/src/batSet.mli @@ -301,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}*) (** @@ -667,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 @@ -958,19 +932,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) From 549a0f9a460f1b84a9efce3f965cfa3ed75abc22 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Mon, 30 Sep 2019 04:39:59 +0200 Subject: [PATCH 255/273] Add BatFilename (#910) Also added `Filename.split_extension` Closes #445 --- .gitignore | 1 + src/batFilename.ml | 33 ++++++ src/batFilename.mliv | 234 +++++++++++++++++++++++++++++++++++++++++++ src/batteries.mllib | 1 + src/batteries.mlv | 1 + 5 files changed, 270 insertions(+) create mode 100644 src/batFilename.ml create mode 100644 src/batFilename.mliv diff --git a/.gitignore b/.gitignore index 3b6a13063..230f587a9 100644 --- a/.gitignore +++ b/.gitignore @@ -34,3 +34,4 @@ src/batPrintf.mli src/batFormat.mli src/batSys.mli src/batBigarray.mli +src/batFilename.mli diff --git a/src/batFilename.ml b/src/batFilename.ml new file mode 100644 index 000000000..82c2e1b12 --- /dev/null +++ b/src/batFilename.ml @@ -0,0 +1,33 @@ +(* + * 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 + * 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 + *) + +include Filename + +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/batteries.mllib b/src/batteries.mllib index 30ab679a6..cd4df595e 100644 --- a/src/batteries.mllib +++ b/src/batteries.mllib @@ -13,6 +13,7 @@ BatInnerPervasives BatDeque BatDigest BatEnum + BatFilename BatFingerTree BatFloat BatFormat diff --git a/src/batteries.mlv b/src/batteries.mlv index e4c6e6993..81047a896 100644 --- a/src/batteries.mlv +++ b/src/batteries.mlv @@ -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 From 4d34e6aa3973a905240c4dd43d0ed619445c9351 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Mon, 30 Sep 2019 04:41:06 +0200 Subject: [PATCH 256/273] s/RELASE/RELEASE (#911) typos --- src/batGc.mliv | 2 +- src/batPrintexc.mliv | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/batGc.mliv b/src/batGc.mliv index 906739ab0..de5554e90 100644 --- a/src/batGc.mliv +++ b/src/batGc.mliv @@ -356,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/batPrintexc.mliv b/src/batPrintexc.mliv index cd6246f95..2ea7f3bf8 100644 --- a/src/batPrintexc.mliv +++ b/src/batPrintexc.mliv @@ -325,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##*) From 9cdd373c9f785e399eaeec73168d1aab615247e4 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Mon, 30 Sep 2019 04:45:14 +0200 Subject: [PATCH 257/273] Improve toplevel printability of predefined sets (#912) Redefining the modules (instead of using those predefined in BatSet) was causing the printers for BatSet.Int and friends useless. Closes #750 --- battop.ml | 4 ++++ src/batteriesPrint.ml | 15 +++++++-------- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/battop.ml b/battop.ml index 2900ccc1f..397f55832 100644 --- a/battop.ml +++ b/battop.ml @@ -72,6 +72,10 @@ open Batteries;; #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/src/batteriesPrint.ml b/src/batteriesPrint.ml index 35e4f98d5..24f396b81 100644 --- a/src/batteriesPrint.ml +++ b/src/batteriesPrint.ml @@ -42,14 +42,13 @@ 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) From f8aef1e91f3b20b52e01a939b8500addc7bfc891 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Mon, 30 Sep 2019 05:01:27 +0200 Subject: [PATCH 258/273] Remove BatOo (#915) As it is undocumented, unsupported and unsafe. Closes #848 --- build/intro.text | 2 +- src/batOo.ml | 24 ------ src/batOo.mli | 190 -------------------------------------------- src/batteries.mllib | 1 - src/batteries.mlv | 1 - 5 files changed, 1 insertion(+), 217 deletions(-) delete mode 100644 src/batOo.ml delete mode 100644 src/batOo.mli diff --git a/build/intro.text b/build/intro.text index 22b71a0b3..319edcfbb 100644 --- a/build/intro.text +++ b/build/intro.text @@ -55,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/src/batOo.ml b/src/batOo.ml deleted file mode 100644 index 48844cd06..000000000 --- a/src/batOo.ml +++ /dev/null @@ -1,24 +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 - *) - - -include Oo -module Internal = CamlinternalOO 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/batteries.mllib b/src/batteries.mllib index cd4df595e..8c1c6e377 100644 --- a/src/batteries.mllib +++ b/src/batteries.mllib @@ -33,7 +33,6 @@ BatInnerPervasives BatMarshal BatNativeint BatNum - BatOo BatPervasives BatPrintexc BatPrintf diff --git a/src/batteries.mlv b/src/batteries.mlv index 81047a896..1a4e47e4e 100644 --- a/src/batteries.mlv +++ b/src/batteries.mlv @@ -82,7 +82,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 *) From 1a2ccff4ffde22138d4929e3fcbaacda124eb074 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Mon, 30 Sep 2019 05:17:56 +0200 Subject: [PATCH 259/273] Make BatSeq.Exceptionless.combine really exceptionless (#917) Now, BatSeq.Exceptionless.combine returns the longest sequence possible (stopping when one of the input sequence ends). Closes #418 --- src/batSeq.ml | 16 ++++++++++++---- src/batSeq.mli | 2 +- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/src/batSeq.ml b/src/batSeq.ml index 42842eb1c..2687521d4 100644 --- a/src/batSeq.ml +++ b/src/batSeq.ml @@ -429,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) @@ -477,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 93fc8e59a..fca06637c 100644 --- a/src/batSeq.mli +++ b/src/batSeq.mli @@ -322,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 From d563bd21dadea4145ba7e5943a58cb88d2c42601 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Mon, 30 Sep 2019 05:20:14 +0200 Subject: [PATCH 260/273] BatString.split_on_char and nsplit must never return an empty list (#918) BatString.split_on_char behavior matches the one of Legacy.String.split_on_char, and that nsplit behavior matches the one of split_on_char. Closes #845 Closes #846 --- src/batString.mliv | 4 +++- src/batString.mlv | 8 ++++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/batString.mliv b/src/batString.mliv index c33673315..623abb84b 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -745,6 +745,7 @@ 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 *) @@ -788,7 +789,8 @@ 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"; ""]] *) diff --git a/src/batString.mlv b/src/batString.mlv index 706b641c0..3779d3a2d 100644 --- a/src/batString.mlv +++ b/src/batString.mlv @@ -383,7 +383,7 @@ 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 [] + if str = "" then [""] else if sep = "" then invalid_arg "String.nsplit: empty sep not allowed" else (* str is non empty *) @@ -412,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"; ""; ""] @@ -420,7 +420,7 @@ 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 = @@ -433,7 +433,7 @@ let split_on_char sep str = (*$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"; ""; ""] *) From 43068b3d3eea4354f8bcef3d7a042e7138e15edc Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Mon, 30 Sep 2019 05:50:21 +0200 Subject: [PATCH 261/273] Add Legacy.Result for OCaml >= 4.8.0 (#913) Now, users can pattern match Result.t returned from some library using Legacy.Result.Error while Batteries is opened. Ref #839 --- src/batteries.mlv | 1 + 1 file changed, 1 insertion(+) diff --git a/src/batteries.mlv b/src/batteries.mlv index 1a4e47e4e..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 *) From 3c323ef1707b9f89c2d9c8694f0163853b21e61c Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Tue, 1 Oct 2019 03:07:10 +0200 Subject: [PATCH 262/273] List.sum [] is now 0 (#916) List.sum and List.fsum default to 0 (or 0.0) in case the list is empty. Previously, this was raising Invalid_argument. Closes #519 --- src/batArray.mlv | 5 +++-- src/batList.mliv | 6 ++++-- src/batList.mlv | 14 +++++++++----- 3 files changed, 16 insertions(+), 9 deletions(-) diff --git a/src/batArray.mlv b/src/batArray.mlv index 64efbcb55..c6fd13c97 100644 --- a/src/batArray.mlv +++ b/src/batArray.mlv @@ -592,12 +592,13 @@ let min_max a = try ignore (min_max [||]); false with Invalid_argument _ -> true *) -let sum = reduce (+) -let fsum = reduce (+.) +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 diff --git a/src/batList.mliv b/src/batList.mliv index b2aba6b8e..560b4db63 100644 --- a/src/batList.mliv +++ b/src/batList.mliv @@ -298,12 +298,14 @@ val min : 'a list -> 'a val sum : int list -> int (** [sum l] returns the sum of the integers of [l]. - @raise Invalid_argument on the empty list. + 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]. - @raise Invalid_argument on the empty list. + 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 diff --git a/src/batList.mlv b/src/batList.mlv index b60454c0b..562dcdae8 100644 --- a/src/batList.mlv +++ b/src/batList.mlv @@ -1369,11 +1369,15 @@ let reduce f = function let min l = reduce Pervasives.min l let max l = reduce Pervasives.max l -let sum 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 - | [] -> invalid_arg "List.fsum: Empty List" + | [] -> 0. | x::xs -> let acc = ref x in let rem = ref xs in @@ -1386,9 +1390,9 @@ let fsum l = rem := xs done; !acc -(*$T fsum - try let _ = fsum [] in false with Invalid_argument _ -> true - fsum [1.;2.;3.] = 6. +(*$= fsum & ~printer:string_of_float + 0. (fsum []) + 6. (fsum [1.;2.;3.]) *) let favg l = From 76975d7fd734263105a8869f2358d929cfa9d8d5 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Mon, 21 Oct 2019 03:46:40 +0200 Subject: [PATCH 263/273] Remove Legacy.Sort for OCaml >= 4.08 (#926) Closes #925 --- src/batteries.mlv | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/batteries.mlv b/src/batteries.mlv index 37e804185..ecbb5801d 100644 --- a/src/batteries.mlv +++ b/src/batteries.mlv @@ -34,7 +34,7 @@ module Legacy = struct module Random = Random module Scanf = Scanf module Set = Set - module Sort = Sort +##V<4.8## module Sort = Sort module Stack = Stack module StdLabels = StdLabels module Stream = Stream From d5ac8a213281342508f0a47d946383287dea1bab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Arma=C3=ABl=20Gu=C3=A9neau?= Date: Wed, 30 Oct 2019 02:11:43 +0100 Subject: [PATCH 264/273] Build with -strict-sequence (#927) --- _tags | 2 +- src/batIO.mli | 6 +++--- src/batInnerPervasives.mlv | 2 +- src/batLazyList.ml | 2 +- src/batRefList.ml | 4 ++-- 5 files changed, 8 insertions(+), 8 deletions(-) diff --git a/_tags b/_tags index c74904414..2e8fc763f 100644 --- a/_tags +++ b/_tags @@ -12,4 +12,4 @@ true: package(bytes), warn_-3, bin_annot : opaque true: safe_string true: no_alias_deps - +true: strict_sequence diff --git a/src/batIO.mli b/src/batIO.mli index dc546d98f..a797aaf80 100644 --- a/src/batIO.mli +++ b/src/batIO.mli @@ -951,7 +951,7 @@ module Incubator : sig ?last:string -> ?sep:string -> ?indent:int -> - (Format.formatter -> 'a -> 'b) -> Format.formatter -> 'a array -> unit + (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a array -> unit (** 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 @@ -972,7 +972,7 @@ module Incubator : sig ?last:string -> ?sep:string -> ?indent:int -> - (Format.formatter -> 'a -> 'b) -> Format.formatter -> 'a BatEnum.t -> unit + (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a BatEnum.t -> unit (** 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 @@ -992,7 +992,7 @@ module Incubator : sig ?last:string -> ?sep:string -> ?indent:int -> - (Format.formatter -> 'a -> 'b) -> Format.formatter -> 'a list -> unit + (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a list -> unit (** 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 diff --git a/src/batInnerPervasives.mlv b/src/batInnerPervasives.mlv index c86f1f7ec..275b03bad 100644 --- a/src/batInnerPervasives.mlv +++ b/src/batInnerPervasives.mlv @@ -58,7 +58,7 @@ let ok = function let wrap f x = try Ok (f x) with ex -> Bad ex -let forever f x = ignore (while true do f x done) +let forever f x = ignore (while true do ignore (f x) done) let ignore_exceptions f x = try ignore (f x) with _ -> () diff --git a/src/batLazyList.ml b/src/batLazyList.ml index 6c4fe715e..c5c48e7ac 100644 --- a/src/batLazyList.ml +++ b/src/batLazyList.ml @@ -106,7 +106,7 @@ let make n x = let iter f l = let rec aux l = match next l with - | Cons (x, t) -> (f x; aux t) + | Cons (x, t) -> (ignore (f x); aux t) | Nil -> () in aux l diff --git a/src/batRefList.ml b/src/batRefList.ml index 36bb5446e..84150b9a4 100644 --- a/src/batRefList.ml +++ b/src/batRefList.ml @@ -121,12 +121,12 @@ module Index = struct let index pred rl = let index = ref (-1) in - List.find (fun it -> incr index; pred it; ) !rl; + ignore (List.find (fun it -> incr index; pred it; ) !rl); !index let index_of rl item = let index = ref (-1) in - List.find (fun it -> incr index; it = item; ) !rl; + ignore (List.find (fun it -> incr index; it = item; ) !rl); !index let at_index rl pos = List.nth !rl pos From 29b7620df212c460d2770ea27b919ae853f7f97f Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Wed, 30 Oct 2019 02:13:00 +0100 Subject: [PATCH 265/273] with_locked_file (#904) * high level file locking file interface * with_file_lock: now call user function with the opened file --- ChangeLog | 5 +++++ src/batUnix.mliv | 10 ++++++++++ src/batUnix.mlv | 23 +++++++++++++++++++++++ 3 files changed, 38 insertions(+) diff --git a/ChangeLog b/ChangeLog index 240f0ec90..d1f350f68 100644 --- a/ChangeLog +++ b/ChangeLog @@ -37,6 +37,11 @@ recommend trying the 'stdcompat' library. #891 (Cedric Cellier, Francois Berenger, Gabriel Scherer) +- added Unix.with_locked_file + #904 + (Cedric Cellier, Francois Berenger) + + ## v2.9.0 (minor release) This minor release adds support for OCaml 4.07.0, as well as a certain diff --git a/src/batUnix.mliv b/src/batUnix.mliv index 4e7dd990e..a7f7599fe 100644 --- a/src/batUnix.mliv +++ b/src/batUnix.mliv @@ -1041,6 +1041,16 @@ val lockf : file_descr -> lock_command -> int -> unit acquired on the specified region, without actually putting a lock. It returns immediately if successful, or fails otherwise. *) +val with_locked_file : kind:[`Read|`Write] -> string -> (file_descr -> 'a) -> 'a +(** [with_locked_file ~kind filename f] puts a lock (using lockf) on the whole + file named [filename], calls [f] with the file descriptor, and returns + its result after the file is unlocked. + The file is opened with permissions matching [kind], and created if it + does not exist yet. + If [f ()] raises an exception the exception is re-raised after the file + is unlocked. + + @param kind specifies whether the lock is read-only or read-write. *) (** {6 Signals} Note: installation of signal handlers is performed via diff --git a/src/batUnix.mlv b/src/batUnix.mlv index 19ac50dc4..e488fb714 100644 --- a/src/batUnix.mlv +++ b/src/batUnix.mlv @@ -215,3 +215,26 @@ let is_directory fn = (lstat fn).st_kind = S_DIR let rec restart_on_EINTR f x = try f x with Unix_error(EINTR, _, _) -> restart_on_EINTR f x + +(** + {6 Locking} +*) + +let with_locked_file ~kind filename f = + let perms = + [O_CREAT ; match kind with `Read -> O_RDONLY | `Write -> O_RDWR] in + let lock_file = openfile filename perms 0o644 in + let lock_action = match kind with + | `Read -> F_RLOCK + | `Write -> F_LOCK + in + lockf lock_file lock_action 0; + BatInnerPervasives.finally + (fun () -> + (* Although the user might expect EINTR to interrupt locking, we must + * not allow such interrupt here since there is no way to restart the + * unlock: *) + restart_on_EINTR (lseek lock_file 0) SEEK_SET |> ignore; + restart_on_EINTR (lockf lock_file F_ULOCK) 0; + restart_on_EINTR close lock_file) + f lock_file From 73b2085c31666ad8f25d55b5ca5437564d4a0d09 Mon Sep 17 00:00:00 2001 From: Cedric Cellier Date: Mon, 16 Dec 2019 02:26:15 +0100 Subject: [PATCH 266/273] Release v2.11.0 (#931) * Fix batFilename for various old OCaml versions split_extension was relying on remove_extension and extension functions that were introduced in OCaml 4.04.0. Also, an ocaml.deprecated annotation needed to be protected by some preprocessing. Tested with most of supported compiler versions. * Prepare Changelog and NEXT_RELEASE placeholder for v2.11.0 * Update setup.ml based on _oasis Closes #928 --- ChangeLog | 35 +++++++++++++++++- _oasis | 2 +- setup.ml | 6 +-- src/batFilename.mliv | 49 +++++++++++++++++-------- src/{batFilename.ml => batFilename.mlv} | 31 ++++++++++++++++ src/batGc.mliv | 2 +- src/batList.mliv | 4 +- src/batPrintexc.mliv | 2 +- src/batString.mliv | 4 +- 9 files changed, 107 insertions(+), 28 deletions(-) rename src/{batFilename.ml => batFilename.mlv} (55%) diff --git a/ChangeLog b/ChangeLog index d1f350f68..798ed7836 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,9 +1,40 @@ Changelog --------- -## NEXT_RELEASE +## v2.11.0 (minor release) + +This minor release fixes a few bugs or interface mismatch with OCaml stdlib, +and is compatible with BER MetaOCaml. + +This is the last planned release of the v2 series. +Next planned release (v3.0.0) will introduce some API changes. + +Notable changes: + +- Add Unix.with_locked_file + #904 + (Simon Cruanes, Cedric Cellier, review by Francois Berenger) + +- Build with -strict-sequence + #927 + (Armaël Guéneau, review by Francois Berenger) + +- Add Legacy.Result for OCaml >= 4.8.0 + #913 + (Cedric Cellier, review by Francois Berenger) + +- Remove BatOo + #915 + (Cedric Cellier, review by Francois Berenger) + +- Add BatFilename + #910 + (Cedric Cellier, review by Francois Berenger) + +- Make batteries usable with BER MetaOCaml + #909 + (Cedric Cellier, review by Francois Berenger and Gabriel Scherer) -... cool features to come. ## v2.10.0 (minor release) diff --git a/_oasis b/_oasis index 70aa351b0..1d3bc6bfc 100644 --- a/_oasis +++ b/_oasis @@ -1,7 +1,7 @@ OASISFormat: 0.4 OCamlVersion: >= 3.12.1 Name: batteries -Version: NEXT_RELEASE +Version: 2.11.0 Authors: Batteries Included Team License: LGPL-2.1 with OCaml linking exception LicenseFile: LICENSE diff --git a/setup.ml b/setup.ml index 8df1e0dde..4dc94f0b1 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.2.0 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 8eacb5fc3c01b3f2ec2fa94f8db2c52a) *) +(* DO NOT EDIT (digest: c538dc9cea7562212bf9319fabb10941) *) (* Regenerated by OASIS v0.4.11 Visit http://oasis.forge.ocamlcore.org for more information and @@ -6742,7 +6742,7 @@ let setup_t = { oasis_version = "0.4"; ocaml_version = Some (OASISVersion.VGreaterEqual "3.12.1"); - version = "2.10.0"; + version = "2.11.0"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -7019,7 +7019,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.11"; - oasis_digest = Some "\031B\"\198\141\157`Yd\200\159F\169\162\127\022"; + oasis_digest = Some "\197\026\147\198c\239\0223\026_)\201>2\152\150"; oasis_exec = None; oasis_setup_args = []; setup_update = false diff --git a/src/batFilename.mliv b/src/batFilename.mliv index 0bcec2e32..8b274755f 100644 --- a/src/batFilename.mliv +++ b/src/batFilename.mliv @@ -30,7 +30,7 @@ val parent_dir_name : string val dir_sep : string (** The directory separator (e.g. [/] in Unix). - @since NEXT_RELEASE and OCaml 3.11.2 *) + @since 2.11.0 and OCaml 3.11.2 *) val concat : string -> string -> string (** [concat dir file] returns a file name that designates file @@ -73,7 +73,7 @@ val chop_suffix : string -> string -> string ##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## @since 2.11.0 and OCaml 4.08 ##V>=4.8##*) @@ -89,7 +89,7 @@ val chop_suffix : string -> string -> string ##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## @since 2.11.0 and OCaml 4.04 ##V>=4.4##*) ##V>=4.4##val remove_extension : string -> string @@ -101,7 +101,7 @@ val chop_suffix : string -> string -> string ##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## @since 2.11.0 and OCaml 4.04 ##V>=4.4##*) val chop_extension : string -> string @@ -141,8 +141,10 @@ val temp_file : ?temp_dir: string -> string -> string -> string *) val open_temp_file : - ?mode: open_flag list -> ?perms: int -> ?temp_dir: string -> string -> - string -> string * out_channel + ?mode: open_flag list -> +##V>4.2## ?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 @@ -150,13 +152,11 @@ val open_temp_file : 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]). + and [Open_text]. The default is [[Open_text]] (open in text mode). +##V>4.2## The file is created with permissions [perms] (defaults to readable and +##V>4.2## 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 @@ -166,24 +166,24 @@ val open_temp_file : ##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## @since 2.11.0 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## @since 2.11.0 and OCaml 4.00.0 ##V>=4.0##*) val temp_dir_name : string - [@@ocaml.deprecated "Use Filename.get_temp_dir_name instead"] +##V>=4.2## [@@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 + @since 2.11.0 and OCaml 3.09.1 *) val quote : string -> string @@ -226,9 +226,26 @@ val quote : string -> string ##V>4.9## Raise [Failure] if the command cannot be escaped on the current platform. ##V>4.9##*) +##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 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 in name0. +##V<4.4## If such a suffix does not exist, extension name is the empty string. +##V<4.4## +##V<4.4## @since 2.11.0 *) + +##V<4.4## val remove_extension : string -> string +##V<4.4##(* Return the given file name without its extension, as defined in +##V<4.4## Filename.extension. If the extension is empty, the function returns +##V<4.4## the given file name. +##V<4.4## +##V<4.4## @since 2.11.0 *) + 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 *) + @since 2.11.0 *) diff --git a/src/batFilename.ml b/src/batFilename.mlv similarity index 55% rename from src/batFilename.ml rename to src/batFilename.mlv index 82c2e1b12..258808f53 100644 --- a/src/batFilename.ml +++ b/src/batFilename.mlv @@ -21,6 +21,37 @@ include Filename +##V<4.4## let is_dir_sep name i = +##V<4.4## try +##V<4.4## for j = 0 to String.length dir_sep - 1 do +##V<4.4## if i + j >= String.length name || +##V<4.4## name.[i + j] != dir_sep.[j] then raise Exit +##V<4.4## done; +##V<4.4## true +##V<4.4## with Exit -> +##V<4.4## false +##V<4.4## +##V<4.4## let extension_len name = +##V<4.4## let rec check i0 i = +##V<4.4## if i < 0 || is_dir_sep name i then 0 +##V<4.4## else if name.[i] = '.' then check i0 (i - 1) +##V<4.4## else String.length name - i0 +##V<4.4## in +##V<4.4## let rec search_dot i = +##V<4.4## if i < 0 || is_dir_sep name i then 0 +##V<4.4## else if name.[i] = '.' then check i (i - 1) +##V<4.4## else search_dot (i - 1) +##V<4.4## in +##V<4.4## search_dot (String.length name - 1) +##V<4.4## +##V<4.4## let remove_extension name = +##V<4.4## let l = extension_len name in +##V<4.4## if l = 0 then name else String.sub name 0 (String.length name - l) +##V<4.4## +##V<4.4## let extension name = +##V<4.4## let l = extension_len name in +##V<4.4## if l = 0 then "" else String.sub name (String.length name - l) l + let split_extension s = remove_extension s, extension s diff --git a/src/batGc.mliv b/src/batGc.mliv index de5554e90..3b452135e 100644 --- a/src/batGc.mliv +++ b/src/batGc.mliv @@ -356,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_RELEASE and OCaml 4.04 +##V>=4.4## @since 2.11.0 and OCaml 4.04 ##V>=4.4##*) val finalise_release : unit -> unit;; diff --git a/src/batList.mliv b/src/batList.mliv index 560b4db63..1fb2534aa 100644 --- a/src/batList.mliv +++ b/src/batList.mliv @@ -299,13 +299,13 @@ val min : 'a list -> 'a val sum : int list -> int (** [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. + Note: prior to 2.11.0, used to raise Invalid_argument on the empty list. *) val fsum : float list -> float (** [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. + Note: prior to 2.11.0, used to raise Invalid_argument on the empty list. *) val favg : float list -> float diff --git a/src/batPrintexc.mliv b/src/batPrintexc.mliv index 2ea7f3bf8..83560d41a 100644 --- a/src/batPrintexc.mliv +++ b/src/batPrintexc.mliv @@ -325,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_RELEASE and OCaml 4.04 +##V>=4.4## @since 2.11.0 and OCaml 4.04 ##V>=4.4##*) diff --git a/src/batString.mliv b/src/batString.mliv index 623abb84b..f0ae7c93d 100644 --- a/src/batString.mliv +++ b/src/batString.mliv @@ -745,7 +745,7 @@ 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. + Note: prior to 2.11.0 [split_on_char _ ""] used to return an empty list. @since 2.5.3 *) @@ -790,7 +790,7 @@ 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 a single empty string. - Note: prior to NEXT_RELEASE [nsplit "" _] used to return an empty list. + Note: prior to 2.11.0 [nsplit "" _] used to return an empty list. Example: [String.nsplit "abcabcabc" "bc" = ["a"; "a"; "a"; ""]] *) From 21809c49160b9e970cff4217e4ca0aa5753b6d56 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Mon, 16 Dec 2019 10:31:34 +0900 Subject: [PATCH 267/273] make Unix.sleepf available under all OCaml versions (#930) * make Unix.sleepf available across all OCaml versions --- ChangeLog | 4 ++++ src/batUnix.mliv | 8 ++++---- src/batUnix.mlv | 31 +++++++++++++++++++++++++++++++ 3 files changed, 39 insertions(+), 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index 798ed7836..abc64edf6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -35,6 +35,10 @@ Notable changes: #909 (Cedric Cellier, review by Francois Berenger and Gabriel Scherer) +- Unix.sleepf is provided across all OCaml versions; + previously it was only for OCaml >= 4.03.0 + #930 + (Francois Berenger, review by Cedric Cellier) ## v2.10.0 (minor release) diff --git a/src/batUnix.mliv b/src/batUnix.mliv index a7f7599fe..017cade4b 100644 --- a/src/batUnix.mliv +++ b/src/batUnix.mliv @@ -1144,10 +1144,10 @@ val alarm : int -> int val sleep : int -> unit (** Stop execution for the given number of seconds. *) -##V>=4.3##val sleepf : float -> unit -##V>=4.3##(** Stop execution for the given number of seconds. Like [sleep], -##V>=4.3## but fractions of seconds are supported. -##V>=4.3## @since 2.5.0 and OCaml 4.03 *) +val sleepf : float -> unit +(** Stop execution for the given number of seconds. Like [sleep], + but fractions of seconds are supported. + @since 2.5.0 *) val times : unit -> process_times (** Return the execution times of the process. *) diff --git a/src/batUnix.mlv b/src/batUnix.mlv index e488fb714..164ed0fd8 100644 --- a/src/batUnix.mlv +++ b/src/batUnix.mlv @@ -30,6 +30,37 @@ include Unix ##V<4.2##let send_substring = send ##V<4.2##let sendto_substring = sendto +##V<4.3##let sleepf (timeout: float): unit = +##V<4.3## let elapsed = ref 0.0 in +##V<4.3## while !elapsed < timeout do +##V<4.3## let start = gettimeofday () in +##V<4.3## begin +##V<4.3## try ignore(select [] [] [] (timeout -. !elapsed)) +##V<4.3## with Unix_error(EINTR, _, _) -> () +##V<4.3## end; +##V<4.3## let stop = gettimeofday () in +##V<4.3## let dt = stop -. start in +##V<4.3## elapsed := !elapsed +. dt +##V<4.3## done; +##V<4.3## () + +(* chronometer is useful to test sleepf *) +(*$inject +let chronometer f = + let start = gettimeofday () in + let res = f () in + let stop = gettimeofday () in + let dt = stop -. start in + (dt, res) ;; +*) + +(* do not underestimate the imprecission of sleepf + and so don't be too harsh when testing it *) +(*$T sleepf +let dt, _ = chronometer (fun () -> sleepf 0.002) in \ +0.001 <= dt && dt <= 0.003 +*) + let run_and_read cmd = (* This code is before the open of BatInnerIO to avoid using batteries' wrapped IOs *) From 728107993726e4d136f6d9c86bac40d33c80927e Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Mon, 16 Dec 2019 11:04:19 +0900 Subject: [PATCH 268/273] the '|>' operator was not available in old versions of the stdlib (e.g. OCaml 4.0.0) --- src/batUnix.mlv | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/batUnix.mlv b/src/batUnix.mlv index 164ed0fd8..c17b630d5 100644 --- a/src/batUnix.mlv +++ b/src/batUnix.mlv @@ -265,7 +265,7 @@ let with_locked_file ~kind filename f = (* Although the user might expect EINTR to interrupt locking, we must * not allow such interrupt here since there is no way to restart the * unlock: *) - restart_on_EINTR (lseek lock_file 0) SEEK_SET |> ignore; + ignore (restart_on_EINTR (lseek lock_file 0) SEEK_SET); restart_on_EINTR (lockf lock_file F_ULOCK) 0; restart_on_EINTR close lock_file) f lock_file From dff125eb71e4c733940ca3f2cb4bab1fa5cd27eb Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Mon, 16 Dec 2019 11:30:21 +0900 Subject: [PATCH 269/273] BatBytes was missing unsafe_blit_string's signature to compile on 4.09.0 --- src/batBytes.mliv | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/batBytes.mliv b/src/batBytes.mliv index 386a7b72f..a5ebb8f9d 100644 --- a/src/batBytes.mliv +++ b/src/batBytes.mliv @@ -666,3 +666,5 @@ let s = Bytes.of_string "hello" ##V<4.4##external unsafe_fill : t -> int -> int -> char -> unit = "caml_fill_string" "noalloc" ##V>=4.4##external unsafe_fill: t -> int -> int -> char -> unit = "caml_fill_bytes" "noalloc" + +##V>=4.09##external unsafe_blit_string : string -> int -> bytes -> int -> int -> unit = "caml_blit_string" "noalloc" From 30abf8b46a4afc3449099a3bab595e1e5414fc5d Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Mon, 16 Dec 2019 11:38:55 +0900 Subject: [PATCH 270/273] provide signatures of new functions from 4.09.0 in BatPrintexc --- src/batPrintexc.mliv | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/batPrintexc.mliv b/src/batPrintexc.mliv index 83560d41a..0f3e20b91 100644 --- a/src/batPrintexc.mliv +++ b/src/batPrintexc.mliv @@ -348,3 +348,17 @@ val print : _ BatInnerIO.output -> exn -> unit ##V>=4.08##type t = exn = .. ##V>=4.08##(** The type of exception values. *) + +##V>=4.09##val use_printers: exn -> string option +##V>=4.09##(** [Printexc.use_printers e] returns [None] if there are no registered +##V>=4.09## printers and [Some s] with else as the resulting string otherwise. +##V>=4.09## +##V>=4.09## @since 2.11.0 and OCaml 4.09 +##V>=4.09##*) + +##V>=4.09##val to_string_default: exn -> string +##V>=4.09##(** [Printexc.to_string_default e] returns a string representation of the +##V>=4.09## exception [e], ignoring all registered exception printers. +##V>=4.09## +##V>=4.09## @since 2.11.0 and OCaml 4.09 +##V>=4.09##*) From 7b53eef77a2e24b7691d8eb7e533f7f0ab8c9eb5 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Mon, 16 Dec 2019 11:47:20 +0900 Subject: [PATCH 271/273] BatSys: change in argv declaration for ocaml >= 4.09.0 --- src/batSys.mliv | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/batSys.mliv b/src/batSys.mliv index b7a4f9333..7df166a78 100644 --- a/src/batSys.mliv +++ b/src/batSys.mliv @@ -29,7 +29,8 @@ @author David Teller *) -val argv : string array +##V>=4.09##external argv : string array = "%sys_argv" +##V<4.09##val argv : string array (** The command line arguments given to the process. The first element is the command name used to invoke the program. The following elements are the command-line arguments From 565dbea7967af4207e9326859f230e554bd408f2 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Mon, 16 Dec 2019 11:52:37 +0900 Subject: [PATCH 272/273] updated opam file to reflect more the one from opam-repository --- opam | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/opam b/opam index f40435a67..3e0aa5f1f 100644 --- a/opam +++ b/opam @@ -9,7 +9,7 @@ authors: "OCaml batteries-included team" homepage: "http://batteries.forge.ocamlcore.org/" bug-reports: "https://github.com/ocaml-batteries-team/batteries-included/issues" dev-repo: "git://github.com/ocaml-batteries-team/batteries-included.git" -license: "LGPL-2.1+ with OCaml linking exception" +license: "LGPL-2.1-or-later with OCaml-LGPL-linking-exception" doc: "http://ocaml-batteries-team.github.io/batteries-included/hdoc2/" build: [ ["ocaml" "setup.ml" "-configure" "--prefix" prefix] @@ -18,7 +18,7 @@ build: [ install: [make "install"] remove: ["ocamlfind" "remove" "batteries"] depends: [ - "ocaml" {>= "3.12.1"} + "ocaml" {>= "4.00.0" & < "4.10.0"} "ocamlfind" {build & >= "1.5.3"} "ocamlbuild" {build} "qtest" {with-test & >= "2.5"} From a7f1789cad5f3e5ae960936b893a6e0e53c30486 Mon Sep 17 00:00:00 2001 From: Francois Berenger Date: Mon, 16 Dec 2019 12:26:24 +0900 Subject: [PATCH 273/273] bits for next release --- ChangeLog | 4 ++++ _oasis | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index abc64edf6..3485c45bc 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,10 @@ Changelog --------- +## v3.0.0 (major release) + +TODO + ## v2.11.0 (minor release) This minor release fixes a few bugs or interface mismatch with OCaml stdlib, diff --git a/_oasis b/_oasis index 1d3bc6bfc..70aa351b0 100644 --- a/_oasis +++ b/_oasis @@ -1,7 +1,7 @@ OASISFormat: 0.4 OCamlVersion: >= 3.12.1 Name: batteries -Version: 2.11.0 +Version: NEXT_RELEASE Authors: Batteries Included Team License: LGPL-2.1 with OCaml linking exception LicenseFile: LICENSE