From: Stephane Glondu Date: Sat, 21 Jan 2023 08:55:03 +0000 (+0100) Subject: New upstream version 0.9 X-Git-Tag: archive/raspbian/0.10-1+rpi1~1^2~6^2~1 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=e990ec3f1fb1c66e95e994005408fdf31ff02e33;p=ocaml-eqaf.git New upstream version 0.9 --- diff --git a/.cirrus.yml b/.cirrus.yml index 5caf7b8..2813ab6 100644 --- a/.cirrus.yml +++ b/.cirrus.yml @@ -4,9 +4,9 @@ freebsd_instance: freebsd_task: env: matrix: - - OCAML_VERSION: 4.10.1 - OCAML_VERSION: 4.11.1 - pkg_install_script: pkg install -y ocaml-opam gmp gmake pkgconf bash + - OCAML_VERSION: 4.12.0 + pkg_install_script: pkg install -y ocaml-opam gmake bash ocaml_script: opam init -a --comp=$OCAML_VERSION dependencies_script: eval `opam env` && opam install -y --deps-only . build_script: eval `opam env` && dune build @install diff --git a/.ocamlformat b/.ocamlformat index 94f7d43..5ea8ce8 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,2 +1,2 @@ -version=0.18.0 +version=0.21.0 disable=true diff --git a/CHANGES.md b/CHANGES.md index 03816f6..f0f9865 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,9 @@ +### v0.9 2022-07-24 Paris (France) + +- Add support of OCaml 5.00 (@kit-ty-kate, #37) +- Add support for current-bench and fix bad r² for unequal strings (@Zined-Ada, @art-w, #38) +- Add benchmark with `bechamel` (@Zineb-Ada, @art-w, #38) + ### v0.8 2021-08-06 Paris (France) - Fix the check tool on 4.11.0 (@dinosaure, @cfcs, @stedolan, #30) diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..eeeb261 --- /dev/null +++ b/Makefile @@ -0,0 +1,4 @@ +.PHONY: bench +bench: + dune exec check/check.exe + dune exec check/bench.exe \ No newline at end of file diff --git a/check/bench.ml b/check/bench.ml new file mode 100644 index 0000000..c5c3d03 --- /dev/null +++ b/check/bench.ml @@ -0,0 +1,137 @@ +let seed = "4EygbdYh+v35vvrmD9YYP4byT5E3H7lTeXJiIj+dQnc=" +let seed = Base64.decode_exn seed + +let seed = + let res = Array.make (String.length seed / 2) 0 in + for i = 0 to (String.length seed / 2) - 1 do + res.(i) <- (Char.code seed.[i * 2] lsl 8) lor Char.code seed.[(i * 2) + 1] + done; + res + +let () = + let random_seed = seed in + Random.full_init random_seed + +let random length = + let get _ = + match Random.int (10 + 26 + 26) with + | n when n < 10 -> Char.(chr (code '0' + n)) + | n when n < 10 + 26 -> Char.(chr (code 'a' + n - 10)) + | n -> Char.(chr (code 'A' + n - 10 - 26)) + in + String.init length get + +open Bechamel +open Toolkit + +let hash_eq_0 = random 4096 +let hash_eq_1 = Bytes.to_string (Bytes.of_string hash_eq_0) +let chr_into_hash_eq_0 = hash_eq_0.[Random.int 4096] +let hash_neq_0 = random 4096 + +let hash_neq_1 = + let rec go limit = + if limit <= 0 then failwith "Impossible to generate different hashes."; + let res = random 4096 in + if res = hash_neq_0 then go (pred limit) else res + in + go 10 + +let random_chr = + let rec go limit = + if limit <= 0 then + failwith + "Impossible to generate a byte which does not appear into hash_neq_0."; + let res = Char.chr (Random.int 256) in + if not (String.contains hash_neq_0 res) then res else go (pred limit) + in + go 10 + +let test_equal0 = + Test.make ~name:"equal" + (Staged.stage @@ fun () -> Eqaf.equal hash_eq_0 hash_eq_1) + +let test_equal1 = + Test.make ~name:"not equal" + (Staged.stage @@ fun () -> Eqaf.equal hash_neq_0 hash_neq_1) + +let cfg = Benchmark.cfg ~start:100 + +let test_compare0 = + Test.make ~name:"equal" + (Staged.stage @@ fun () -> Eqaf.compare_be hash_eq_0 hash_eq_1) +let test_compare1 = + Test.make ~name:"not equal" + (Staged.stage @@ fun () -> Eqaf.compare_be hash_neq_0 hash_neq_1) + +let f_eq_0 (v : int) = v = Char.code chr_into_hash_eq_0 +let f_neq_0 (v : int) = v = Char.code random_chr + +let test_exists0 = + Test.make ~name:"equal" + (Staged.stage @@ fun () -> Eqaf.exists_uint8 ~f:f_eq_0 hash_eq_0) +let test_exists1 = + Test.make ~name:"not equal" + (Staged.stage @@ fun () -> Eqaf.exists_uint8 ~f:f_neq_0 hash_neq_0) + +let f_hash_eq_0 (v : int) = v = Char.code chr_into_hash_eq_0 +let f_random (v : int) = v = Char.code random_chr + +let test_find0 = + Test.make ~name:"equal" + (Staged.stage @@ fun () -> Eqaf.find_uint8 ~f:f_hash_eq_0 hash_eq_0) +let test_find1 = + Test.make ~name:"not equal" + (Staged.stage @@ fun () -> Eqaf.find_uint8 ~f:f_random hash_neq_0) + +let benchmark () = + let ols = + Analyze.ols ~bootstrap:0 ~r_square:true ~predictors:Measure.[| run |] + in + let instances = + Instance.[ monotonic_clock ] + in + let cfg = + Benchmark.cfg ~limit:2000 ~stabilize:true ~quota:(Time.second 1.) + ~start:1000 ~kde:(Some 1000) () + in + let test_equal = + Test.make_grouped ~name:"equal" ~fmt:"%s %s" + [ test_equal0; test_equal1 ] + in + let test_compare = + Test.make_grouped ~name:"compare" ~fmt:"%s %s" + [ test_compare0; test_compare1 ] + in + let test_exists = + Test.make_grouped ~name:"exists" ~fmt:"%s %s" + [ test_exists0; test_exists1 ] + in + let test_find = + Test.make_grouped ~name:"find" ~fmt:"%s %s" + [ test_find0; test_find1 ] + in + let raw_results = + Benchmark.all cfg instances + (Test.make_grouped ~name:"benchmark" ~fmt:"%s %s" + [ test_equal; test_compare; test_exists; test_find ]) + in + let results = + List.map (fun instance -> Analyze.all ols instance raw_results) instances + in + let pr_bench name value = + Format.printf + {|{"results": [{"name": "eqaf", "metrics": [{"name": "%s", "value": %f, "units": "ns"}]}]}@.|} + name value + in + let results = Analyze.merge ols instances results in + let timings = Hashtbl.find results "monotonic-clock" in + Hashtbl.iter + (fun c v -> + match Analyze.OLS.estimates v with + | None -> () + | Some ts -> List.iter (pr_bench c) ts) + timings; + () + +let () = benchmark () \ No newline at end of file diff --git a/check/check.ml b/check/check.ml index fd681c1..dcbda49 100644 --- a/check/check.ml +++ b/check/check.ml @@ -311,8 +311,11 @@ module Equal = Make(struct let reset = ignore and switch = ignore let stdlib_true () = String.equal hash_eq_0 hash_eq_1 - let stdlib_false () = String.equal hash_neq_0 hash_neq_1 - + let stdlib_false () = + for _ = 1 to 100 + do let _ = String.equal hash_neq_0 hash_neq_1 in () done ; + String.equal hash_neq_0 hash_neq_1 + let eqaf_true () = Eqaf.equal hash_eq_0 hash_eq_1 let eqaf_false () = Eqaf.equal hash_neq_0 hash_neq_1 end) @@ -326,7 +329,10 @@ module Compare = Make(struct let reset = ignore and switch = ignore let stdlib_true () = String.compare hash_eq_0 hash_eq_1 - let stdlib_false () = String.compare hash_neq_0 hash_neq_1 + let stdlib_false () = + for _ = 1 to 100 + do let _ = String.compare hash_neq_0 hash_neq_1 in () done ; + String.compare hash_neq_0 hash_neq_1 let eqaf_true () = Eqaf.compare_be hash_eq_0 hash_eq_1 let eqaf_false () = Eqaf.compare_be hash_neq_0 hash_neq_1 @@ -462,16 +468,23 @@ let () = if tried > 20 then invalid_arg "Too many tried for Eqaf.divmod" ; let res = Divmod32.test () in if res = exit_success then tried else _4 (succ tried) in - + let pr_bench name value = + Fmt.pr {|{"results": [{"name": "check", "metrics": [{"name": "%s", "value": %d}]}]}@.|} name value in + let _0 = _0 1 in Fmt.pr "%d trial(s) for Eqaf.equal.\n%!" _0 ; + pr_bench "equal" _0 ; let _1 = _1 1 in Fmt.pr "%d trial(s) for Eqaf.compare.\n%!" _1 ; + pr_bench "compare" _1 ; let _2 = _2 1 in Fmt.pr "%d trial(s) for Eqaf.exists.\n%!" _2 ; + pr_bench "exists" _2 ; let _3 = _3 1 in Fmt.pr "%d trial(s) for Eqaf.find_uint8.\n%!" _3 ; + pr_bench "find_uint8" _3 ; let _4 = _4 1 in - Fmt.pr "%d trial(s) for Eqaf.divmod.\n%!" _3 ; + Fmt.pr "%d trial(s) for Eqaf.divmod.\n%!" _4 ; + pr_bench "divmod" _4 ; - exit exit_success + exit exit_success \ No newline at end of file diff --git a/check/dune b/check/dune index 81d7c33..cc72a59 100644 --- a/check/dune +++ b/check/dune @@ -3,6 +3,11 @@ (modules check linear_algebra benchmark fmt unsafe) (libraries eqaf base64 clock)) +(executable + (name bench) + (modules bench) + (libraries bechamel eqaf base64)) + (rule (copy %{read:../config/which-unsafe-file} unsafe.ml)) diff --git a/clock/clock_linux_stubs.c b/clock/clock_linux_stubs.c index 479275e..f039268 100644 --- a/clock/clock_linux_stubs.c +++ b/clock/clock_linux_stubs.c @@ -1,3 +1,5 @@ +#define CAML_NAME_SPACE + #include #include #include @@ -22,7 +24,7 @@ clock_linux_get_time_byte(__unit ()) if (clock_gettime(CLOCK_MONOTONIC, &ts)) caml_invalid_argument("clock: unsupported clock"); - return copy_int64(ts.tv_sec * 1000000000LL + ts.tv_nsec); + return caml_copy_int64(ts.tv_sec * 1000000000LL + ts.tv_nsec); } // XXX(dinosaure): commented because to be able to compile the test into any diff --git a/clock/clock_mach_stubs.c b/clock/clock_mach_stubs.c index 245697f..22f997c 100644 --- a/clock/clock_mach_stubs.c +++ b/clock/clock_mach_stubs.c @@ -31,5 +31,5 @@ clock_mach_get_time(value unit) now = mach_absolute_time(); - return copy_int64(now * s.numer / s.denom); + return caml_copy_int64(now * s.numer / s.denom); } diff --git a/clock/clock_windows_stubs.c b/clock/clock_windows_stubs.c index 9784b93..6308cce 100644 --- a/clock/clock_windows_stubs.c +++ b/clock/clock_windows_stubs.c @@ -24,7 +24,7 @@ clock_windows_get_time(value unit) QueryPerformanceCounter(&now); - res = copy_int64(now.QuadPart * frequency.QuadPart); + res = caml_copy_int64(now.QuadPart * frequency.QuadPart); CAMLreturn(res); } diff --git a/dune-project b/dune-project index 8c97908..aa2d0b3 100644 --- a/dune-project +++ b/dune-project @@ -1,3 +1,3 @@ (lang dune 2.0) (name eqaf) -(version v0.8) +(version v0.9) diff --git a/eqaf.opam b/eqaf.opam index 1db0219..2ea638b 100644 --- a/eqaf.opam +++ b/eqaf.opam @@ -1,4 +1,4 @@ -version: "0.8" +version: "0.9" opam-version: "2.0" maintainer: [ "Romain Calascibetta " ] authors: [ "Romain Calascibetta " ] @@ -25,4 +25,6 @@ depends: [ "base64" {with-test} "alcotest" {with-test} "crowbar" {with-test} + "fmt" {with-test & >= "0.8.7"} + "bechamel" {with-test} ] \ No newline at end of file diff --git a/test/test.ml b/test/test.ml index c08e349..9c34739 100644 --- a/test/test.ml +++ b/test/test.ml @@ -11,44 +11,44 @@ let of_expected = function let value w = Alcotest.testable Fmt.int (equal w) let be a b expected = - let title = Fmt.strf "be %S %S = %d" a b expected in + let title = Fmt.str "be %S %S = %d" a b expected in Alcotest.test_case title `Quick @@ fun () -> let expected' = String.compare a b in Alcotest.(check (value (of_expected expected))) "result" (Eqaf.compare_be a b) expected ; Alcotest.(check (value (of_expected expected'))) "string.compare" (Eqaf.compare_be a b) expected' let le a b expected = - let title = Fmt.strf "le %S %S = %d" a b expected in + let title = Fmt.str "le %S %S = %d" a b expected in Alcotest.test_case title `Quick @@ fun () -> Alcotest.(check (value (of_expected expected))) "result" (Eqaf.compare_le a b) expected let exists str chr exists = - Alcotest.test_case (Fmt.strf "contains %S %c = %b" str chr exists) `Quick @@ fun () -> + Alcotest.test_case (Fmt.str "contains %S %c = %b" str chr exists) `Quick @@ fun () -> let res = Eqaf.exists_uint8 ~f:((=) (Char.code chr)) str in Alcotest.(check bool) "result" res exists let find str chr index = - Alcotest.test_case (Fmt.strf "index %S %c = %d" str chr index) `Quick @@ fun () -> + Alcotest.test_case (Fmt.str "index %S %c = %d" str chr index) `Quick @@ fun () -> let res = Eqaf.find_uint8 ~f:((=) (Char.code chr)) str in Alcotest.(check int) "result" res index let int_of_bool bool expect = Alcotest.test_case - (Fmt.strf + (Fmt.str "int_of_bool %B = %d" bool expect ) `Quick @@ fun ()-> Alcotest.(check int) "result" expect (Eqaf.int_of_bool bool) let bool_of_int desc n expect = Alcotest.test_case - (Fmt.strf + (Fmt.str "int_of_bool %s = %B" desc expect ) `Quick @@ fun ()-> Alcotest.(check bool) "result" expect (Eqaf.bool_of_int n) let select_a_if_in_range (low,high) n a b expect = Alcotest.test_case - (Fmt.strf + (Fmt.str "select_a_if_in_range (%d,%d) ~n:%d %d %d" low high n a b ) `Quick @@ fun ()-> @@ -61,7 +61,7 @@ let a_uint32 = Alcotest.testable Fmt.uint32 (=) let divmod str x m q r = (* (x / m = q) and (x mod m = r) *) Alcotest.test_case - (Fmt.strf + (Fmt.str "divmod %s %lu / %lu = %lu, %lu mod %lu = %lu" str x m q x m r ) `Quick @@ fun ()-> @@ -70,7 +70,7 @@ let divmod str x m q r = let ascii_of_int32 str digits n expect = Alcotest.test_case - (Fmt.strf + (Fmt.str "ascii_of_string %s %d %lu %S" str digits n expect ) `Quick @@ fun ()-> @@ -81,7 +81,7 @@ let ascii_of_int32 str digits n expect = let string_of_hex str hex expect = Alcotest.test_case - (Fmt.strf + (Fmt.str " %s %S %S" str hex expect ) `Quick @@ fun ()-> @@ -90,7 +90,7 @@ let string_of_hex str hex expect = let hex_of_string str raw expect = Alcotest.test_case - (Fmt.strf + (Fmt.str " %s %S %S" str raw expect ) `Quick @@ fun ()->