From 65fc9204270bc84381413303c3d7d1b152a7c1f1 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 19 Aug 2024 12:17:58 -0400 Subject: [PATCH 01/10] feat pp: add a bunch of extensions thanks to @grayswandyr --- src/pp/containers_pp.ml | 55 +++++++++++++++++++++++++++++++++++ src/pp/containers_pp.mli | 62 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 117 insertions(+) diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml index 6724a5111..621b7ecf7 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 780f38a0f..be6344194 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 NEXT_RELEASE *) + + val of_array : ?sep:t -> ('a -> t) -> 'a array -> t + (** @since NEXT_RELEASE *) + + val parens : t -> t + (** @since NEXT_RELEASE *) + + val braces : t -> t + (** @since NEXT_RELEASE *) + + val brackets : t -> t + (** Adds '[' ']' around the term + @since NEXT_RELEASE *) + + val angles : t -> t + (** Adds '<' '>' around the term + @since NEXT_RELEASE *) 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 NEXT_RELEASE *) +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 NEXT_RELEASE *) From df0e442956864a44b14732a57f1ed712b2850bb4 Mon Sep 17 00:00:00 2001 From: Ben Bellick Date: Sat, 24 Aug 2024 10:26:01 -0500 Subject: [PATCH 02/10] predicate combinators: and_p and or_p --- src/core/CCFun.ml | 4 ++++ src/core/CCFun.mli | 10 ++++++++++ 2 files changed, 14 insertions(+) diff --git a/src/core/CCFun.ml b/src/core/CCFun.ml index 65c9a5d59..8a3e5375d 100644 --- a/src/core/CCFun.ml +++ b/src/core/CCFun.ml @@ -8,6 +8,10 @@ include Sys include Stdlib include Fun + +let[@inline] and_p f g x = (f x) && (g x) +let[@inline] or_p 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 fa69904f8..913f28e0b 100644 --- a/src/core/CCFun.mli +++ b/src/core/CCFun.mli @@ -5,6 +5,16 @@ include module type of Fun (** @inline *) +val and_p : ('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. +*) + +val or_p : ('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. +*) + val compose : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c (** [compose f g x] is [g (f x)]. Composition. *) From 1dc046c6e9313f21ba96c9fc3d80db0ac978fd2b Mon Sep 17 00:00:00 2001 From: Ben Bellick Date: Sat, 24 Aug 2024 10:53:59 -0500 Subject: [PATCH 03/10] fix formatting --- src/core/CCFun.ml | 6 ++---- src/core/CCFun.mli | 4 ++-- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/src/core/CCFun.ml b/src/core/CCFun.ml index 8a3e5375d..f36af982c 100644 --- a/src/core/CCFun.ml +++ b/src/core/CCFun.ml @@ -8,10 +8,8 @@ include Sys include Stdlib include Fun - -let[@inline] and_p f g x = (f x) && (g x) -let[@inline] or_p f g x = (f x) || (g x) - +let[@inline] and_p f g x = f x && g x +let[@inline] or_p 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 913f28e0b..c4f6d49be 100644 --- a/src/core/CCFun.mli +++ b/src/core/CCFun.mli @@ -9,12 +9,12 @@ val and_p : ('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. *) - + val or_p : ('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. *) - + val compose : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c (** [compose f g x] is [g (f x)]. Composition. *) From c6cb57223035a90f86be065f29c8713c40207f05 Mon Sep 17 00:00:00 2001 From: Benjamin Bellick Date: Tue, 3 Sep 2024 11:59:43 -0500 Subject: [PATCH 04/10] and_p -> and_pred, or_p -> or_pred --- src/core/CCFun.ml | 5 +++-- src/core/CCFun.mli | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/core/CCFun.ml b/src/core/CCFun.ml index f36af982c..1718aa7f1 100644 --- a/src/core/CCFun.ml +++ b/src/core/CCFun.ml @@ -8,10 +8,11 @@ include Sys include Stdlib include Fun -let[@inline] and_p f g x = f x && g x -let[@inline] or_p f g x = f x || g x +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) let[@inline] uncurry f (x, y) = f x y diff --git a/src/core/CCFun.mli b/src/core/CCFun.mli index c4f6d49be..1c20937b5 100644 --- a/src/core/CCFun.mli +++ b/src/core/CCFun.mli @@ -5,12 +5,12 @@ include module type of Fun (** @inline *) -val and_p : ('a -> bool) -> ('a -> bool) -> 'a -> bool +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. *) -val or_p : ('a -> bool) -> ('a -> bool) -> 'a -> bool +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. *) From 07cfdb0d9401161953396e994e7251273446d13b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 3 Sep 2024 13:11:57 -0400 Subject: [PATCH 05/10] format --- src/core/CCFun.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/src/core/CCFun.ml b/src/core/CCFun.ml index 1718aa7f1..abb2a6a26 100644 --- a/src/core/CCFun.ml +++ b/src/core/CCFun.ml @@ -12,7 +12,6 @@ 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) let[@inline] uncurry f (x, y) = f x y From 9f8c2efe6442a740719653ffa96f38841a4c2284 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 3 Sep 2024 13:12:12 -0400 Subject: [PATCH 06/10] add missing @since tags --- src/core/CCFun.mli | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/core/CCFun.mli b/src/core/CCFun.mli index 1c20937b5..58c4aacce 100644 --- a/src/core/CCFun.mli +++ b/src/core/CCFun.mli @@ -8,11 +8,13 @@ include module type of Fun 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 NEXT_RELEASE *) 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 NEXT_RELEASE *) val compose : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c From 6ab811f79b82eb691dc09955a96c7b8d3d9e8141 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 10 Sep 2024 08:47:46 -0400 Subject: [PATCH 07/10] prepare for 3.14 --- CHANGELOG.md | 15 +++++++++++++++ containers-data.opam | 2 +- containers.opam | 2 +- dune-project | 2 +- src/core/CCByte_buffer.mli | 6 +++--- src/core/CCByte_slice.mli | 2 +- src/core/CCFun.mli | 8 ++++---- src/core/CCList.mli | 2 +- src/core/CCListLabels.mli | 2 +- src/core/CCOption.mli | 10 +++++----- src/core/CCResult.mli | 10 +++++----- src/core/CCVector.mli | 2 +- src/pp/containers_pp.mli | 16 ++++++++-------- src/pvec/containers_pvec.mli | 2 +- 14 files changed, 48 insertions(+), 33 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e36a8e51b..d4c8e84d1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,20 @@ # Changelog +## 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/containers-data.opam b/containers-data.opam index a0eae5c8d..12b4d9a70 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 2d9830aa0..de0ad37ea 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 3f1268da8..40eeadf3e 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 1bdab2b5a..a67f277cd 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 7b867417f..78d3f2a80 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.mli b/src/core/CCFun.mli index 58c4aacce..882611012 100644 --- a/src/core/CCFun.mli +++ b/src/core/CCFun.mli @@ -8,13 +8,13 @@ include module type of Fun 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 NEXT_RELEASE + @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 NEXT_RELEASE + @since 3.13.1 *) val compose : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c @@ -96,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 4f54dbb3b..b9507f77c 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 48e3072d2..952d028c9 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 e4915fd1f..6ee5a6ee8 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 bcd94d96c..5347b3fd6 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.mli b/src/core/CCVector.mli index c8fddf6e8..a874e5c19 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.mli b/src/pp/containers_pp.mli index be6344194..7006fbaff 100644 --- a/src/pp/containers_pp.mli +++ b/src/pp/containers_pp.mli @@ -260,24 +260,24 @@ module Dump : sig val list : t list -> t val of_iter : ?sep:t -> ('a -> t) -> 'a iter -> t - (** @since NEXT_RELEASE *) + (** @since 3.13.1 *) val of_array : ?sep:t -> ('a -> t) -> 'a array -> t - (** @since NEXT_RELEASE *) + (** @since 3.13.1 *) val parens : t -> t - (** @since NEXT_RELEASE *) + (** @since 3.13.1 *) val braces : t -> t - (** @since NEXT_RELEASE *) + (** @since 3.13.1 *) val brackets : t -> t (** Adds '[' ']' around the term - @since NEXT_RELEASE *) + @since 3.13.1 *) val angles : t -> t (** Adds '<' '>' around the term - @since NEXT_RELEASE *) + @since 3.13.1 *) end (** Simple colors in terminals *) @@ -305,7 +305,7 @@ module Term_color : sig val style_l : style list -> t -> t end -(** @since NEXT_RELEASE *) +(** @since 3.13.1 *) module Char : sig val bang : t val at : t @@ -343,4 +343,4 @@ end val surround : ?width:int -> t -> t -> t -> t (** Generalization of {!bracket} - @since NEXT_RELEASE *) + @since 3.13.1 *) diff --git a/src/pvec/containers_pvec.mli b/src/pvec/containers_pvec.mli index 68773a2d5..2112a4d03 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 From c959e396b31450196eb72d1258ea392ea6b6cfbe Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 17 Sep 2024 12:51:07 -0400 Subject: [PATCH 08/10] fix #454: work around a weird miscompilation --- src/core/CCVector.ml | 6 ++++-- tests/core/t_vector.ml | 16 +++++++++++++++- 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 6a560df06..4777205d8 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/tests/core/t_vector.ml b/tests/core/t_vector.ml index a3f6236c5..5abe32923 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 ];; @@ -751,3 +753,15 @@ push v 0; push v 0; push v 0; 6 = foldi (fun i acc _ -> acc + i) 0 v +;; + +t ~name:"reg454" @@ fun () -> +let arr : Int32.t vector = create () in +CCVector.push arr (Int32.of_int 123456); +let s = spf "%d\n" (Int32.to_int (CCVector.get arr 0)) in +Printf.eprintf "%d\n" (Int32.to_int (CCVector.get arr 0)); +let x = CCVector.get arr 0 in +let s2 = spf "%d\n" (Int32.to_int x) in +Printf.eprintf "%d\n" (Int32.to_int x); +assert_equal ~printer:(spf "%S") s s2; +true From 69f0e9b624dad06666ae8e3d273087d99f71be74 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 17 Sep 2024 14:04:09 -0400 Subject: [PATCH 09/10] test: better regression test for #454 --- Makefile | 3 ++- tests/core/reg/dune | 5 +++++ tests/core/reg/t_reg454.expected | 0 tests/core/reg/t_reg454.ml | 8 ++++++++ tests/core/t_vector.ml | 12 ------------ 5 files changed, 15 insertions(+), 13 deletions(-) create mode 100644 tests/core/reg/dune create mode 100644 tests/core/reg/t_reg454.expected create mode 100644 tests/core/reg/t_reg454.ml diff --git a/Makefile b/Makefile index 3c14d7563..f6190bbdd 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/tests/core/reg/dune b/tests/core/reg/dune new file mode 100644 index 000000000..985274b0e --- /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 000000000..e69de29bb diff --git a/tests/core/reg/t_reg454.ml b/tests/core/reg/t_reg454.ml new file mode 100644 index 000000000..a8040580c --- /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 5abe32923..121a7df75 100644 --- a/tests/core/t_vector.ml +++ b/tests/core/t_vector.ml @@ -753,15 +753,3 @@ push v 0; push v 0; push v 0; 6 = foldi (fun i acc _ -> acc + i) 0 v -;; - -t ~name:"reg454" @@ fun () -> -let arr : Int32.t vector = create () in -CCVector.push arr (Int32.of_int 123456); -let s = spf "%d\n" (Int32.to_int (CCVector.get arr 0)) in -Printf.eprintf "%d\n" (Int32.to_int (CCVector.get arr 0)); -let x = CCVector.get arr 0 in -let s2 = spf "%d\n" (Int32.to_int x) in -Printf.eprintf "%d\n" (Int32.to_int x); -assert_equal ~printer:(spf "%S") s s2; -true From 3efaa02d9dec1fc25ad2687c105f81e1504dc873 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 17 Sep 2024 14:50:42 -0400 Subject: [PATCH 10/10] update test output --- tests/core/reg/t_reg454.expected | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/core/reg/t_reg454.expected b/tests/core/reg/t_reg454.expected index e69de29bb..ae66ec1ac 100644 --- a/tests/core/reg/t_reg454.expected +++ b/tests/core/reg/t_reg454.expected @@ -0,0 +1,2 @@ +123456 +123456