v0.18~preview.129.42+498

src/array.mli

@@ -2,10 +2,13 @@
 
 open! Import
 
-type 'a t = 'a array [@@deriving_inline compare ~localize, globalize, sexp, sexp_grammar]
+type 'a t = 'a array
+[@@deriving_inline compare ~localize, equal ~localize, globalize, sexp, sexp_grammar]
 
 include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t
 include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t
+include Ppx_compare_lib.Equal.S1 with type 'a t := 'a t
+include Ppx_compare_lib.Equal.S_local1 with type 'a t := 'a t
 
 val globalize : ('a -> 'a) -> 'a t -> 'a t
 
@@ -263,8 +266,6 @@ val sorted_copy : 'a t -> compare:('a -> 'a -> int) -> 'a t
 
 val last : 'a t -> 'a [@@deprecated "[since 2024-07] This was renamed to [last_exn]"]
 val last_exn : 'a t -> 'a
-val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
-val equal__local : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
 
 (** The input array is copied internally so that future modifications of it do not change
     the sequence. *)

src/base.ml

@@ -652,10 +652,12 @@ module Export = struct
   (* This is declared as an external to be optimized away in more contexts. *)
 
   (** Reverse application operator. [x |> g |> f] is equivalent to [f (g (x))]. *)
-  external ( |> ) : 'a -> (('a -> 'b)[@local_opt]) -> 'b = "%revapply"
+  external ( |> ) : 'a 'b. 'a -> (('a -> 'b)[@local_opt]) -> 'b = "%revapply"
+  [@@layout_poly]
 
   (** Application operator. [g @@ f @@ x] is equivalent to [g (f (x))]. *)
-  external ( @@ ) : (('a -> 'b)[@local_opt]) -> 'a -> 'b = "%apply"
+  external ( @@ ) : 'a 'b. (('a -> 'b)[@local_opt]) -> 'a -> 'b = "%apply"
+  [@@layout_poly]
 
   (** Boolean operations *)
 
@@ -665,7 +667,7 @@ module Export = struct
   external not : (bool[@local_opt]) -> bool = "%boolnot"
 
   (* This must be declared as an external for the warnings to work properly. *)
-  external ignore : (_[@local_opt]) -> unit = "%ignore"
+  external ignore : 'a. ('a[@local_opt]) -> unit = "%ignore" [@@layout_poly]
 
   (** Common string operations *)
   let ( ^ ) = String.( ^ )
@@ -712,5 +714,3 @@ exception Not_found_s = Not_found_s
    program refers to at least one value directly in [Base]; referring to values in
    [Base.Bool], for example, is not sufficient. *)
 let () = Backtrace.initialize_module ()
-
-module Caml = struct end [@@deprecated "[since 2023-01] use Stdlib instead of Caml"]

src/comparable.ml

@@ -69,11 +69,16 @@ end
 let gt cmp a b = cmp a b > 0
 let lt cmp a b = cmp a b < 0
 let geq cmp a b = cmp a b >= 0
+let geq_local cmp a b = cmp a b >= 0
 let leq cmp a b = cmp a b <= 0
+let leq_local cmp a b = cmp a b <= 0
 let equal cmp a b = cmp a b = 0
+let equal_local cmp a b = cmp a b = 0
 let not_equal cmp a b = cmp a b <> 0
 let min cmp t t' = Bool0.select (leq cmp t t') t t'
+let min_local cmp t t' = Bool0.select (leq_local cmp t t') t t'
 let max cmp t t' = Bool0.select (geq cmp t t') t t'
