mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2026-03-08 06:37:59 -04:00
Compare commits
6 commits
73ea1a2e88
...
2827011b37
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
2827011b37 | ||
|
|
5a50d42352 | ||
|
|
d493f6696b | ||
|
|
bb6de2ff05 | ||
|
|
1aa8b869e5 | ||
|
|
df7619786c |
15 changed files with 166 additions and 40 deletions
17
CHANGELOG.md
17
CHANGELOG.md
|
|
@ -1,10 +1,15 @@
|
||||||
|
|
||||||
## main
|
## 3.18
|
||||||
- breaking: CCListLabel.compare and CCListLabel.equal takes the function on the elements as named arguments
|
|
||||||
- breaking: CCListLabel.init now takes the length as a named arguments to follow the Stdlib
|
- fix leb128 slice bug
|
||||||
- breaking: change the semantic of CCFloat.{min,max} with respect to NaN to follow the Stdlib
|
- fix leb128 `Int64.min_int` bug
|
||||||
- breaking: change the semantic of CCInt.rem with respect to negative number to follow the Stdlib
|
- add tests for leb128 library (#486)
|
||||||
- breaking: change the order of argument of CCMap.add_seq to align with the stdlib.
|
- some breaking changes after the big bump to 4.08 as lower bound, thanks to @fardale for the cleanup
|
||||||
|
* breaking: CCListLabel.compare and CCListLabel.equal takes the function on the elements as named arguments
|
||||||
|
* breaking: CCListLabel.init now takes the length as a named arguments to follow the Stdlib
|
||||||
|
* breaking: change the semantic of CCFloat.{min,max} with respect to NaN to follow the Stdlib
|
||||||
|
* breaking: change the semantic of CCInt.rem with respect to negative number to follow the Stdlib
|
||||||
|
* breaking: change the order of argument of `CCMap.add_seq` to align with the stdlib.
|
||||||
|
|
||||||
## 3.17
|
## 3.17
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -10,7 +10,6 @@
|
||||||
qcheck
|
qcheck
|
||||||
oseq
|
oseq
|
||||||
batteries
|
batteries
|
||||||
base
|
|
||||||
sek)
|
sek)
|
||||||
(flags :standard -warn-error -3-5 -w -60 -safe-string -color always)
|
(flags :standard -warn-error -3-5 -w -60 -safe-string -color always)
|
||||||
(optional)
|
(optional)
|
||||||
|
|
|
||||||
|
|
@ -1824,4 +1824,32 @@ module Str = struct
|
||||||
])
|
])
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Hash = struct
|
||||||
|
let hash_ocaml (n : int) : int =
|
||||||
|
let offset_basis = 0xcbf29ce484222325L in
|
||||||
|
let prime = 0x100000001b3L in
|
||||||
|
let h = ref offset_basis in
|
||||||
|
for k = 0 to 7 do
|
||||||
|
(h := Int64.(mul !h prime));
|
||||||
|
h := Int64.(logxor !h (of_int ((n lsr (k * 8)) land 0xff)))
|
||||||
|
done;
|
||||||
|
Int64.to_int !h land max_int
|
||||||
|
|
||||||
|
let bench_hash n =
|
||||||
|
let run_ocaml () =
|
||||||
|
for i = 0 to n - 1 do
|
||||||
|
opaque_ignore (hash_ocaml i)
|
||||||
|
done
|
||||||
|
and run_c_stub () =
|
||||||
|
for i = 0 to n - 1 do
|
||||||
|
opaque_ignore (CCInt.hash i)
|
||||||
|
done
|
||||||
|
in
|
||||||
|
B.throughputN 3 ~repeat
|
||||||
|
[ "ocaml_fnv", run_ocaml, (); "c_stub", run_c_stub, () ]
|
||||||
|
|
||||||
|
let () =
|
||||||
|
B.Tree.register ("hash" @>>> [ "int" @>> app_ints bench_hash [ 1_000 ] ])
|
||||||
|
end
|
||||||
|
|
||||||
let () = try B.Tree.run_global () with Arg.Help msg -> print_endline msg
|
let () = try B.Tree.run_global () with Arg.Help msg -> print_endline msg
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
# This file is generated by dune, edit dune-project instead
|
# This file is generated by dune, edit dune-project instead
|
||||||
opam-version: "2.0"
|
opam-version: "2.0"
|
||||||
version: "3.17"
|
version: "3.18"
|
||||||
synopsis: "A set of advanced datatypes for containers"
|
synopsis: "A set of advanced datatypes for containers"
|
||||||
maintainer: ["c-cube"]
|
maintainer: ["c-cube"]
|
||||||
authors: ["c-cube"]
|
authors: ["c-cube"]
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
# This file is generated by dune, edit dune-project instead
|
# This file is generated by dune, edit dune-project instead
|
||||||
opam-version: "2.0"
|
opam-version: "2.0"
|
||||||
version: "3.17"
|
version: "3.18"
|
||||||
synopsis:
|
synopsis:
|
||||||
"A modular, clean and powerful extension of the OCaml standard library"
|
"A modular, clean and powerful extension of the OCaml standard library"
|
||||||
maintainer: ["c-cube"]
|
maintainer: ["c-cube"]
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,7 @@
|
||||||
|
|
||||||
(generate_opam_files true)
|
(generate_opam_files true)
|
||||||
|
|
||||||
(version 3.17)
|
(version 3.18)
|
||||||
|
|
||||||
(authors c-cube)
|
(authors c-cube)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -104,7 +104,7 @@ val option : ?none:unit printer -> 'a printer -> 'a option printer
|
||||||
- [Some x] will become [pp x]
|
- [Some x] will become [pp x]
|
||||||
- [None] will become [none ()]
|
- [None] will become [none ()]
|
||||||
Alias of {!Format.pp_print_option}
|
Alias of {!Format.pp_print_option}
|
||||||
@since NEXT_RELEASE *)
|
@since 3.18 *)
|
||||||
|
|
||||||
val opt : 'a printer -> 'a option printer
|
val opt : 'a printer -> 'a option printer
|
||||||
(** [opt pp] prints options as follows:
|
(** [opt pp] prints options as follows:
|
||||||
|
|
|
||||||
|
|
@ -7,7 +7,7 @@ type 'a t = 'a -> hash
|
||||||
type 'a iter = ('a -> unit) -> unit
|
type 'a iter = ('a -> unit) -> unit
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
|
|
||||||
(* FNV hashing
|
(* FNV-1 hashing (multiply then XOR)
|
||||||
https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function
|
https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function
|
||||||
*)
|
*)
|
||||||
let fnv_offset_basis = 0xcbf29ce484222325L
|
let fnv_offset_basis = 0xcbf29ce484222325L
|
||||||
|
|
|
||||||
|
|
@ -4,20 +4,11 @@ include Int
|
||||||
|
|
||||||
type 'a iter = ('a -> unit) -> unit
|
type 'a iter = ('a -> unit) -> unit
|
||||||
|
|
||||||
(* use FNV:
|
(* use FNV-1:
|
||||||
https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function *)
|
https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function *)
|
||||||
let hash (n : int) : int =
|
external hash : (int[@untagged]) -> (int[@untagged])
|
||||||
let offset_basis = 0xcbf29ce484222325L in
|
= "caml_cc_hash_int_byte" "caml_cc_hash_int"
|
||||||
let prime = 0x100000001b3L in
|
[@@noalloc]
|
||||||
|
|
||||||
let h = ref offset_basis in
|
|
||||||
for k = 0 to 7 do
|
|
||||||
(h := Int64.(mul !h prime));
|
|
||||||
(* h := h xor (k-th byte of n) *)
|
|
||||||
h := Int64.(logxor !h (of_int ((n lsr (k * 8)) land 0xff)))
|
|
||||||
done;
|
|
||||||
(* truncate back to int and remove sign *)
|
|
||||||
Int64.to_int !h land max_int
|
|
||||||
|
|
||||||
let range i j yield =
|
let range i j yield =
|
||||||
let rec up i j yield =
|
let rec up i j yield =
|
||||||
|
|
|
||||||
|
|
@ -11,21 +11,14 @@ let max : t -> t -> t = Stdlib.max
|
||||||
|
|
||||||
let sign i = compare i zero
|
let sign i = compare i zero
|
||||||
|
|
||||||
(* use FNV:
|
(* use FNV-1:
|
||||||
https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function *)
|
https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function *)
|
||||||
let hash_to_int64 (n : t) =
|
external hash_to_int64 : (int64[@unboxed]) -> (int64[@unboxed])
|
||||||
let offset_basis = 0xcbf29ce484222325L in
|
= "caml_cc_hash_int64_to_int64_byte" "caml_cc_hash_int64_to_int64"
|
||||||
let prime = 0x100000001b3L in
|
|
||||||
|
|
||||||
let h = ref offset_basis in
|
external hash : (int64[@unboxed]) -> (int[@untagged])
|
||||||
for k = 0 to 7 do
|
= "caml_cc_hash_int64_byte" "caml_cc_hash_int64"
|
||||||
h := mul !h prime;
|
[@@noalloc]
|
||||||
(* h := h xor (k-th byte of n) *)
|
|
||||||
h := logxor !h (logand (shift_right n (k * 8)) 0xffL)
|
|
||||||
done;
|
|
||||||
logand !h max_int
|
|
||||||
|
|
||||||
let[@inline] hash (n : t) : int = to_int (hash_to_int64 n) land Stdlib.max_int
|
|
||||||
|
|
||||||
(* see {!CCInt.popcount} for more details *)
|
(* see {!CCInt.popcount} for more details *)
|
||||||
let[@inline] popcount (b : t) : int =
|
let[@inline] popcount (b : t) : int =
|
||||||
|
|
|
||||||
|
|
@ -20,7 +20,7 @@ let cons a b () = Cons (a, b)
|
||||||
let singleton x () = Cons (x, nil)
|
let singleton x () = Cons (x, nil)
|
||||||
|
|
||||||
[@@@endif]
|
[@@@endif]
|
||||||
[@@@iflt 4.11]
|
[@@@iflt 4.14]
|
||||||
|
|
||||||
let init n f =
|
let init n f =
|
||||||
let rec aux i () =
|
let rec aux i () =
|
||||||
|
|
|
||||||
|
|
@ -49,7 +49,7 @@ val forever : (unit -> 'a) -> 'a t
|
||||||
|
|
||||||
val cycle : 'a t -> 'a t
|
val cycle : 'a t -> 'a t
|
||||||
(** Cycle through the sequence infinitely. The sequence should be persistent.
|
(** Cycle through the sequence infinitely. The sequence should be persistent.
|
||||||
@since NEXT_RELEASE the sequence can be empty, in this case cycle return an empty sequence. *)
|
@since 3.18 the sequence can be empty, in this case cycle return an empty sequence. *)
|
||||||
|
|
||||||
val iterate : ('a -> 'a) -> 'a -> 'a t
|
val iterate : ('a -> 'a) -> 'a -> 'a t
|
||||||
(** [iterate f a] corresponds to the infinite sequence containing [a], [f a], [f (f a)],
|
(** [iterate f a] corresponds to the infinite sequence containing [a], [f a], [f (f a)],
|
||||||
|
|
|
||||||
67
src/core/cc_stubs.c
Normal file
67
src/core/cc_stubs.c
Normal file
|
|
@ -0,0 +1,67 @@
|
||||||
|
#include <caml/alloc.h>
|
||||||
|
#include <caml/mlvalues.h>
|
||||||
|
#include <stdint.h>
|
||||||
|
|
||||||
|
/* FNV-1 hash for a 64-bit integer.
|
||||||
|
https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function
|
||||||
|
|
||||||
|
FNV-1 order: multiply then XOR (as opposed to FNV-1a which XORs first).
|
||||||
|
Uses the standard 64-bit FNV parameters:
|
||||||
|
offset_basis = 0xcbf29ce484222325
|
||||||
|
prime = 0x00000100000001b3
|
||||||
|
|
||||||
|
Core routine: operates on all 8 bytes of an int64_t. */
|
||||||
|
|
||||||
|
static inline int64_t cc_fnv_hash_int64(int64_t n) {
|
||||||
|
uint64_t un = (uint64_t)n;
|
||||||
|
uint64_t h = UINT64_C(0xcbf29ce484222325);
|
||||||
|
const uint64_t prime = UINT64_C(0x100000001b3);
|
||||||
|
for (int k = 0; k < 8; k++) {
|
||||||
|
h *= prime;
|
||||||
|
h ^= (un >> (k * 8)) & 0xff;
|
||||||
|
}
|
||||||
|
return (int64_t)h;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* --- CCInt.hash entry points (int -> int) --- */
|
||||||
|
|
||||||
|
/* Mask to the OCaml int range (63 bits on 64-bit, 31 on 32-bit)
|
||||||
|
before hashing, so negative OCaml ints hash the same as
|
||||||
|
the unsigned representation seen by OCaml's [lsr]. */
|
||||||
|
#define OCAML_INT_MASK ((UINT64_C(1) << (8 * sizeof(value) - 1)) - 1)
|
||||||
|
|
||||||
|
/* native: untagged int in, untagged int out */
|
||||||
|
CAMLprim intnat caml_cc_hash_int(intnat n) {
|
||||||
|
int64_t projected = (int64_t)((uint64_t)n & OCAML_INT_MASK);
|
||||||
|
return (intnat)((uint64_t)cc_fnv_hash_int64(projected) & Max_long);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* bytecode: boxed value in, boxed value out */
|
||||||
|
CAMLprim value caml_cc_hash_int_byte(value v_n) {
|
||||||
|
return Val_long(caml_cc_hash_int(Long_val(v_n)));
|
||||||
|
}
|
||||||
|
|
||||||
|
/* --- int64 hash entry points (int64 -> int) --- */
|
||||||
|
|
||||||
|
/* native: unboxed int64 in, untagged int out */
|
||||||
|
CAMLprim intnat caml_cc_hash_int64(int64_t n) {
|
||||||
|
return (intnat)((uint64_t)cc_fnv_hash_int64(n) & Max_long);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* bytecode: boxed int64 value in, boxed value out */
|
||||||
|
CAMLprim value caml_cc_hash_int64_byte(value v_n) {
|
||||||
|
return Val_long(caml_cc_hash_int64(Int64_val(v_n)));
|
||||||
|
}
|
||||||
|
|
||||||
|
/* --- int64 -> int64 entry points (for hash_to_int64) --- */
|
||||||
|
|
||||||
|
/* native: unboxed int64 in, unboxed int64 out.
|
||||||
|
Masks to non-negative int64 (matches OCaml's Int64.max_int). */
|
||||||
|
CAMLprim int64_t caml_cc_hash_int64_to_int64(int64_t n) {
|
||||||
|
return cc_fnv_hash_int64(n) & INT64_MAX;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* bytecode: boxed int64 in, boxed int64 out */
|
||||||
|
CAMLprim value caml_cc_hash_int64_to_int64_byte(value v_n) {
|
||||||
|
return caml_copy_int64(cc_fnv_hash_int64(Int64_val(v_n)) & INT64_MAX);
|
||||||
|
}
|
||||||
|
|
@ -6,6 +6,10 @@
|
||||||
(action
|
(action
|
||||||
(run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
|
(run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
|
||||||
(flags :standard -nolabels -open CCMonomorphic)
|
(flags :standard -nolabels -open CCMonomorphic)
|
||||||
|
(foreign_stubs
|
||||||
|
(language c)
|
||||||
|
(flags :standard -std=c99 -O2)
|
||||||
|
(names cc_stubs))
|
||||||
(libraries either containers.monomorphic containers.domain))
|
(libraries either containers.monomorphic containers.domain))
|
||||||
|
|
||||||
(ocamllex
|
(ocamllex
|
||||||
|
|
|
||||||
|
|
@ -101,3 +101,42 @@ eq' 63 (popcount max_int);;
|
||||||
eq' 1 (popcount min_int);;
|
eq' 1 (popcount min_int);;
|
||||||
eq' 10 (popcount 0b1110010110110001010L);;
|
eq' 10 (popcount 0b1110010110110001010L);;
|
||||||
eq' 5 (popcount 0b1101110000000000L)
|
eq' 5 (popcount 0b1101110000000000L)
|
||||||
|
|
||||||
|
(* hash tests *)
|
||||||
|
let ( >= ) = Stdlib.( >= )
|
||||||
|
let ( = ) = Stdlib.( = )
|
||||||
|
let ( <> ) = Stdlib.( <> );;
|
||||||
|
|
||||||
|
(* hash is non-negative *)
|
||||||
|
t @@ fun () -> hash 0L >= 0;;
|
||||||
|
t @@ fun () -> hash 1L >= 0;;
|
||||||
|
t @@ fun () -> hash (-1L) >= 0;;
|
||||||
|
t @@ fun () -> hash max_int >= 0;;
|
||||||
|
t @@ fun () -> hash min_int >= 0;;
|
||||||
|
|
||||||
|
(* hash_to_int64 is non-negative *)
|
||||||
|
t @@ fun () -> CCInt64.compare (hash_to_int64 0L) 0L >= 0;;
|
||||||
|
t @@ fun () -> CCInt64.compare (hash_to_int64 (-1L)) 0L >= 0;;
|
||||||
|
t @@ fun () -> CCInt64.compare (hash_to_int64 min_int) 0L >= 0;;
|
||||||
|
|
||||||
|
(* hash is consistent with hash_to_int64 *)
|
||||||
|
t @@ fun () -> hash 42L = Stdlib.(Int64.to_int (hash_to_int64 42L) land max_int)
|
||||||
|
;;
|
||||||
|
|
||||||
|
t @@ fun () ->
|
||||||
|
hash (-1L) = Stdlib.(Int64.to_int (hash_to_int64 (-1L)) land max_int)
|
||||||
|
;;
|
||||||
|
|
||||||
|
(* different inputs produce different hashes *)
|
||||||
|
t @@ fun () -> hash 0L <> hash 1L;;
|
||||||
|
t @@ fun () -> hash 1L <> hash 2L;;
|
||||||
|
t @@ fun () -> hash 1L <> hash (-1L);;
|
||||||
|
t @@ fun () -> hash_to_int64 0L <> hash_to_int64 1L;;
|
||||||
|
|
||||||
|
(* deterministic *)
|
||||||
|
t @@ fun () -> hash 123L = hash 123L;;
|
||||||
|
t @@ fun () -> hash_to_int64 123L = hash_to_int64 123L;;
|
||||||
|
|
||||||
|
(* quickcheck: hash is always non-negative *)
|
||||||
|
q Q.(map Int64.of_int int) (fun n -> hash n >= 0);;
|
||||||
|
q Q.(map Int64.of_int int) (fun n -> CCInt64.compare (hash_to_int64 n) 0L >= 0)
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue