diff --git a/.gitignore b/.gitignore index 230f587a9..0e1c6f353 100644 --- a/.gitignore +++ b/.gitignore @@ -23,15 +23,3 @@ qtest2/all_tests.ml qtest.targets.log setup.data setup.log -src/batUnix.mli -src/batPervasives.mli -src/batInnerPervasives.ml -src/batHashtbl.ml -src/batMarshal.mli -src/batPrintexc.mli -src/batPrintf.ml -src/batPrintf.mli -src/batFormat.mli -src/batSys.mli -src/batBigarray.mli -src/batFilename.mli diff --git a/Makefile b/Makefile index 90e2982ef..9b1d7ea02 100644 --- a/Makefile +++ b/Makefile @@ -33,34 +33,21 @@ else QTESTPKG = QTest2Lib endif -INSTALL_FILES = _build/META _build/src/*.cma _build/src/*.cmi _build/src/*.mli \ - toplevel/battop.ml _build/toplevel/*.cmi _build/toplevel/*.mli \ -# Note: we do not currently install -# _build/toplevel/*.cma -# as there are no such files. If you create a proper library for batteries-help, you need to add *.cma -# to INSTALL_FILES. - -INSTALL_FILES += \ - _build/src/batteriesConfig.cmo _build/src/batteriesPrint.cmo _build/toplevel/batteriesHelp.cmo \ - toplevel/ocamlinit build/ocaml - +INSTALL_FILES = _build/META _build/src/*.cma \ + battop.ml _build/src/*.cmi _build/src/*.mli \ + _build/src/batteriesHelp.cmo _build/src/batteriesConfig.cmo _build/src/batteriesPrint.cmo \ + ocamlinit build/ocaml # the bin_annot flag in _tags is not handled by versions of ocamlbuild < 4.01.0 # hence we only install *.cmt{i} files if they were produced ifneq ($(wildcard _build/src/*.cmt),) INSTALL_FILES += _build/src/*.cmt - INSTALL_FILES += _build/toplevel/*.cmt endif - ifneq ($(wildcard _build/src/*.cmti),) INSTALL_FILES += _build/src/*.cmti - INSTALL_FILES += _build/toplevel/*.cmti endif -OPT_INSTALL_FILES = \ - _build/src/*.cmx _build/src/*.cmxa _build/src/*.cmxs \ - _build/src/*.a _build/src/*.lib \ - _build/toplevel/*.cmx _build/toplevel/*.cmxa _build/toplevel/*.cmxs \ - _build/toplevel/*.a _build/toplevel/*.lib +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) @@ -70,7 +57,7 @@ endif # What to build TARGETS = src/batteries.cma -TARGETS += toplevel/batteriesHelp.cmo +TARGETS += src/batteriesHelp.cmo TARGETS += src/batteriesThread.cma TARGETS += META BENCH_TARGETS = benchsuite/bench_int.native @@ -188,7 +175,8 @@ clean-prefilter: # $(TESTFILES) from $(TESTABLE), and pass them to qtest from the # `_build` directory. -DONTTEST=src/batteries_compattest.mlv \ +DONTTEST=src/batteriesHelp.ml \ + src/batteries_compattest.mlv \ src/batConcreteQueue_402.ml src/batConcreteQueue_403.ml TESTABLE ?= $(filter-out $(DONTTEST),\ $(wildcard src/*.ml) $(wildcard src/*.mlv)) diff --git a/_tags b/_tags index 75c83ea9c..2e8fc763f 100644 --- a/_tags +++ b/_tags @@ -3,7 +3,7 @@ true: package(bytes), warn_-3, bin_annot "build": include "src": include -"toplevel": include +"libs": include "testsuite": include "qtest": include "benchsuite": include diff --git a/opam b/batteries.opam similarity index 82% rename from opam rename to batteries.opam index b9496b427..8bb450410 100644 --- a/opam +++ b/batteries.opam @@ -7,7 +7,7 @@ maintainer: [ "Thibault Suzanne " ] authors: "OCaml batteries-included team" -homepage: "http://batteries.forge.ocamlcore.org/" +homepage: "https://github.com/ocaml-batteries-team/batteries-included" 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-or-later with OCaml-LGPL-linking-exception" @@ -23,9 +23,6 @@ depends: [ "ocamlbuild" {build} "qtest" {with-test & >= "2.5"} "qcheck" {with-test & >= "0.6" & < "0.14"} + "benchmark" {with-test & >= "1.6"} "num" ] -#url { -# src: "https://github.com/ocaml-batteries-team/batteries-included/releases/download/vXXX/batteries-XXX.tar.gz" -# checksum: "md5=XXX" -#} diff --git a/toplevel/battop.ml b/battop.ml similarity index 100% rename from toplevel/battop.ml rename to battop.ml diff --git a/toplevel/ocamlinit b/ocamlinit similarity index 100% rename from toplevel/ocamlinit rename to ocamlinit diff --git a/src/_tags b/src/_tags index 87ca72c37..eef38e006 100644 --- a/src/_tags +++ b/src/_tags @@ -4,6 +4,7 @@ true: warn_error(-50) : threads <{batMap,batVect,batFile,batPervasives,batParserCo,batSet,batLogger,batPathGen,batSplay}.ml>: warn_z <{batPervasives,batIMap,batLog}.ml>: warn_-9 +: compiler-libs : inline(3) # necessary to inline ofs_of_layout on V<4.2 diff --git a/src/batBig_int.mlv b/src/batBig_int.mlv index f79742cf2..3246e0997 100644 --- a/src/batBig_int.mlv +++ b/src/batBig_int.mlv @@ -109,7 +109,7 @@ let to_string_in_hexa = to_string_in_base 16 open BatNumber -module BaseBig_int = struct +module BaseBig_int : NUMERIC_BASE with type t = Big_int.big_int = struct open Big_int type t = big_int @@ -133,8 +133,6 @@ module BaseBig_int = struct let of_int = big_int_of_int let compare = compare_big_int - let ord = BatOrd.ord compare - let equal a b = compare a b = 0 let of_float f = try of_string (Printf.sprintf "%.0f" f) diff --git a/src/batBool.ml b/src/batBool.ml index 382e60214..9f588cea6 100644 --- a/src/batBool.ml +++ b/src/batBool.ml @@ -55,10 +55,6 @@ module BaseBool : BatNumber.NUMERIC_BASE with type t = bool = struct let compare = compare - let equal = (=) - - let ord = BatOrd.ord compare - let of_int = function | 0 -> false | _ -> true diff --git a/src/batBool.mli b/src/batBool.mli index d00ccf003..1290169a4 100644 --- a/src/batBool.mli +++ b/src/batBool.mli @@ -91,6 +91,8 @@ val ( -- ): t -> t -> t BatEnum.t val ( --- ): t -> t -> t BatEnum.t val operations : t BatNumber.numeric +include BatNumber.Bounded + (** {6 Submodules grouping all infix operators} *) module Infix : BatNumber.Infix with type bat__infix_t = t diff --git a/src/batBytes.mliv b/src/batBytes.mliv index a5ebb8f9d..3bc8d41a2 100644 --- a/src/batBytes.mliv +++ b/src/batBytes.mliv @@ -662,9 +662,9 @@ let s = Bytes.of_string "hello" ##V>=4.4##external unsafe_set : t -> int -> char -> unit = "%bytes_unsafe_set" ##V<4.4##external unsafe_blit : t -> int -> t -> int -> int -> unit = "caml_blit_string" "noalloc" -##V>=4.4##external unsafe_blit : t -> int -> t -> int -> int -> unit = "caml_blit_bytes" "noalloc" +##V>=4.4##external unsafe_blit : t -> int -> t -> int -> int -> unit = "caml_blit_bytes" [@@noalloc] ##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.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" +##V>=4.09##external unsafe_blit_string : string -> int -> bytes -> int -> int -> unit = "caml_blit_string" [@@noalloc] diff --git a/src/batBytes.mlv b/src/batBytes.mlv index 901a79111..062dd694b 100644 --- a/src/batBytes.mlv +++ b/src/batBytes.mlv @@ -5,8 +5,8 @@ include Bytes *) (*$T mapi - mapi (fun _ -> Char.uppercase) (of_string "Five") |> to_string = "FIVE" - mapi (fun _ -> Char.uppercase) (of_string "") |> to_string = "" + mapi (fun _ -> Char.uppercase_ascii) (of_string "Five") |> to_string = "FIVE" + mapi (fun _ -> Char.uppercase_ascii) (of_string "") |> to_string = "" mapi (fun _ -> String.of_char %> failwith) (of_string "") |> to_string = "" mapi (fun i _c -> "0123456789".[9-i]) (of_string "0123456789") |> to_string = "9876543210" ignore (let last = ref (-1) in mapi (fun i _c -> assert (i > !last); last := i; '0') (of_string "012345")); true @@ -32,8 +32,8 @@ include Bytes ##V<4.0## sc (*$T map - "Five" |> of_string |> map Char.uppercase |> to_string |> (=) "FIVE" - "" |> of_string |> map Char.uppercase |> to_string |> (=) "" + "Five" |> of_string |> map Char.uppercase_ascii |> to_string |> (=) "FIVE" + "" |> of_string |> map Char.uppercase_ascii |> to_string |> (=) "" "" |> of_string |> map (String.of_char %> failwith) |> to_string |> (=) "" *) diff --git a/src/batConcreteQueue_403.ml b/src/batConcreteQueue_403.ml index 479297b9b..6fb06b096 100644 --- a/src/batConcreteQueue_403.ml +++ b/src/batConcreteQueue_403.ml @@ -1,6 +1,10 @@ type 'a cell = | Nil | Cons of { content: 'a; mutable next: 'a cell } +[@@warning "-37"] +(* Disable warning 37 (Unused constructor): + Cons is never used to build values, + but it is used implicitly in [of_abstr] *) type 'a t = { mutable length: int; diff --git a/src/batEnum.ml b/src/batEnum.ml index 7d07415ce..1240e9df2 100644 --- a/src/batEnum.ml +++ b/src/batEnum.ml @@ -1597,47 +1597,3 @@ end let id l = Monad.bind l Monad.return in \ List.enum l |> id |> List.of_enum = l) *) - -module Incubator = struct - open BatOrd - - let int_eq (x:int) y = x = y - let int_ord (x:int) y = - if x > y then Gt - else if y > x then Lt - else Eq - - let eq_elements eq_elt a1 a2 = for_all2 eq_elt a1 a2 - - let rec ord_elements ord_elt t u = - match (get t, get u) with - | (None, None) -> Eq - | (None, _) -> Lt - | (_, None) -> Gt - | (Some x, Some y) -> match ord_elt x y with - | Eq -> ord_elements ord_elt t u - | (Gt|Lt) as n -> n - - let eq eq_elt t1 t2 = - bin_eq - int_eq (count t1) (count t2) - (eq_elements eq_elt) t1 t2 - - let ord ord_elt t1 t2 = - bin_ord - int_ord (count t1) (count t2) - (ord_elements ord_elt) t1 t2 - - module Eq (T : Eq) = struct - type 'a enum = 'a t - type t = T.t enum - let eq = eq T.eq - end - - module Ord (T : Ord) = struct - type 'a enum = 'a t - type t = T.t enum - let ord = ord T.ord - end - -end diff --git a/src/batFloat.mli b/src/batFloat.mli index 86de13f93..0fdfd4304 100644 --- a/src/batFloat.mli +++ b/src/batFloat.mli @@ -348,7 +348,9 @@ end module Compare : BatNumber.Compare with type bat__compare_t = t -include (BatNumber.RefOps with type bat__refops_t = t) +include BatNumber.RefOps with type bat__refops_t = t + +include BatNumber.Bounded with type bounded = t (** {6 Boilerplate code}*) @@ -447,6 +449,8 @@ sig *) val operations : t BatNumber.numeric + include BatNumber.Bounded with type bounded = t + (** {6 Operations specific to floating-point numbers} *) diff --git a/src/batInt32.mliv b/src/batInt32.mliv index 5b59b14ac..e0541dd40 100644 --- a/src/batInt32.mliv +++ b/src/batInt32.mliv @@ -305,6 +305,8 @@ val operations : t BatNumber.numeric module Infix : BatNumber.Infix with type bat__infix_t = t module Compare : BatNumber.Compare with type bat__compare_t = t +include BatNumber.Bounded with type bounded = t + (** {6 Boilerplate code}*) diff --git a/src/batLazyList.ml b/src/batLazyList.ml index 5ae4fb583..a9a8f0fb4 100644 --- a/src/batLazyList.ml +++ b/src/batLazyList.ml @@ -319,9 +319,8 @@ let concat lol = ignore (concat (lazy (Cons ((let () = failwith "foo" in nil), nil)))); true *) -(** - {6 Conversions} -*) +(** {6 Conversions} *) + (** Eager conversion to list. *) diff --git a/src/batMap.ml b/src/batMap.ml index 43e9e7362..898a3c6ed 100644 --- a/src/batMap.ml +++ b/src/batMap.ml @@ -1046,8 +1046,6 @@ struct external t_of_impl: 'a implementation -> 'a t = "%identity" external impl_of_t: 'a t -> 'a implementation = "%identity" - type 'a iter = E | C of key * 'a * 'a implementation * 'a iter - let cardinal t = Concrete.cardinal (impl_of_t t) let enum t = Concrete.enum (impl_of_t t) let backwards t = Concrete.backwards (impl_of_t t) @@ -1482,7 +1480,7 @@ let merge f m1 m2 = Concrete.merge f Pervasives.compare m1 m2 let bindings = Concrete.bindings let compare cmp_val m1 m2 = - Concrete.compare Pervasives.compare Pervasives.compare m1 m2 + Concrete.compare Pervasives.compare cmp_val m1 m2 let equal eq_val m1 m2 = Concrete.equal Pervasives.compare eq_val m1 m2 diff --git a/src/batNativeint.mliv b/src/batNativeint.mliv index 2a29bbb23..ec22879c4 100644 --- a/src/batNativeint.mliv +++ b/src/batNativeint.mliv @@ -269,6 +269,8 @@ val ( ** ) : t -> t -> t *) val operations : t BatNumber.numeric +include BatNumber.Bounded with type bounded = t + (** {6 Submodules grouping all infix operators} *) module Infix : BatNumber.Infix with type bat__infix_t = t diff --git a/src/batText.ml b/src/batText.ml index 9fdd9600a..99782b889 100644 --- a/src/batText.ml +++ b/src/batText.ml @@ -260,8 +260,6 @@ module Iter = struct let copy i = {i with idx=i.idx; } - type t = iterator option - (* Initial iterator state: *) let make rope = { leaf = UTF8.empty; idx = UTF8.ByteIndex.first; diff --git a/toplevel/batteriesHelp.ml b/src/batteriesHelp.ml similarity index 99% rename from toplevel/batteriesHelp.ml rename to src/batteriesHelp.ml index 2591888f6..0ddd6dcfc 100644 --- a/toplevel/batteriesHelp.ml +++ b/src/batteriesHelp.ml @@ -231,6 +231,9 @@ let result_of_completions table singular subject (l:completion list) = inconsistency singular subject; (*Report internal inconsistency*) None) l +(**A deconstructor for [completion].*) +let get_qualified {qualified = q; _} = q + (** Look for a given subject inside one of the manuals diff --git a/toplevel/batteriesHelp.mli b/src/batteriesHelp.mli similarity index 100% rename from toplevel/batteriesHelp.mli rename to src/batteriesHelp.mli diff --git a/src/batteries_compattest.ml b/src/batteries_compattest.ml new file mode 100644 index 000000000..b6ef36e16 --- /dev/null +++ b/src/batteries_compattest.ml @@ -0,0 +1,134 @@ +open Batteries + +module Stdlib_verifications = struct + (* This module asserts that all the BatFoo modules are actually + extensions of stdlib modules, and that no functionality is lost. *) + module Array_t = (Array : module type of Legacy.Array) + module Buffer_t = + (Buffer: sig + include module type of Legacy.Buffer + val add_channel : t -> BatInnerIO.input -> int -> unit + val output_buffer : t -> string BatInnerIO.output + end) + module Bytes = (Bytes : module type of Legacy.Bytes) + module Char_t = (Char: module type of Legacy.Char) + module Complex_t = (Complex : module type of Legacy.Complex) + module Digest = + (Digest: sig + include module type of Legacy.Digest + val channel : BatIO.input -> int -> Digest.t + val output : 'a BatIO.output -> t -> unit + val input : BatIO.input -> Digest.t + end) + (* module Format = (Format: module type of Legacy.Format)*) + module Gc = + (Gc: sig + include module type of Legacy.Gc + val print_stat : 'a BatInnerIO.output -> unit + end) + module Genlex = (Genlex : module type of Legacy.Genlex) + (* module Hashtbl = (Hashtbl: module type of Legacy.Hashtbl)*) + module Int32 = (Int32: module type of Legacy.Int32) + module Int64 = (Int64: module type of Legacy.Int64) + module Lexing = + (Lexing: sig + include module type of Legacy.Lexing + val from_channel : BatIO.input -> Lexing.lexbuf + end) + module List = + (List: sig + include module type of Legacy.List + val find_map : ('a -> 'b option) -> 'a list -> 'b + end) + module Seq = (Seq : module type of Legacy.Seq) + module Marshal = + (Marshal: sig + include module type of Legacy.Marshal + val to_channel : _ BatIO.output -> 'b -> extern_flags list -> unit + val from_channel : BatIO.input -> 'a + end) + module Nativeint = (Nativeint: module type of Legacy.Nativeint) + module Oo = (Oo : module type of Legacy.Oo) + module Printexc = + (Printexc: sig + include module type of Legacy.Printexc + val print : 'a BatInnerIO.output -> exn -> unit + val print_backtrace : 'a BatInnerIO.output -> unit + end) + (* module Printf = (Printf: module type of Legacy.Printf)*) + module Queue = (Queue: module type of Legacy.Queue) + module Random = (Random: module type of Legacy.Random) + module Result = (Result: module type of Legacy.Result) + (* module Scanf = (Scanf : module type of Legacy.Scanf)*) + (* FAILS BECAUSE OF Stack.Empty not being present because + module Stack = (Stack : module type of Legacy.Stack) + *) + module Stream = (Stream : module type of Legacy.Stream) + module String = (String : module type of Legacy.String) + module Sys = (Sys : module type of Legacy.Sys) + module Unix = + (Unix: sig + include module type of Legacy.Unix + val in_channel_of_descr : Unix.file_descr -> BatInnerIO.input + val out_channel_of_descr : Unix.file_descr -> unit BatInnerIO.output + val descr_of_in_channel : BatInnerIO.input -> Unix.file_descr + val descr_of_out_channel : unit BatInnerIO.output -> Unix.file_descr + val open_process_in : + ?autoclose:bool -> ?cleanup:bool -> string -> BatInnerIO.input + val open_process_out : + ?cleanup:bool -> string -> unit BatInnerIO.output + val open_process : + ?autoclose:bool -> + ?cleanup:bool -> + string -> BatInnerIO.input * unit BatInnerIO.output + val open_process_full : + ?autoclose:bool -> + ?cleanup:bool -> + string -> + string array -> + BatInnerIO.input * unit BatInnerIO.output * BatInnerIO.input + val close_process_in : BatInnerIO.input -> Unix.process_status + val close_process_out : + unit BatInnerIO.output -> Unix.process_status + val close_process : + BatInnerIO.input * unit BatInnerIO.output -> Unix.process_status + val close_process_full : + BatInnerIO.input * unit BatInnerIO.output * BatInnerIO.input -> + Unix.process_status + val open_connection : + ?autoclose:bool -> + Unix.sockaddr -> BatInnerIO.input * unit BatInnerIO.output + val shutdown_connection : BatInnerIO.input -> unit + val establish_server : + ?autoclose:bool -> + ?cleanup:bool -> + (BatInnerIO.input -> unit BatInnerIO.output -> unit) -> + Unix.sockaddr -> unit + end) + module Big_int = (Big_int : module type of Legacy.Big_int) + (* FIXME: This does not pass for some reason: + module Bigarray = (Bigarray : module type of Legacy.Bigarray)*) + + (* test compatibility of BatMap.S with Legacy.Map.S *) + let sort_map (type s) (module Map : Legacy.Map.S with type key = s) l = + Map.bindings (List.fold_right (fun x m -> Map.add x x m) l Map.empty) + module IntMap = struct + include BatMap.Int + let update = update_stdlib + end + let _ = assert ([1,1;2,2;3,3;] = (sort_map (module IntMap) [3; 1; 2;])) + (* test compat of BatSplay.S with Legacy.Map.S *) + module IntSplayMap = struct + include BatSplay.Map (BatInt) + let update = update_stdlib + end + let _ = assert ([1,1;2,2;3,3;] = (sort_map (module IntSplayMap) [3; 1; 2;])) + + (* test compatibility of BatSet.S with Legacy.Set.S *) + let sort (type s) (module Set : Legacy.Set.S with type elt = s) l = + Set.elements (List.fold_right Set.add l Set.empty) + module IntSet = struct + include BatSet.Int + end + let _ = assert ([1;2;3] = (sort (module IntSet) [3; 1; 2;])) +end diff --git a/testsuite/test_container.ml b/testsuite/test_container.ml index 48669a0c6..a9eec5ff7 100644 --- a/testsuite/test_container.ml +++ b/testsuite/test_container.ml @@ -116,8 +116,6 @@ module ArrayContainer : Container = struct let hd = ni1 let snoc = ni1 let cons = ni1 - let take = head - let drop = tail let tail = ni1 let init = ni1 and find_right = ni2 diff --git a/testsuite/test_map.ml b/testsuite/test_map.ml index c8dc2739e..8cfce4da7 100644 --- a/testsuite/test_map.ml +++ b/testsuite/test_map.ml @@ -121,7 +121,6 @@ module TestMap val enum : 'a m -> (key * 'a) BatEnum.t val backwards : 'a m -> (key * 'a) BatEnum.t val of_enum : (key * 'a) BatEnum.t -> 'a m - val bindings : 'a m -> (key * 'a) list val for_all : (key -> 'a -> bool) -> 'a m -> bool val exists : (key -> 'a -> bool) -> 'a m -> bool diff --git a/testsuite/test_substring.ml b/testsuite/test_substring.ml index 955213a0f..acb197d9a 100644 --- a/testsuite/test_substring.ml +++ b/testsuite/test_substring.ml @@ -173,8 +173,8 @@ let test_is_prefix = ];; let test_enum = + let test_enum ss = ss |> to_string |> BatString.enum in let ss = of_string "testing" in - let test_enum substring = ss |> to_string |> BatString.enum in [ begin "enum" >:: fun () -> assert_equal (ss |> enum |> BatString.of_enum) "testing"; diff --git a/toplevel/_tags b/toplevel/_tags deleted file mode 100644 index c758d7e51..000000000 --- a/toplevel/_tags +++ /dev/null @@ -1 +0,0 @@ -: compiler-libs