+let max_local cmp t t' = Bool0.select (geq_local cmp t t') t t'
 
 module Infix (T : sig
     type t [@@deriving_inline compare]
@@ -189,19 +194,46 @@ Make (struct
   end)
 
 (* compare [x] and [y] lexicographically using functions in the list [cmps] *)
-let lexicographic cmps x y =
-  let rec loop = function
-    | cmp :: cmps ->
-      let res = cmp x y in
-      if res = 0 then loop cmps else res
-    | [] -> 0
-  in
-  loop cmps
+let rec lexicographic_gen ~apply cmps x y =
+  match cmps with
+  | cmp :: cmps ->
+    let res = apply cmp x y in
+    if res = 0 then lexicographic_gen ~apply cmps x y else res
+  | [] -> 0
+;;
+
+let[@inline] lexicographic cmps x y =
+  let open Modes.Export in
+  lexicographic_gen
+    ~apply:(fun [@inline] cmp { global = x } { global = y } -> cmp x y)
+    cmps
+    { global = x }
+    { global = y }
+;;
+
+let[@inline] lexicographic_local cmps x y =
+  lexicographic_gen ~apply:(fun [@inline] cmp x y -> cmp x y) cmps x y
 ;;
 
 let lift cmp ~f x y = cmp (f x) (f y)
+let lift_local cmp ~f x y = cmp (f x) (f y) [@nontail]
 let reverse cmp x y = cmp y x
+let reverse_local cmp x y = cmp y x
 
 type 'a reversed = 'a
 
 let compare_reversed cmp x y = cmp y x
+let compare_reversed_local cmp x y = cmp y x
+
+module Local = struct
+  let lexicographic = lexicographic_local
+  let lift = lift_local
+  let reverse = reverse_local
+
+  type 'a reversed = 'a
+
+  let compare_reversed = compare_reversed_local
+  let equal = equal_local
+  let max = max_local
+  let min = min_local
+end

src/comparable_intf.ml

@@ -7,15 +7,17 @@ module type Comparisons_with_zero_alloc = Comparisons.S_with_zero_alloc
 
 module Sign = Sign0 (** @canonical Base.Sign *)
 
-module type With_compare = sig
-  (** Various combinators for [compare] and [equal] functions. *)
+module type With_compare_gen = sig
+  type ('a, 'b) compare_fn
+  type ('a, 'b) fn
+  type 'a select_fn
 
   (** [lexicographic cmps x y] compares [x] and [y] lexicographically using functions in the
       list [cmps]. *)
-  val lexicographic : ('a -> 'a -> int) list -> 'a -> 'a -> int
+  val lexicographic : ('a, int) compare_fn list -> ('a, int) compare_fn
 
   (** [lift cmp ~f x y] compares [x] and [y] by comparing [f x] and [f y] via [cmp]. *)
-  val lift : ('a -> 'a -> 'result) -> f:('b -> 'a) -> 'b -> 'b -> 'result
+  val lift : ('a, 'result) compare_fn -> f:('b, 'a) fn -> ('b, 'result) compare_fn
 
   (** [reverse cmp x y = cmp y x]
 
@@ -26,24 +28,40 @@ module type With_compare = sig
       [Comparable.S] provides [ascending] and [descending], which are more readable as a
       pair than [compare] and [reverse compare]. Similarly, [<=] is more idiomatic than
       [reverse (>=)]. *)
-  val reverse : ('a -> 'a -> 'result) -> 'a -> 'a -> 'result
+  val reverse : ('a, 'result) compare_fn -> ('a, 'result) compare_fn
 
   (** {!reversed} is the identity type but its associated compare function is the same as
       the {!reverse} function above. It allows you to get reversed comparisons with
       [ppx_compare], writing, for example, [[%compare: string Comparable.reversed]] to
       have strings ordered in the reverse order. *)
   type 'a reversed = 'a
 
-  val compare_reversed : ('a -> 'a -> int) -> 'a reversed -> 'a reversed -> int
+  val compare_reversed : ('a, int) compare_fn -> ('a reversed, int) compare_fn
 
   (** The functions below are analogues of the type-specific functions exported by the
       [Comparable.S] interface. *)
 
-  val equal : ('a -> 'a -> int) -> 'a -> 'a -> bool
-  val max : ('a -> 'a -> int) -> 'a -> 'a -> 'a
-  val min : ('a -> 'a -> int) -> 'a -> 'a -> 'a
+  val equal : ('a, int) compare_fn -> ('a, bool) compare_fn
+  val max : ('a, int) compare_fn -> 'a select_fn
+  val min : ('a, int) compare_fn -> 'a select_fn
 end
 
+(** Various combinators for [compare] and [equal] functions. *)
+module type With_compare =
+  With_compare_gen
+  with type ('a, 'b) compare_fn := 'a -> 'a -> 'b
+   and type ('a, 'b) fn := 'a -> 'b
+   and type 'a select_fn := 'a -> 'a -> 'a
+(** @inline *)
+
+(** Various combinators for [compare__local] and [equal__local] functions. *)
+module type With_compare_local =
+  With_compare_gen
+  with type ('a, 'b) compare_fn := 'a -> 'a -> 'b
+   and type ('a, 'b) fn := 'a -> 'b
+   and type 'a select_fn := 'a -> 'a -> 'a
+(** @inline *)
+
 module type With_zero = sig
   type t
 
@@ -149,9 +167,11 @@ module type Comparable = sig
   module type Comparisons = Comparisons
   module type Comparisons_with_zero_alloc = Comparisons_with_zero_alloc
   module type With_compare = With_compare
+  module type With_compare_local = With_compare_local
   module type With_zero = With_zero
 
   include With_compare
+  module Local : With_compare_local
 
   (** Derive [Infix] or [Comparisons] functions from just [[@@deriving compare]],
       without need for the [sexp_of_t] required by [Make*] (see below). *)

src/dune

@@ -17,7 +17,7 @@
  (foreign_stubs
   (language c)
   (names bytes_stubs exn_stubs float_stubs int_math_stubs hash_stubs
-    obj_stubs am_testing)
+    obj_stubs string_stubs am_testing)
   (flags
    :standard
    -D_LARGEFILE64_SOURCE

src/either.ml

@@ -44,7 +44,7 @@ let equal eq1 eq2 t1 t2 =
   | First _, Second _ | Second _, First _ -> false
 ;;
 
-let local_equal eq1 eq2 t1 t2 =
+let equal__local eq1 eq2 t1 t2 =
   match t1, t2 with
   | First x, First y -> eq1 x y
   | Second x, Second y -> eq2 x y

src/either_intf.ml

@@ -34,10 +34,12 @@ module type Either = sig
   type ('f, 's) t = ('f, 's) Either0.t =
     | First of 'f
     | Second of 's
-  [@@deriving_inline compare ~localize, hash, sexp, sexp_grammar]
+  [@@deriving_inline compare ~localize, equal ~localize, hash, sexp, sexp_grammar]
 
   include Ppx_compare_lib.Comparable.S2 with type ('f, 's) t := ('f, 's) t
   include Ppx_compare_lib.Comparable.S_local2 with type ('f, 's) t := ('f, 's) t
+  include Ppx_compare_lib.Equal.S2 with type ('f, 's) t := ('f, 's) t
+  include Ppx_compare_lib.Equal.S_local2 with type ('f, 's) t := ('f, 's) t
   include Ppx_hash_lib.Hashable.S2 with type ('f, 's) t := ('f, 's) t
   include Sexplib0.Sexpable.S2 with type ('f, 's) t := ('f, 's) t
 
@@ -55,14 +57,6 @@ module type Either = sig
   val iter : ('a, 'b) t -> first:('a -> unit) -> second:('b -> unit) -> unit
   val value_map : ('a, 'b) t -> first:('a -> 'c) -> second:('b -> 'c) -> 'c
   val map : ('a, 'b) t -> first:('a -> 'c) -> second:('b -> 'd) -> ('c, 'd) t
-  val equal : ('f -> 'f -> bool) -> ('s -> 's -> bool) -> ('f, 's) t -> ('f, 's) t -> bool
-
-  val local_equal
-    :  ('f -> 'f -> bool)
-    -> ('s -> 's -> bool)
-    -> ('f, 's) t
-    -> ('f, 's) t
-    -> bool
 
   module type Focused = Focused
 

src/float.mli

@@ -127,8 +127,8 @@ val to_int64 : t -> int64
     v}
 
     For convenience, versions of these functions with the [dir] argument hard-coded are
-    provided.  If you are writing performance-critical code you should use the
-    versions with the hard-coded arguments (e.g. [iround_down_exn]).  The [_exn] ones
+    provided. If you are writing performance-critical code you should use the
+    versions with the hard-coded arguments (e.g. [iround_down_exn]). The [_exn] ones
     are the fastest.
 
     The following properties hold:

src/fn.ml

@@ -2,7 +2,7 @@ open! Import
 
 let const c _ = c
 
-external ignore : (_[@local_opt]) -> unit = "%ignore"
+external ignore : 'a. ('a[@local_opt]) -> unit = "%ignore" [@@layout_poly]
 
 (* this has the same behavior as [Stdlib.ignore] *)
 
@@ -17,8 +17,10 @@ let forever f =
   | e -> e
 ;;
 
-external id : ('a[@local_opt]) -> ('a[@local_opt]) = "%identity"
-external ( |> ) : 'a -> (('a -> 'b)[@local_opt]) -> 'b = "%revapply"
+external id : 'a. ('a[@local_opt]) -> ('a[@local_opt]) = "%identity" [@@layout_poly]
+
+external ( |> ) : 'a 'b. 'a -> (('a -> 'b)[@local_opt]) -> 'b = "%revapply"
+[@@layout_poly]
 
 (* The typical use case for these functions is to pass in functional arguments and get
    functions as a result. *)

src/fn.mli

@@ -6,13 +6,15 @@ open! Import
 
     See {{:https://github.com/janestreet/ppx_pipebang} ppx_pipebang} for
     further details. *)
-external ( |> ) : 'a -> (('a -> 'b)[@local_opt]) -> 'b = "%revapply"
+external ( |> ) : 'a 'b. 'a -> (('a -> 'b)[@local_opt]) -> 'b = "%revapply"
+[@@layout_poly]
 
 (** Produces a function that just returns its first argument. *)
 val const : 'a -> _ -> 'a
 
 (** Ignores its argument and returns [()]. *)
-external ignore : (_[@local_opt]) -> unit = "%ignore"
+external ignore : 'a. ('a[@local_opt]) -> unit = "%ignore"
+[@@layout_poly]
 
 (** Negates a boolean function. *)
 val non : ('a -> bool) -> 'a -> bool
@@ -27,7 +29,8 @@ val apply_n_times : n:int -> ('a -> 'a) -> 'a -> 'a
 (** The identity function.
 
     See also: {!Sys.opaque_identity}. *)
-external id : ('a[@local_opt]) -> ('a[@local_opt]) = "%identity"
+external id : 'a. ('a[@local_opt]) -> ('a[@local_opt]) = "%identity"
+[@@layout_poly]
 
 (** [compose f g x] is [f (g x)]. *)
 val compose : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c

src/int.ml

@@ -209,16 +209,19 @@ module Pow2 = struct
   let clz = Ocaml_intrinsics_kernel.Int.count_leading_zeros
   let ctz = Ocaml_intrinsics_kernel.Int.count_trailing_zeros
 
+  let[@cold] [@inline never] [@local never] [@specialise never] log2_bad_input i =
+    raise_s (Sexp.message "[Int.floor_log2] got invalid input" [ "", sexp_of_int i ])
+  ;;
+
   (** Hacker's Delight Second Edition p106 *)
-  let floor_log2 i =
-    if i <= 0
-    then raise_s (Sexp.message "[Int.floor_log2] got invalid input" [ "", sexp_of_int i ]);
-    num_bits - 1 - clz i
+  let floor_log2 i = if i <= 0 then log2_bad_input i else num_bits - 1 - clz i
+
+  let[@cold] [@inline never] [@local never] [@specialise never] log2_bad_input i =
+    raise_s (Sexp.message "[Int.ceil_log2] got invalid input" [ "", sexp_of_int i ])
   ;;
 
   let ceil_log2 i =
-    if i <= 0
-    then raise_s (Sexp.message "[Int.ceil_log2] got invalid input" [ "", sexp_of_int i ]);
+    if i <= 0 then log2_bad_input i;
     if i = 1 then 0 else num_bits - clz (i - 1)
   ;;
 end

src/list.mli

@@ -5,10 +5,13 @@
 open! Import
 
 type 'a t = 'a list
-[@@deriving_inline compare ~localize, globalize, hash, sexp, sexp_grammar]
+[@@deriving_inline
+  compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar]
 
 include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t
 include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t
+include Ppx_compare_lib.Equal.S1 with type 'a t := 'a t
+include Ppx_compare_lib.Equal.S_local1 with type 'a t := 'a t
 
 val globalize : ('a -> 'a) -> 'a t -> 'a t
 
@@ -487,8 +490,6 @@ val random_element_exn : ?random_state:Random.State.t -> 'a t -> 'a
 val is_sorted : 'a t -> compare:('a -> 'a -> int) -> bool
 
 val is_sorted_strictly : 'a t -> compare:('a -> 'a -> int) -> bool
-val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
-val equal__local : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
 
 module Infix : sig
   val ( @ ) : 'a t -> 'a t -> 'a t

src/map.ml

@@ -1368,9 +1368,9 @@ module Tree0 = struct
     Enum.compare compare_key compare_data e1 e2
   ;;
 
-  let equal compare_key compare_data t1 t2 =
+  let equal compare_key data_equal t1 t2 =
     let e1, e2 = Enum.drop_phys_equal_prefix t1 End t2 End in
-    Enum.equal compare_key compare_data e1 e2
+    Enum.equal compare_key data_equal e1 e2
   ;;
 
   let iter2 t1 t2 ~f ~compare_key =
@@ -2295,7 +2295,7 @@ module Accessors = struct
     Tree0.compare (compare_key t1) compare_data t1.tree t2.tree
   ;;
 
-  let equal compare_data t1 t2 = Tree0.equal (compare_key t1) compare_data t1.tree t2.tree
+  let equal data_equal t1 t2 = Tree0.equal (compare_key t1) data_equal t1.tree t2.tree
   let keys t = Tree0.keys t.tree
   let data t = Tree0.data t.tree
   let to_alist ?key_order t = Tree0.to_alist ?key_order t.tree
@@ -2729,8 +2729,8 @@ module Tree = struct
     Tree0.compare comparator.Comparator.compare compare_data t1 t2
   ;;
 
-  let equal ~comparator compare_data t1 t2 =
-    Tree0.equal comparator.Comparator.compare compare_data t1 t2
+  let equal ~comparator data_equal t1 t2 =
+    Tree0.equal comparator.Comparator.compare data_equal t1 t2
   ;;
 
   let keys t = Tree0.keys t