v0.17~preview.128.41+46

janestreet · Sep 28, 2023 · ed84c5b · ed84c5b
1 parent 448ea48
commit ed84c5b
Show file tree

Hide file tree

Showing 15 changed files with 267 additions and 120 deletions.
diff --git a/hash_types/src/base_internalhash_types.ml b/hash_types/src/base_internalhash_types.ml
@@ -8,7 +8,13 @@ type hash_value = int
 external create_seeded : seed -> state = "%identity" [@@noalloc]
 external fold_int64 : state -> int64 -> state = "Base_internalhash_fold_int64" [@@noalloc]
 external fold_int : state -> int -> state = "Base_internalhash_fold_int" [@@noalloc]
-external fold_float : state -> float -> state = "Base_internalhash_fold_float" [@@noalloc]
+
+external fold_float
+  :  state
+  -> (float[@unboxed])
+  -> state
+  = "Base_internalhash_fold_float" "Base_internalhash_fold_float_unboxed"
+  [@@noalloc]
 
 external fold_string : state -> string -> state = "Base_internalhash_fold_string"
   [@@noalloc]

diff --git a/hash_types/src/internalhash_stubs.c b/hash_types/src/internalhash_stubs.c
@@ -31,6 +31,11 @@ CAMLprim value Base_internalhash_fold_float(value st, value i)
   return Val_long(caml_hash_mix_double(Long_val(st), Double_val(i)));
 }
 
+CAMLprim value Base_internalhash_fold_float_unboxed(value st, double i)
+{
+  return Val_long(caml_hash_mix_double(Long_val(st), i));
+}
+
 /* This code mimics what hashtbl.hash does in OCaml's hash.c */
 #define FINAL_MIX(h)                            \
   h ^= h >> 16; \

diff --git a/src/dictionary_immutable_intf.ml b/src/dictionary_immutable_intf.ml
@@ -200,6 +200,20 @@ module Definitions = struct
       -> f:((key:'key key -> data:'data -> bool)[@local])
       -> int
 
+    (** Sum up [f data] for all data in the dictionary. *)
+    val sum
+      :  (module Container.Summable with type t = 'a)
+      -> ('key, 'data, _) t
+      -> f:(('data -> 'a)[@local])
+      -> 'a
+
+    (** Like [sum]. The function may also depend on the associated key. *)
+    val sumi
+      :  (module Container.Summable with type t = 'a)
+      -> ('key, 'data, _) t
+      -> f:((key:'key -> data:'data -> 'a)[@local])
+      -> 'a
+
     (** Produces the key/value pair with the smallest key if non-empty. *)
     val min_elt : ('key, 'data, _) t -> ('key key * 'data) option
 

diff --git a/src/hash.ml b/src/hash.ml
@@ -149,7 +149,11 @@ module Internalhash : sig
 
   external fold_int : state -> int -> state = "Base_internalhash_fold_int" [@@noalloc]
 
-  external fold_float : state -> float -> state = "Base_internalhash_fold_float"
+  external fold_float
+    :  state
+    -> (float[@unboxed])
+    -> state
+    = "Base_internalhash_fold_float" "Base_internalhash_fold_float_unboxed"
     [@@noalloc]
 
   external fold_string : state -> string -> state = "Base_internalhash_fold_string"
@@ -214,7 +218,11 @@ module T = struct
 
     let hash_bool x = if x then 1 else 0
 
-    external hash_float : float -> int = "Base_hash_double" [@@noalloc]
+    external hash_float
+      :  (float[@unboxed])
+      -> int
+      = "Base_hash_double" "Base_hash_double_unboxed"
+      [@@noalloc]
 
     let hash_unit () = 0
   end

diff --git a/src/hash_stubs.c b/src/hash_stubs.c
@@ -22,3 +22,9 @@ CAMLprim value Base_hash_double(value d) {
   h = caml_hash_mix_double(0, Double_val(d));
   FINAL_MIX_AND_RETURN(h);
 }
+
+CAMLprim value Base_hash_double_unboxed(double d) {
+  uint32_t h;
+  h = caml_hash_mix_double(0, d);
+  FINAL_MIX_AND_RETURN(h);
+}