v0.17~preview.129.11+135

base.opam

@@ -11,8 +11,9 @@ build: [
 ]
 depends: [
   "ocaml" {>= "4.14.0"}
+  "ocaml_intrinsics_kernel"
   "sexplib0"
-  "dune"              {>= "2.0.0"}
+  "dune"                    {>= "2.0.0"}
   "dune-configurator"
 ]
 available: arch != "arm32" & arch != "x86_32"

src/container.ml

@@ -103,8 +103,9 @@ let to_array ~length ~iter c =
 ;;
 
 module Make_gen (T : Make_gen_arg) :
-  Generic with type ('a, 'phantom) t := ('a, 'phantom) T.t and type 'a elt := 'a T.elt =
-struct
+  Generic
+    with type ('a, 'phantom1, 'phantom2) t := ('a, 'phantom1, 'phantom2) T.t
+     and type 'a elt := 'a T.elt = struct
   let fold = T.fold
 
   let iter =
@@ -139,7 +140,7 @@ module Make (T : Make_arg) = struct
   include Make_gen (struct
     include T
 
-    type ('a, _) t = 'a T.t
+    type ('a, _, _) t = 'a T.t
     type 'a elt = 'a
   end)
 end
@@ -148,7 +149,7 @@ module Make0 (T : Make0_arg) = struct
   include Make_gen (struct
     include T
 
-    type ('a, _) t = T.t
+    type ('a, _, _) t = T.t
     type 'a elt = T.Elt.t
   end)
 
@@ -157,9 +158,10 @@ end
 
 module Make_gen_with_creators (T : Make_gen_with_creators_arg) :
   Generic_with_creators
-    with type ('a, 'phantom) t := ('a, 'phantom) T.t
+    with type ('a, 'phantom1, 'phantom2) t := ('a, 'phantom1, 'phantom2) T.t
      and type 'a elt := 'a T.elt
-     and type ('a, 'phantom) concat := ('a, 'phantom) T.concat = struct
+     and type ('a, 'phantom1, 'phantom2) concat := ('a, 'phantom1, 'phantom2) T.concat =
+struct
   include Make_gen (T)
 
   let of_list = T.of_list
@@ -205,9 +207,9 @@ module Make_with_creators (T : Make_with_creators_arg) = struct
   include Make_gen_with_creators (struct
     include T
 
-    type ('a, _) t = 'a T.t
+    type ('a, _, _) t = 'a T.t
     type 'a elt = 'a
-    type ('a, _) concat = 'a T.t
+    type ('a, _, _) concat = 'a T.t
 
     let concat_of_array = of_array
   end)
@@ -217,9 +219,9 @@ module Make0_with_creators (T : Make0_with_creators_arg) = struct
   include Make_gen_with_creators (struct
     include T
 
-    type ('a, _) t = T.t
+    type ('a, _, _) t = T.t
     type 'a elt = T.Elt.t
-    type ('a, _) concat = 'a list
+    type ('a, _, _) concat = 'a list
 
     let concat_of_array = Array.to_list
   end)

src/container_intf.ml

@@ -413,44 +413,44 @@ module type S1_phantom = sig
 end
 
 module type Generic = sig
-  type ('a, 'phantom) t
+  type ('a, 'phantom1, 'phantom2) t
   type 'a elt
 
-  val length : (_, _) t -> int
-  val is_empty : (_, _) t -> bool
-  val mem : ('a, _) t -> 'a elt -> equal:('a elt -> 'a elt -> bool) -> bool
-  val iter : ('a, _) t -> f:('a elt -> unit) -> unit
-  val fold : ('a, _) t -> init:'acc -> f:('acc -> 'a elt -> 'acc) -> 'acc
+  val length : (_, _, _) t -> int
+  val is_empty : (_, _, _) t -> bool
+  val mem : ('a, _, _) t -> 'a elt -> equal:('a elt -> 'a elt -> bool) -> bool
+  val iter : ('a, _, _) t -> f:('a elt -> unit) -> unit
+  val fold : ('a, _, _) t -> init:'acc -> f:('acc -> 'a elt -> 'acc) -> 'acc
 
   val fold_result
-    :  ('a, _) t
+    :  ('a, _, _) t
     -> init:'acc
     -> f:('acc -> 'a elt -> ('acc, 'e) Result.t)
     -> ('acc, 'e) Result.t
 
   val fold_until
-    :  ('a, _) t
+    :  ('a, _, _) t
     -> init:'acc
     -> f:('acc -> 'a elt -> ('acc, 'final) Continue_or_stop.t)
     -> finish:('acc -> 'final)
     -> 'final
 
-  val exists : ('a, _) t -> f:('a elt -> bool) -> bool
-  val for_all : ('a, _) t -> f:('a elt -> bool) -> bool
-  val count : ('a, _) t -> f:('a elt -> bool) -> int
+  val exists : ('a, _, _) t -> f:('a elt -> bool) -> bool
+  val for_all : ('a, _, _) t -> f:('a elt -> bool) -> bool
+  val count : ('a, _, _) t -> f:('a elt -> bool) -> int
 
   val sum
     :  (module Summable with type t = 'sum)
-    -> ('a, _) t
+    -> ('a, _, _) t
     -> f:('a elt -> 'sum)
     -> 'sum
 
-  val find : ('a, _) t -> f:('a elt -> bool) -> 'a elt option
-  val find_map : ('a, _) t -> f:('a elt -> 'b option) -> 'b option
-  val to_list : ('a, _) t -> 'a elt list
-  val to_array : ('a, _) t -> 'a elt array
-  val min_elt : ('a, _) t -> compare:('a elt -> 'a elt -> int) -> 'a elt option
-  val max_elt : ('a, _) t -> compare:('a elt -> 'a elt -> int) -> 'a elt option
+  val find : ('a, _, _) t -> f:('a elt -> bool) -> 'a elt option
+  val find_map : ('a, _, _) t -> f:('a elt -> 'b option) -> 'b option
+  val to_list : ('a, _, _) t -> 'a elt list
+  val to_array : ('a, _, _) t -> 'a elt array
+  val min_elt : ('a, _, _) t -> compare:('a elt -> 'a elt -> int) -> 'a elt option
+  val max_elt : ('a, _, _) t -> compare:('a elt -> 'a elt -> int) -> 'a elt option
 end
 
 module type S0_with_creators = sig
@@ -526,31 +526,39 @@ module type S1_with_creators = sig
 end
 
 module type Generic_with_creators = sig
-  type (_, _) concat
+  type (_, _, _) concat
 
   include Generic
 
-  val of_list : 'a elt list -> ('a, _) t
-  val of_array : 'a elt array -> ('a, _) t
-  val append : ('a, 'p) t -> ('a, 'p) t -> ('a, 'p) t
-  val concat : (('a, 'p) t, 'p) concat -> ('a, 'p) t
-  val map : ('a, 'p) t -> f:('a elt -> 'b elt) -> ('b, 'p) t
-  val filter : ('a, 'p) t -> f:('a elt -> bool) -> ('a, 'p) t
-  val filter_map : ('a, 'p) t -> f:('a elt -> 'b elt option) -> ('b, 'p) t
-  val concat_map : ('a, 'p) t -> f:('a elt -> ('b, 'p) t) -> ('b, 'p) t
-  val partition_tf : ('a, 'p) t -> f:('a elt -> bool) -> ('a, 'p) t * ('a, 'p) t
+  val of_list : 'a elt list -> ('a, _, _) t
+  val of_array : 'a elt array -> ('a, _, _) t
+  val append : ('a, 'p1, 'p2) t -> ('a, 'p1, 'p2) t -> ('a, 'p1, 'p2) t
+  val concat : (('a, 'p1, 'p2) t, 'p1, 'p2) concat -> ('a, 'p1, 'p2) t
+  val map : ('a, 'p1, 'p2) t -> f:('a elt -> 'b elt) -> ('b, 'p1, 'p2) t
+  val filter : ('a, 'p1, 'p2) t -> f:('a elt -> bool) -> ('a, 'p1, 'p2) t
+  val filter_map : ('a, 'p1, 'p2) t -> f:('a elt -> 'b elt option) -> ('b, 'p1, 'p2) t
+  val concat_map : ('a, 'p1, 'p2) t -> f:('a elt -> ('b, 'p1, 'p2) t) -> ('b, 'p1, 'p2) t
+
+  val partition_tf
+    :  ('a, 'p1, 'p2) t
+    -> f:('a elt -> bool)
+    -> ('a, 'p1, 'p2) t * ('a, 'p1, 'p2) t
 
   val partition_map
-    :  ('a, 'p) t
+    :  ('a, 'p1, 'p2) t
     -> f:('a elt -> ('b elt, 'c elt) Either0.t)
-    -> ('b, 'p) t * ('c, 'p) t
+    -> ('b, 'p1, 'p2) t * ('c, 'p1, 'p2) t
 end
 
 module type Make_gen_arg = sig
-  type ('a, 'phantom) t
+  type ('a, 'phantom1, 'phantom2) t
   type 'a elt
 
-  val fold : ('a, 'phantom) t -> init:'acc -> f:('acc -> 'a elt -> 'acc) -> 'acc
+  val fold
+    :  ('a, 'phantom1, 'phantom2) t
+    -> init:'acc
+    -> f:('acc -> 'a elt -> 'acc)
+    -> 'acc
 
   (** The [iter] argument to [Container.Make] specifies how to implement the
       container's [iter] function.  [`Define_using_fold] means to define [iter]
@@ -565,7 +573,9 @@ module type Make_gen_arg = sig
       terms of [iter], so passing in a more efficient [iter] will improve their efficiency
       as well. *)
   val iter
-    : [ `Define_using_fold | `Custom of ('a, 'phantom) t -> f:('a elt -> unit) -> unit ]
+    : [ `Define_using_fold
+      | `Custom of ('a, 'phantom1, 'phantom2) t -> f:('a elt -> unit) -> unit
+      ]
 
   (** The [length] argument to [Container.Make] specifies how to implement the
       container's [length] function.  [`Define_using_fold] means to define
@@ -579,13 +589,13 @@ module type Make_gen_arg = sig
       efficient.  Several other functions returned by [Container.Make] are defined in
       terms of [length], so passing in a more efficient [length] will improve their
       efficiency as well. *)
-  val length : [ `Define_using_fold | `Custom of ('a, 'phantom) t -> int ]
+  val length : [ `Define_using_fold | `Custom of ('a, 'phantom1, 'phantom2) t -> int ]
 end
 
 module type Make_arg = sig
   type 'a t
 
-  include Make_gen_arg with type ('a, _) t := 'a t and type 'a elt := 'a
+  include Make_gen_arg with type ('a, _, _) t := 'a t and type 'a elt := 'a
 end
 
 module type Make0_arg = sig
@@ -597,33 +607,33 @@ module type Make0_arg = sig
 
   type t
 
-  include Make_gen_arg with type ('a, _) t := t and type 'a elt := Elt.t
+  include Make_gen_arg with type ('a, _, _) t := t and type 'a elt := Elt.t
 end
 
 module type Make_common_with_creators_arg = sig
   include Make_gen_arg
 
-  type (_, _) concat
+  type (_, _, _) concat
 
-  val of_list : 'a elt list -> ('a, _) t
-  val of_array : 'a elt array -> ('a, _) t
-  val concat : (('a, _) t, _) concat -> ('a, _) t
+  val of_list : 'a elt list -> ('a, _, _) t
+  val of_array : 'a elt array -> ('a, _, _) t
+  val concat : (('a, _, _) t, _, _) concat -> ('a, _, _) t
 end
 
 module type Make_gen_with_creators_arg = sig
   include Make_common_with_creators_arg
 
-  val concat_of_array : 'a array -> ('a, _) concat
+  val concat_of_array : 'a array -> ('a, _, _) concat
 end
 
 module type Make_with_creators_arg = sig
   type 'a t
 
   include
     Make_common_with_creators_arg
-      with type ('a, _) t := 'a t
+      with type ('a, _, _) t := 'a t
        and type 'a elt := 'a
-       and type ('a, _) concat := 'a t
+       and type ('a, _, _) concat := 'a t
 end
 
 module type Make0_with_creators_arg = sig
@@ -637,9 +647,9 @@ module type Make0_with_creators_arg = sig
 
   include
     Make_common_with_creators_arg
-      with type ('a, _) t := t
+      with type ('a, _, _) t := t
        and type 'a elt := Elt.t
-       and type ('a, _) concat := 'a list
+       and type ('a, _, _) concat := 'a list
 end
 
 module type Derived = sig
@@ -747,7 +757,9 @@ module type Container = sig
   module Make0 (T : Make0_arg) : S0 with type t := T.t and type elt := T.Elt.t
 
   module Make_gen (T : Make_gen_arg) :
-    Generic with type ('a, 'phantom) t := ('a, 'phantom) T.t and type 'a elt := 'a T.elt
+    Generic
+      with type ('a, 'phantom1, 'phantom2) t := ('a, 'phantom1, 'phantom2) T.t
+       and type 'a elt := 'a T.elt
 
   module Make_with_creators (T : Make_with_creators_arg) :
     S1_with_creators with type 'a t := 'a T.t
@@ -757,7 +769,7 @@ module type Container = sig
 
   module Make_gen_with_creators (T : Make_gen_with_creators_arg) :
     Generic_with_creators
-      with type ('a, 'phantom) t := ('a, 'phantom) T.t
+      with type ('a, 'phantom1, 'phantom2) t := ('a, 'phantom1, 'phantom2) T.t
        and type 'a elt := 'a T.elt
-       and type ('a, 'phantom) concat := ('a, 'phantom) T.concat
+       and type ('a, 'phantom1, 'phantom2) concat := ('a, 'phantom1, 'phantom2) T.concat
 end

src/dictionary_immutable_intf.ml

@@ -309,7 +309,8 @@ module Definitions = struct
       -> ('key, 'data1, 'phantom) t * ('key, 'data2, 'phantom) t
 
     (** Merges two dictionaries by fully traversing both. Not suitable for efficiently
-        merging lists of dictionaries. See [merge_skewed] instead. *)
+        merging lists of dictionaries. See [merge_disjoint_exn] and [merge_skewed]
+        instead. *)
     val merge
       : ( ('key, 'data1, 'phantom) t
           -> ('key, 'data2, 'phantom) t
@@ -323,6 +324,17 @@ module Definitions = struct
         , 'phantom )
         accessor
 
+    (** Merges two dictionaries with the same type of data and disjoint sets of keys.
+        Raises if any keys overlap. *)
+    val merge_disjoint_exn
+      : ( ('key, 'data, 'phantom) t
+          -> ('key, 'data, 'phantom) t
+          -> ('key, 'data, 'phantom) t
+        , 'key
+        , 'data
+        , 'phantom )
+        accessor
+
     (** Merges two dictionaries by traversing only the smaller of the two. Adds key/value
         pairs missing from the larger dictionary, and [combine]s duplicate values. *)
     val merge_skewed

src/dune

@@ -16,8 +16,7 @@
 (library
  (foreign_stubs
   (language c)
-  (names bytes_stubs exn_stubs float_stubs int_math_stubs hash_stubs
-    obj_stubs am_testing)
+  (names bytes_stubs exn_stubs int_math_stubs hash_stubs obj_stubs am_testing)
   (flags
    :standard
    -D_LARGEFILE64_SOURCE
@@ -27,7 +26,8 @@
  (ocamlopt_flags
   :standard
   (:include ocamlopt-flags))
- (libraries base_internalhash_types sexplib0 shadow_stdlib)
+ (libraries base_internalhash_types sexplib0 shadow_stdlib
+   ocaml_intrinsics_kernel)
  (preprocess no_preprocessing)
  (lint
   (pps ppx_base ppx_base_lint -check-doc-comments -type-conv-keep-w32=both

src/float0.ml

@@ -202,27 +202,8 @@ let lower_bound_for_int num_bits =
    These intrinsics were copied from [Ocaml_intrinsics] to avoid build deps we don't want
 *)
 module Intrinsics_with_weird_nan_behavior = struct
-  (** Equivalent to [if x < y then x else y].
-
-      On an x86-64 machine, this compiles to [minsd xmm0, xmm1].
-      On ARM, this calls a C implementation. *)
-  external min
-    :  (float[@unboxed])
-    -> (float[@unboxed])
-    -> (float[@unboxed])
-    = "caml_sse2_float64_min_bytecode" "caml_sse2_float64_min"
-    [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects]
-
-  (** Equivalent to [if x > y then x else y].
-
-      On an x86-64 machine, this compiles to [maxsd xmm0, xmm1].
-      On ARM, this calls a C implementation. *)
-  external max
-    :  (float[@unboxed])
-    -> (float[@unboxed])
-    -> (float[@unboxed])
-    = "caml_sse2_float64_max_bytecode" "caml_sse2_float64_max"
-    [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects]
+  let[@inline always] min a b = Ocaml_intrinsics_kernel.Float.min a b
+  let[@inline always] max a b = Ocaml_intrinsics_kernel.Float.max a b
 end
 
 let clamp_unchecked

src/hash_set_intf.ml

@@ -4,7 +4,7 @@ module Key = Hashtbl_intf.Key
 module type Accessors = sig
   type 'a t
 
-  include Container.Generic with type ('a, _) t := 'a t
+  include Container.Generic with type ('a, _, _) t := 'a t
 
   (** override [Container.Generic.mem] *)
   val mem : 'a t -> 'a -> bool