Merge branch 'main' into linear-heap-building

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

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

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"]

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"]

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)

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

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 *)

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)

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

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

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]

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

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

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 }
 

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?). *)

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

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 *)

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

tests/core/reg/dune

@@ -0,0 +1,5 @@
+
+(tests
+ (ocamlopt_flags :standard -inline 1000)
+ (names t_reg454)
+ (libraries containers))

tests/core/reg/t_reg454.expected

@@ -0,0 +1,2 @@
+123456
+123456

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)

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 ];;