v0.18~preview.130.04+450

composition_infix/README.md

@@ -0,0 +1,2 @@
+A single-module library for defining infix composition operators `<<`
+and `>>`.

composition_infix/src/composition_infix.ml

@@ -0,0 +1,2 @@
+let ( >> ) f g x = g (f x)
+let ( << ) f g x = f (g x)

composition_infix/src/composition_infix.mli

@@ -0,0 +1,7 @@
+(** Infix composition operators.
+
+    - [ a |> (f >> g) = a |> f |> g ]
+    - [ (f << g) a = f (g a) ] *)
+
+val ( >> ) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
+val ( << ) : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c

composition_infix/src/dune

@@ -0,0 +1,5 @@
+(library
+ (name composition_infix)
+ (public_name base.composition_infix)
+ (preprocess no_preprocessing)
+ (libraries))

lint/ppx_base_lint.ml

@@ -181,9 +181,10 @@ let () =
       | { pstr_loc = loc; _ } :: _ as st ->
         (check (module_of_loc loc))#structure st;
         st)
-    ~intf:(function
-      | [] -> []
-      | { psig_loc = loc; _ } :: _ as sg ->
+    ~intf:(fun sg ->
+      match sg.psg_items with
+      | [] -> sg
+      | { psig_loc = loc; _ } :: _ ->
         (check (module_of_loc loc))#signature sg;
         sg)
 ;;

ppx/src/ppx_base_internal.ml

@@ -3,7 +3,7 @@ open Ppxlib
 
 module Specialize_polymorphic_compare = struct
   let signature ~loc =
-    [%sig:
+    [%sigil:
       [@@@ocaml.ppwarning "ppx_base_internal: intended only for use inside Base"]
 
       external ( = ) : (t[@local_opt]) -> (t[@local_opt]) -> bool = "%equal"

src/array.mli

@@ -2,14 +2,17 @@
 
 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 : (local_ 'a -> 'a) -> local_ 'a t -> 'a t
 
-include Sexplib0.Sexpable.S1 with type 'a t := 'a t
+include Sexplib0.Sexpable.S_any1 with type 'a t := 'a t
 
 val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t
 
@@ -270,8 +273,6 @@ val sorted_copy : local_ 'a t -> compare:local_ ('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 : (local_ 'a -> local_ 'a -> bool) -> local_ 'a t -> local_ 'a t -> bool
 
 (** The input array is copied internally so that future modifications of it do not change
     the sequence. *)

src/base.ml

@@ -758,5 +758,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/bool.mli

@@ -9,7 +9,7 @@ include Ppx_enumerate_lib.Enumerable.S with type t := t
 
 val globalize : local_ t -> t
 
-include Sexplib0.Sexpable.S with type t := t
+include Sexplib0.Sexpable.S_any with type t := t
 
 val t_sexp_grammar : t Sexplib0.Sexp_grammar.t
 

src/bytes_intf.ml

@@ -22,7 +22,7 @@ module type Bytes = sig
 
   val globalize : local_ t -> t
 
-  include Sexplib0.Sexpable.S with type t := t
+  include Sexplib0.Sexpable.S_any with type t := t
 
   val t_sexp_grammar : t Sexplib0.Sexp_grammar.t
 

src/char.mli

@@ -9,7 +9,7 @@ include Ppx_enumerate_lib.Enumerable.S with type t := t
 
 val globalize : local_ t -> t
 
-include Sexplib0.Sexpable.S with type t := t
+include Sexplib0.Sexpable.S_any with type t := t
 
 val t_sexp_grammar : t Sexplib0.Sexp_grammar.t
 
@@ -95,7 +95,7 @@ module Caseless : sig
   type nonrec t = t [@@deriving_inline hash, sexp, sexp_grammar]
 
   include Ppx_hash_lib.Hashable.S with type t := t
-  include Sexplib0.Sexpable.S with type t := t
+  include Sexplib0.Sexpable.S_any with type t := t
 
   val t_sexp_grammar : t Sexplib0.Sexp_grammar.t
 

src/dictionary_immutable_intf.ml

@@ -299,6 +299,17 @@ module Definitions = struct
           , 'phantom )
           transformer
 
+    (** Like [update]. Returns the new value. *)
+    val update_and_return
+      : ( ('key, 'data, 'phantom) t
+          -> 'key key
+          -> f:local_ ('data option -> 'data)
+          -> 'data * ('key, 'data, 'phantom) t
+          , 'key
+          , 'data
+          , 'phantom )
+          transformer
+
     (** Adds [data] to the existing key/value pair for [key]. Interprets a missing key as
         having an empty list. *)
     val add_multi

src/dictionary_mutable_intf.ml

@@ -393,7 +393,10 @@ module Definitions = struct
       -> ('key, 'c, 'phantom) t * ('key, 'd, 'phantom) t
 
     (** Merges two dictionaries by fully traversing both. Not suitable for efficiently
-        merging lists of dictionaries. See [merge_into] instead. *)
+        merging lists of dictionaries. See [merge_into] instead.
+
+        If the two dictionaries differ in their implementations, e.g. of [hash] or
+        [compare] functions, those from the first argument are preferred. *)
     val merge
       : ( ('key, 'data1, 'phantom) t
           -> ('key, 'data2, 'phantom) t

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
 
@@ -61,15 +63,6 @@ module type Either = sig
     -> second:local_ ('b -> 'd)
     -> ('c, 'd) t
 
-  val equal : ('f -> 'f -> bool) -> ('s -> 's -> bool) -> ('f, 's) t -> ('f, 's) t -> bool
-
-  val local_equal
-    :  (local_ 'f -> local_ 'f -> bool)
-    -> (local_ 's -> local_ 's -> bool)
-    -> local_ ('f, 's) t
-    -> local_ ('f, 's) t
-    -> bool
-
   module type Focused = Focused
 
   module First : Focused with type ('a, 'b) t = ('a, 'b) t

src/exn.ml

@@ -34,7 +34,7 @@ let () =
 
 [@@@end]
 
-exception Sexp of Sexp.t
+exception Sexp of Sexp.t Lazy.t
 
 (* We install a custom exn-converter rather than use:
 
@@ -47,13 +47,14 @@ exception Sexp of Sexp.t
    to eliminate the extra wrapping of [(Sexp ...)]. *)
 let () =
   Sexplib0.Sexp_conv.Exn_converter.add [%extension_constructor Sexp] (function
-    | Sexp t -> t
+    | Sexp t -> Lazy.force t
     | _ ->
       (* Reaching this branch indicates a bug in sexplib. *)
       assert false)
 ;;
 
-let create_s sexp = Sexp sexp
+let create_s sexp = Sexp (Lazy.from_val sexp)
+let create_s_lazy lazy_sexp = Sexp lazy_sexp
 
 let raise_with_original_backtrace t backtrace =
   Stdlib.Printexc.raise_with_backtrace t backtrace

src/exn.mli

@@ -27,6 +27,9 @@ exception Reraised of string * t
     particular exn constructor doesn't matter. *)
 val create_s : Sexp.t -> t
 
+(** [create_s_lazy lazy_sexp] is like [create_s], but takes a lazily generated sexp. *)
+val create_s_lazy : Sexp.t Lazy.t -> t
+
 (** Same as [raise], except that the backtrace is not recorded. *)
 val raise_without_backtrace : t -> _
 

src/float.mli

@@ -127,8 +127,8 @@ val to_int64 : local_ 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:
@@ -700,7 +700,7 @@ val ieee_mantissa : local_ t -> Int63.t
 module Terse : sig
   type nonrec t = t [@@deriving_inline sexp, sexp_grammar]
 
-  include Sexplib0.Sexpable.S with type t := t
+  include Sexplib0.Sexpable.S_any with type t := t
 
   val t_sexp_grammar : t Sexplib0.Sexp_grammar.t
 

src/fn.ml

@@ -2,7 +2,7 @@ open! Import
 
 let const c _ = c
 
-external ignore : (_[@local_opt]) -> unit = "%ignore"
+external ignore : ('a : any). ('a[@local_opt]) -> unit = "%ignore" [@@layout_poly]
 
 (* this has the same behavior as [Stdlib.ignore] *)
 
@@ -17,8 +17,14 @@ 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 : any). ('a[@local_opt]) -> ('a[@local_opt]) = "%identity"
+[@@layout_poly]
+
+external ( |> )
+  : ('a : any) ('b : any).
+  '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,18 @@ open! Import
 
     See {{:https://github.com/janestreet/ppx_pipebang} ppx_pipebang} for
     further details. *)
-external ( |> ) : 'a -> (('a -> 'b)[@local_opt]) -> 'b = "%revapply"
+external ( |> )
+  : ('a : any) ('b : any).
+  '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 : any). ('a[@local_opt]) -> unit = "%ignore"
+[@@layout_poly]
 
 (** Negates a boolean function. *)
 val non : ('a -> bool) -> 'a -> bool
@@ -27,7 +32,8 @@ val apply_n_times : n:int -> local_ ('a -> 'a) -> 'a -> 'a
 (** The identity function.
 
     See also: {!Sys.opaque_identity}. *)
-external id : ('a[@local_opt]) -> ('a[@local_opt]) = "%identity"
+external id : ('a : any). ('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/hash_set.ml

@@ -14,6 +14,7 @@ module Accessors = struct
   let hashable = hashable
   let clear = Hashtbl.clear
   let length = Hashtbl.length
+  let capacity = Hashtbl.capacity
   let mem = Hashtbl.mem
   let is_empty t = Hashtbl.is_empty t
 

src/hash_set_intf.ml

@@ -40,6 +40,7 @@ module type Accessors = sig
   val diff : 'a t -> 'a t -> 'a t
   val of_hashtbl_keys : ('a, _) Hashtbl.t -> 'a t
   val to_hashtbl : 'key t -> f:local_ ('key -> 'data) -> ('key, 'data) Hashtbl.t
+  val capacity : _ t -> int
 end
 
 type ('key, 'z) create_options = ('key, unit, 'z) Hashtbl_intf.create_options
@@ -172,7 +173,7 @@ module type Hash_set = sig
   module Poly : sig
     type nonrec 'a t = 'a t [@@deriving_inline sexp, sexp_grammar]
 
-    include Sexplib0.Sexpable.S1 with type 'a t := 'a t
+    include Sexplib0.Sexpable.S_any1 with type 'a t := 'a t
 
     val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t
 

src/hashtbl.ml

@@ -638,11 +638,9 @@ let merge =
   let maybe_set t ~key ~f d =
     match f ~key d with
     | None -> ()
-    | Some v -> set t ~key ~data:v
+    | Some v -> add_exn t ~key ~data:v
   in
   fun t_left t_right ~f ->
-    if not (Hashable.equal t_left.hashable t_right.hashable)
-    then invalid_arg "Hashtbl.merge: different 'hashable' values";
     let new_t =
       create
         ~growth_allowed:t_left.growth_allowed

src/indexed_container.ml

@@ -152,6 +152,27 @@ struct
   let filteri t ~f =
     filter_mapi t ~f:(fun i x -> if f i x then Some x else None) [@nontail]
   ;;
+
+  let partition_mapi t ~f =
+    let array = Array.mapi (to_array t) ~f in
+    let xs =
+      Array.fold_right array ~init:[] ~f:(fun either acc ->
+        match (either : _ Either0.t) with
+        | First x -> x :: acc
+        | Second _ -> acc)
+    in
+    let ys =
+      Array.fold_right array ~init:[] ~f:(fun either acc ->
+        match (either : _ Either0.t) with
+        | First _ -> acc
+        | Second x -> x :: acc)
+    in
+    of_list xs, of_list ys
+  ;;
+
+  let partitioni_tf t ~f =
+    partition_mapi t ~f:(fun i x -> if f i x then First x else Second x) [@nontail]
+  ;;
 end
 
 module Make_with_creators (T : Make_with_creators_arg) = struct