diff --git a/CHANGELOG.md b/CHANGELOG.md index 8df6e836..a9a236e7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,21 @@ instead of O(n log n), and they ensure physical equality (for `delete_all` this is a bugfix) +## 3.14 + + +- predicate combinators: `and_pred` and `or_pred` +- feat `pp`: add a bunch of extensions +- Kleisli Composition Operator and Apply_or for option/result/fun (#455) +- add `CCByte_buffer.to_slice` +- add a byte slice type `CCByte_slice` +- add `cons_when` to `CCListLabels` +- add `(|||>)` and `||>` to `CCFun` +- `CCVector`: Add function foldi +- add `containers.pvec`, a persistent vector type. + +- perf: use a monomorphic impl for `CCMonomorphic.{min,max}` + ## 3.13.1 - list: TRMC was in 4.14, we can use it earlier diff --git a/Makefile b/Makefile index 3c14d756..f6190bbd 100644 --- a/Makefile +++ b/Makefile @@ -6,7 +6,8 @@ build: dune build @install -p $(PACKAGES) test: build - dune runtest --display=quiet --cache=disabled --no-buffer --force + # run tests in release mode to expose bug in #454 + dune runtest --display=quiet --cache=disabled --no-buffer --force --profile=release clean: dune clean diff --git a/containers-data.opam b/containers-data.opam index a0eae5c8..12b4d9a7 100644 --- a/containers-data.opam +++ b/containers-data.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "3.13.1" +version: "3.14" synopsis: "A set of advanced datatypes for containers" maintainer: ["c-cube"] authors: ["c-cube"] diff --git a/containers.opam b/containers.opam index 2d9830aa..de0ad37e 100644 --- a/containers.opam +++ b/containers.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "3.13.1" +version: "3.14" synopsis: "A modular, clean and powerful extension of the OCaml standard library" maintainer: ["c-cube"] diff --git a/dune-project b/dune-project index 3f1268da..40eeadf3 100644 --- a/dune-project +++ b/dune-project @@ -2,7 +2,7 @@ (name containers) (generate_opam_files true) -(version 3.13.1) +(version 3.14) (authors c-cube) (maintainers c-cube) (license BSD-2-Clause) diff --git a/src/core/CCByte_buffer.mli b/src/core/CCByte_buffer.mli index 1bdab2b5..a67f277c 100644 --- a/src/core/CCByte_buffer.mli +++ b/src/core/CCByte_buffer.mli @@ -13,7 +13,7 @@ type t = { is undefined garbage. *) } (** The byte buffer. - The definition is public since NEXT_RELEASE . *) + The definition is public since 3.13.1 . *) type 'a iter = ('a -> unit) -> unit @@ -89,7 +89,7 @@ val unsafe_set : t -> int -> char -> unit val to_slice : t -> CCByte_slice.t (** [to_slice buf] returns a slice of the current content. The slice shares the same byte array as [buf] (until [buf] is resized). - @since NEXT_RELEASE *) + @since 3.13.1 *) val contents : t -> string (** Copy the internal data to a string. Allocates. *) @@ -102,7 +102,7 @@ val iter : (char -> unit) -> t -> unit val iteri : (int -> char -> unit) -> t -> unit (** Iterate with index. - @since NEXT_RELEASE *) + @since 3.13.1 *) val fold_left : ('a -> char -> 'a) -> 'a -> t -> 'a val of_iter : char iter -> t diff --git a/src/core/CCByte_slice.mli b/src/core/CCByte_slice.mli index 7b867417..78d3f2a8 100644 --- a/src/core/CCByte_slice.mli +++ b/src/core/CCByte_slice.mli @@ -1,6 +1,6 @@ (** A simple byte slice. - @since NEXT_RELEASE *) + @since 3.13.1 *) type t = { bs: bytes; (** The bytes, potentially shared between many slices *) diff --git a/src/core/CCFun.ml b/src/core/CCFun.ml index 65c9a5d5..abb2a6a2 100644 --- a/src/core/CCFun.ml +++ b/src/core/CCFun.ml @@ -8,6 +8,8 @@ include Sys include Stdlib include Fun +let[@inline] and_pred f g x = f x && g x +let[@inline] or_pred f g x = f x || g x let[@inline] compose f g x = g (f x) let[@inline] compose_binop f g x y = g (f x) (f y) let[@inline] curry f x y = f (x, y) diff --git a/src/core/CCFun.mli b/src/core/CCFun.mli index fa69904f..88261101 100644 --- a/src/core/CCFun.mli +++ b/src/core/CCFun.mli @@ -5,6 +5,18 @@ include module type of Fun (** @inline *) +val and_pred : ('a -> bool) -> ('a -> bool) -> 'a -> bool +(** [and_p f g x] is [(f x) && (g x)]. + Produces a predicate which is a conjunction of the two predicates. + @since 3.13.1 +*) + +val or_pred : ('a -> bool) -> ('a -> bool) -> 'a -> bool +(** [or_p f g x] is [(f x) || (g x)]. + Produces a predicate which is a disjunction of the two predicates. + @since 3.13.1 +*) + val compose : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c (** [compose f g x] is [g (f x)]. Composition. *) @@ -84,11 +96,11 @@ module Infix : sig val ( ||> ) : 'a * 'b -> ('a -> 'b -> 'c) -> 'c (** [x ||> f] is [f (fst x) (snd x)] - @since NEXT_RELEASE *) + @since 3.13.1 *) val ( |||> ) : 'a * 'b * 'c -> ('a -> 'b -> 'c -> 'd) -> 'd (** like [||>] but for tuples of size 3 - @since NEXT_RELEASE *) + @since 3.13.1 *) end include module type of Infix diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 4f54dbb3..b9507f77 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -28,7 +28,7 @@ val cons_maybe : 'a option -> 'a t -> 'a t val cons_when : bool -> 'a -> 'a t -> 'a t (** [cons_when true x l] is [x :: l]. [cons_when false x l] is [l]. - @since NEXT_RELEASE *) + @since 3.13.1 *) val cons' : 'a t -> 'a -> 'a t (** [cons' l x] is the same as [x :: l]. This is convenient for fold diff --git a/src/core/CCListLabels.mli b/src/core/CCListLabels.mli index 48e3072d..952d028c 100644 --- a/src/core/CCListLabels.mli +++ b/src/core/CCListLabels.mli @@ -47,7 +47,7 @@ val cons_maybe : 'a option -> 'a t -> 'a t val cons_when : bool -> 'a -> 'a t -> 'a t (** [cons_when true x l] is [x :: l]. [cons_when false x l] is [l]. - @since NEXT_RELEASE *) + @since 3.13.1 *) val filter : f:('a -> bool) -> 'a t -> 'a t (** [filter ~f l] returns all the elements of the list [l] diff --git a/src/core/CCOption.mli b/src/core/CCOption.mli index e4915fd1..6ee5a6ee 100644 --- a/src/core/CCOption.mli +++ b/src/core/CCOption.mli @@ -60,7 +60,7 @@ val bind : 'a t -> ('a -> 'b t) -> 'b t val k_compose : ('a -> 'b t) -> ('b -> 'c t) -> 'a -> 'c t (** Kleisli composition. Monadic equivalent of {!CCFun.compose} - @since NEXT_RELEASE *) + @since 3.13.1 *) val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t (** [map2 f o1 o2] maps ['a option] and ['b option] to a ['c option] using [f]. *) @@ -100,7 +100,7 @@ val apply_or : ('a -> 'a t) -> 'a -> 'a (** [apply_or f x] returns the original [x] if [f] fails, or unwraps [f x] if it succeeds. Useful for piping preprocessing functions together (such as string processing), turning functions like "remove" into "remove_if_it_exists". - @since NEXT_RELEASE *) + @since 3.13.1 *) val value : 'a t -> default:'a -> 'a (** [value o ~default] is similar to the Stdlib's [Option.value] and to {!get_or}. @@ -187,7 +187,7 @@ module Infix : sig val ( |?> ) : 'a -> ('a -> 'a t) -> 'a (** [x |?> f] is [apply_or f x] - @since NEXT_RELEASE *) + @since 3.13.1 *) val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t @@ -196,11 +196,11 @@ module Infix : sig val ( >=> ) : ('a -> 'b t) -> ('b -> 'c t) -> 'a -> 'c t (** Monadic [k_compose]. - @since NEXT_RELEASE *) + @since 3.13.1 *) val ( <=< ) : ('b -> 'c t) -> ('a -> 'b t) -> 'a -> 'c t (** Reverse monadic [k_compose]. - @since NEXT_RELEASE *) + @since 3.13.1 *) end include module type of Infix diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli index bcd94d96..5347b3fd 100644 --- a/src/core/CCResult.mli +++ b/src/core/CCResult.mli @@ -100,7 +100,7 @@ val apply_or : ('a -> ('a, _) t) -> 'a -> 'a (** [apply_or f x] returns the original [x] if [f] fails, or unwraps [f x] if it succeeds. Useful for piping preprocessing functions together (such as string processing), turning functions like "remove" into "remove_if_it_exists". - @since NEXT_RELEASE *) + @since 3.13.1 *) val get_or_failwith : ('a, string) t -> 'a (** [get_or_failwith e] returns [x] if [e = Ok x], fails otherwise. @@ -123,7 +123,7 @@ val flat_map : ('a -> ('b, 'err) t) -> ('a, 'err) t -> ('b, 'err) t val k_compose : ('a -> ('b, 'err) t) -> ('b -> ('c, 'err) t) -> 'a -> ('c, 'err) t (** Kleisli composition. Monadic equivalent of {!CCFun.compose}. - @since NEXT_RELEASE *) + @since 3.13.1 *) val equal : err:'err equal -> 'a equal -> ('a, 'err) t equal val compare : err:'err ord -> 'a ord -> ('a, 'err) t ord @@ -202,7 +202,7 @@ module Infix : sig val ( |?> ) : 'a -> ('a -> ('a, _) t) -> 'a (** Alias for {!apply_or} - @since NEXT_RELEASE *) + @since 3.13.1 *) val ( let+ ) : ('a, 'e) t -> ('a -> 'b) -> ('b, 'e) t (** @since 2.8 *) @@ -219,12 +219,12 @@ module Infix : sig val ( >=> ) : ('a -> ('b, 'err) t) -> ('b -> ('c, 'err) t) -> 'a -> ('c, 'err) t (** Monadic [k_compose]. - @since NEXT_RELEASE *) + @since 3.13.1 *) val ( <=< ) : ('b -> ('c, 'err) t) -> ('a -> ('b, 'err) t) -> 'a -> ('c, 'err) t (** Reverse monadic [k_compose]. - @since NEXT_RELEASE *) + @since 3.13.1 *) end include module type of Infix diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 6a560df0..4777205d 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -176,7 +176,8 @@ let append a b = let[@inline] get v i = if i < 0 || i >= v.size then invalid_arg "CCVector.get"; - Array.unsafe_get v.vec i + (* NOTE: over eager inlining seems to miscompile for int32 at least (#454) *) + Sys.opaque_identity (Array.unsafe_get v.vec i) let[@inline] set v i x = if i < 0 || i >= v.size then invalid_arg "CCVector.set"; @@ -282,7 +283,8 @@ let[@inline] top v = let[@inline] top_exn v = if v.size = 0 then raise Empty; - Array.unsafe_get v.vec (v.size - 1) + (* NOTE: over eager inlining seems to miscompile for int32 at least (#454) *) + Sys.opaque_identity (Array.unsafe_get v.vec (v.size - 1)) let[@inline] copy v = { size = v.size; vec = Array.sub v.vec 0 v.size } diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index c8fddf6e..a874e5c1 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -209,7 +209,7 @@ val fold : ('b -> 'a -> 'b) -> 'b -> ('a, _) t -> 'b val foldi : (int -> 'b -> 'a -> 'b) -> 'b -> ('a, _) t -> 'b (** [foldi f init v] is just like {!fold}, but it also passes in the index of each element as the first argument to the function [f]. - @since NEXT_RELEASE *) + @since 3.13.1 *) val exists : ('a -> bool) -> ('a, _) t -> bool (** Existential test (is there an element that satisfies the predicate?). *) diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml index 6724a511..621b7ecf 100644 --- a/src/pp/containers_pp.ml +++ b/src/pp/containers_pp.ml @@ -1,6 +1,8 @@ module B = Buffer module Int_map = Map.Make (CCInt) +type 'a iter = ('a -> unit) -> unit + module Out = struct type t = { char: char -> unit; @@ -464,11 +466,64 @@ let bracket l d r : t = group (text l ^ nest (String.length l) d ^ text r) let bracket2 l d r : t = group (text l ^ nest 2 (nl ^ d) ^ nl ^ text r) let sexp_l l : t = char '(' ^ nest 1 (group (append_nl l ^ char ')')) let sexp_apply a l : t = sexp_l (text a :: l) +let surround ?(width = 1) l b r = group (l ^ nest width b ^ r) + +module Char = struct + let bang = char '!' + let at = char '@' + let hash = char '#' + let dollar = char '$' + let tilde = char '~' + let backquote = char '`' + let percent = char '%' + let caret = char '^' + let ampersand = char '&' + let star = char '*' + let minus = char '-' + let underscore = char '_' + let plus = char '+' + let equal = char '=' + let pipe = char '|' + let slash = char '/' + let backslash = char '\\' + let colon = char ':' + let semi = char ';' + let guillemet = char '"' + let quote = char '\'' + let comma = char ',' + let dot = char '.' + let question = char '?' + let lparen = char '(' + let rparen = char ')' + let lbrace = char '{' + let rbrace = char '}' + let lbracket = char '[' + let rbracket = char ']' + let langle = char '<' + let rangle = char '>' +end module Dump = struct let list l : t = let sep = char ';' ^ nl in group (char '[' ^ nest 1 (fill sep l) ^ char ']') + + let parens d = surround Char.lparen d Char.rparen + let braces d = surround Char.lbrace d Char.rbrace + let brackets d = surround Char.lbracket d Char.rbracket + let angles d = surround Char.langle d Char.rangle + + let of_iter ?(sep = nil) g it = + let r = ref nil in + it (fun elt -> r := !r ^ sep ^ g elt); + !r + + let of_array ?(sep = nil) g arr = + let r = ref nil in + for i = 0 to Array.length arr - 1 do + r := !r ^ sep ^ g arr.(i) + done; + !r end module Term_color = struct diff --git a/src/pp/containers_pp.mli b/src/pp/containers_pp.mli index 780f38a0..7006fbaf 100644 --- a/src/pp/containers_pp.mli +++ b/src/pp/containers_pp.mli @@ -32,6 +32,8 @@ (** {2 Core} *) +type 'a iter = ('a -> unit) -> unit + type t (** The type of documents *) @@ -256,6 +258,26 @@ val sexp_l : t list -> t (** Printers that correspond closely to OCaml's syntax. *) module Dump : sig val list : t list -> t + + val of_iter : ?sep:t -> ('a -> t) -> 'a iter -> t + (** @since 3.13.1 *) + + val of_array : ?sep:t -> ('a -> t) -> 'a array -> t + (** @since 3.13.1 *) + + val parens : t -> t + (** @since 3.13.1 *) + + val braces : t -> t + (** @since 3.13.1 *) + + val brackets : t -> t + (** Adds '[' ']' around the term + @since 3.13.1 *) + + val angles : t -> t + (** Adds '<' '>' around the term + @since 3.13.1 *) end (** Simple colors in terminals *) @@ -282,3 +304,43 @@ module Term_color : sig val color : color -> t -> t val style_l : style list -> t -> t end + +(** @since 3.13.1 *) +module Char : sig + val bang : t + val at : t + val hash : t + val dollar : t + val tilde : t + val backquote : t + val percent : t + val caret : t + val ampersand : t + val star : t + val minus : t + val underscore : t + val plus : t + val equal : t + val pipe : t + val slash : t + val backslash : t + val colon : t + val semi : t + val guillemet : t + val quote : t + val comma : t + val dot : t + val question : t + val lparen : t + val rparen : t + val lbrace : t + val rbrace : t + val lbracket : t + val rbracket : t + val langle : t + val rangle : t +end + +val surround : ?width:int -> t -> t -> t -> t +(** Generalization of {!bracket} + @since 3.13.1 *) diff --git a/src/pvec/containers_pvec.mli b/src/pvec/containers_pvec.mli index 68773a2d..2112a4d0 100644 --- a/src/pvec/containers_pvec.mli +++ b/src/pvec/containers_pvec.mli @@ -5,7 +5,7 @@ {b status: experimental} - @since NEXT_RELEASE + @since 3.13.1 *) type 'a iter = ('a -> unit) -> unit diff --git a/tests/core/reg/dune b/tests/core/reg/dune new file mode 100644 index 00000000..985274b0 --- /dev/null +++ b/tests/core/reg/dune @@ -0,0 +1,5 @@ + +(tests + (ocamlopt_flags :standard -inline 1000) + (names t_reg454) + (libraries containers)) diff --git a/tests/core/reg/t_reg454.expected b/tests/core/reg/t_reg454.expected new file mode 100644 index 00000000..ae66ec1a --- /dev/null +++ b/tests/core/reg/t_reg454.expected @@ -0,0 +1,2 @@ +123456 +123456 diff --git a/tests/core/reg/t_reg454.ml b/tests/core/reg/t_reg454.ml new file mode 100644 index 00000000..a8040580 --- /dev/null +++ b/tests/core/reg/t_reg454.ml @@ -0,0 +1,8 @@ +module Vec = CCVector + +let () = + let arr : Int32.t Vec.vector = Vec.create () in + Vec.push arr (Int32.of_int 123456); + Format.printf "%d\n" (Int32.to_int (Vec.get arr 0)); + let x = Vec.get arr 0 in + Format.printf "%d\n" (Int32.to_int x) diff --git a/tests/core/t_vector.ml b/tests/core/t_vector.ml index a3f6236c..121a7df7 100644 --- a/tests/core/t_vector.ml +++ b/tests/core/t_vector.ml @@ -1,6 +1,8 @@ module T = (val Containers_testlib.make ~__FILE__ ()) include T -open CCVector;; +open CCVector + +let spf = Printf.sprintf;; t @@ fun () -> create_with ~capacity:200 1 |> capacity >= 200;; t @@ fun () -> return 42 |> to_list = [ 42 ];;