From 8939c3ee987aaaa3b65fd1bde9fa26dc9152f77d Mon Sep 17 00:00:00 2001 From: Calascibetta Romain Date: Fri, 15 Sep 2023 10:25:38 +0200 Subject: [PATCH 1/2] Delete reverse bindings which is not used --- bindings/generator/dune | 3 - bindings/generator/generate.ml | 33 --------- bindings/stubs/apply_bindings.ml | 1 - bindings/stubs/decompress.ml | 1 - bindings/stubs/dune | 31 --------- bindings/stubs/gen_decompress_bindings.ml | 82 ----------------------- bindings/stubs/init.c | 9 --- decompress.opam | 1 - test/bin/bindings.t | 30 --------- test/bin/dune | 13 +--- test/bin/native_c_libraries.ml | 32 --------- 11 files changed, 1 insertion(+), 235 deletions(-) delete mode 100644 bindings/generator/dune delete mode 100644 bindings/generator/generate.ml delete mode 100644 bindings/stubs/apply_bindings.ml delete mode 100644 bindings/stubs/decompress.ml delete mode 100644 bindings/stubs/dune delete mode 100644 bindings/stubs/gen_decompress_bindings.ml delete mode 100644 bindings/stubs/init.c delete mode 100644 test/bin/bindings.t delete mode 100644 test/bin/native_c_libraries.ml diff --git a/bindings/generator/dune b/bindings/generator/dune deleted file mode 100644 index f85a9983..00000000 --- a/bindings/generator/dune +++ /dev/null @@ -1,3 +0,0 @@ -(executable - (name generate) - (libraries ctypes.stubs gen_decompress_bindings)) diff --git a/bindings/generator/generate.ml b/bindings/generator/generate.ml deleted file mode 100644 index 1c7f8530..00000000 --- a/bindings/generator/generate.ml +++ /dev/null @@ -1,33 +0,0 @@ -let generate dirname = - let prefix = "decompress" in - let path basename = Filename.concat dirname basename in - let ml_fd = open_out (path "decompress_bindings.ml") in - let c_fd = open_out (path "gen_decompress.c") in - let h_fd = open_out (path "decompress.h") in - let stubs = - (module Gen_decompress_bindings.Stubs : Cstubs_inverted.BINDINGS) in - - Cstubs_inverted.write_ml (Format.formatter_of_out_channel ml_fd) ~prefix stubs - ; Format.fprintf - (Format.formatter_of_out_channel c_fd) - "#include \"decompress.h\"@\n %a%!" - (Cstubs_inverted.write_c ~prefix) - stubs - ; Format.fprintf - (Format.formatter_of_out_channel h_fd) - "#if defined(__cplusplus)@\n\ - \ extern \"C\" {@\n\ - \ #endif@\n\ - \ %a@\n\ - \ #if defined(__cplusplus)@\n\ - \ }@\n\ - \ #endif@\n\ - %!" - (Cstubs_inverted.write_c_header ~prefix) - stubs - - ; close_out h_fd - ; close_out c_fd - ; close_out ml_fd - -let () = generate Sys.argv.(1) diff --git a/bindings/stubs/apply_bindings.ml b/bindings/stubs/apply_bindings.ml deleted file mode 100644 index 9d62e18b..00000000 --- a/bindings/stubs/apply_bindings.ml +++ /dev/null @@ -1 +0,0 @@ -include Gen_decompress_bindings.Stubs (Decompress_bindings) diff --git a/bindings/stubs/decompress.ml b/bindings/stubs/decompress.ml deleted file mode 100644 index f1c42269..00000000 --- a/bindings/stubs/decompress.ml +++ /dev/null @@ -1 +0,0 @@ -module Apply_bindings = Apply_bindings diff --git a/bindings/stubs/dune b/bindings/stubs/dune deleted file mode 100644 index 1db6b5e7..00000000 --- a/bindings/stubs/dune +++ /dev/null @@ -1,31 +0,0 @@ -(rule - (targets decompress_bindings.ml gen_decompress.c decompress.h) - (action - (run ../generator/generate.exe .))) - -(library - (name gen_decompress_bindings) - (modules gen_decompress_bindings) - (wrapped false) - (libraries decompress.de decompress.zl ctypes.stubs)) - -(executable - (name decompress) - (modules decompress apply_bindings decompress_bindings) - (forbidden_libraries unix) - (flags - (:standard -w -27)) - (foreign_stubs - (language c) - (names init gen_decompress)) - (ocamlopt_flags -ccopt -static) - (modes - (native object)) - (libraries gen_decompress_bindings checkseum.c ctypes.stubs)) - -(rule - (targets libdecompress.a) - (package decompress) - (deps %{exe:decompress.exe.o}) - (action - (run ar r %{targets} decompress.exe.o))) diff --git a/bindings/stubs/gen_decompress_bindings.ml b/bindings/stubs/gen_decompress_bindings.ml deleted file mode 100644 index d2e82284..00000000 --- a/bindings/stubs/gen_decompress_bindings.ml +++ /dev/null @@ -1,82 +0,0 @@ -open Ctypes - -let inflate i i_len o o_len = - let i = bigarray_of_ptr array1 i_len Bigarray.char i in - let o = bigarray_of_ptr array1 o_len Bigarray.char o in - let rec trail decoder res = - match Zl.Inf.decode decoder with - | `End decoder -> - if Zl.Inf.dst_rem decoder = o_len then res - else invalid_arg "Too small output buffer" - | `Flush _ -> invalid_arg "Too small output buffer" - | `Await _ -> assert false - | `Malformed err -> invalid_arg err - and go decoder = - match Zl.Inf.decode decoder with - | `Await _ -> assert false - | `Flush decoder -> - trail (Zl.Inf.flush decoder) (o_len - Zl.Inf.dst_rem decoder) - | `Malformed err -> invalid_arg err - | `End decoder -> o_len - Zl.Inf.dst_rem decoder in - let decoder = - Zl.Inf.decoder `Manual ~o ~allocate:(fun bits -> De.make_window ~bits) in - let decoder = Zl.Inf.src decoder i 0 i_len in - go decoder - -let deflate i i_len o o_len level = - let i = bigarray_of_ptr array1 i_len Bigarray.char i in - let o = bigarray_of_ptr array1 o_len Bigarray.char o in - let q = De.Queue.create 0x10000 in - let w = De.Lz77.make_window ~bits:15 in - let i_pos = ref 0 in - let o_pos = ref 0 in - let rec go encoder = - match Zl.Def.encode encoder with - | `Await encoder -> - let len = i_len - !i_pos and p = !i_pos in - i_pos := !i_pos + len - ; go (Zl.Def.src encoder i p len) - | `Flush encoder -> - let len = o_len - !o_pos - Zl.Def.dst_rem encoder in - o_pos := !o_pos + len - ; go (Zl.Def.dst encoder o !o_pos (o_len - !o_pos)) - | `End encoder -> - let len = o_len - !o_pos - Zl.Def.dst_rem encoder in - !o_pos + len in - let encoder = Zl.Def.encoder `Manual `Manual ~q ~w ~level in - let encoder = Zl.Def.dst encoder o 0 o_len in - go encoder - -let inflate_ns i i_len o o_len = - let i = bigarray_of_ptr array1 i_len Bigarray.char i in - let o = bigarray_of_ptr array1 o_len Bigarray.char o in - let res = De.Inf.Ns.inflate i o in - match res with Ok (_, res) -> res | Error _ -> invalid_arg "broken" - -let deflate_ns i i_len o o_len level = - let i = bigarray_of_ptr array1 i_len Bigarray.char i in - let o = bigarray_of_ptr array1 o_len Bigarray.char o in - let res = De.Def.Ns.deflate ~level i o in - match res with Ok res -> res | Error _ -> invalid_arg "broken" - -module Stubs (I : Cstubs_inverted.INTERNAL) = struct - let () = - I.internal "decompress_inflate" - (ptr char @-> int @-> ptr char @-> int @-> returning int) - inflate - - let () = - I.internal "decompress_deflate" - (ptr char @-> int @-> ptr char @-> int @-> int @-> returning int) - deflate - - let () = - I.internal "decompress_ns_inflate" - (ptr char @-> int @-> ptr char @-> int @-> returning int) - inflate_ns - - let () = - I.internal "decompress_ns_deflate" - (ptr char @-> int @-> ptr char @-> int @-> int @-> returning int) - deflate_ns -end diff --git a/bindings/stubs/init.c b/bindings/stubs/init.c deleted file mode 100644 index bacddc86..00000000 --- a/bindings/stubs/init.c +++ /dev/null @@ -1,9 +0,0 @@ -#include - -__attribute__ ((__constructor__)) -void -init(void) -{ - char *caml_argv[1] = { NULL }; - caml_startup(caml_argv); -} diff --git a/decompress.opam b/decompress.opam index 60797b2b..4dceb819 100644 --- a/decompress.opam +++ b/decompress.opam @@ -24,7 +24,6 @@ depends: [ "checkseum" {>= "0.2.0"} "bigstringaf" {with-test} "alcotest" {with-test} - "ctypes" {with-test & >= "0.18.0"} "fmt" {with-test & >= "0.8.7"} "camlzip" {>= "1.10" & with-test} "base64" {>= "3.0.0" & with-test} diff --git a/test/bin/bindings.t b/test/bin/bindings.t deleted file mode 100644 index d9d7dcd2..00000000 --- a/test/bin/bindings.t +++ /dev/null @@ -1,30 +0,0 @@ -Test reverse bindings - $ cat >main.c < #include - > #include - > #include - > #include - > #include "decompress.h" - > - > int main() { - > char i[] = "Hello World!" ; - > char *o = malloc(0x1000) ; - > char *r = malloc(strlen(i) + 1) ; - > - > memset(o, 0, 0x1000); - > memset(r, 0, strlen(i)); - > - > int res0 = decompress_deflate(i, strlen(i) + 1, o, 0x1000, 6); - > int res1 = decompress_inflate(o, res0, r, strlen(i) + 1); - > - > printf("%s\n", r); - > fflush(stdout); - > - > return (0); - > } - > EOF - $ ./native_c_libraries.exe > ldflags - $ cc -o a.out main.c -I$(ocamlopt -where) -L../../bindings/stubs -I../../bindings/stubs -ldecompress $(cat ldflags) 2> /dev/null - $ ./a.out - Hello World! - diff --git a/test/bin/dune b/test/bin/dune index 8529f688..104e42da 100644 --- a/test/bin/dune +++ b/test/bin/dune @@ -1,14 +1,3 @@ (cram (package decompress) - (deps - ../corpus/news - ../corpus/bib - ../../bindings/stubs/libdecompress.a - ../../bindings/stubs/decompress.h - zpipe.c - %{bin:decompress} - native_c_libraries.exe)) - -(executable - (name native_c_libraries) - (libraries rresult bos astring)) + (deps ../corpus/news ../corpus/bib zpipe.c %{bin:decompress})) diff --git a/test/bin/native_c_libraries.ml b/test/bin/native_c_libraries.ml deleted file mode 100644 index b420ec13..00000000 --- a/test/bin/native_c_libraries.ml +++ /dev/null @@ -1,32 +0,0 @@ -open Bos -open Astring -open Rresult - -type ('a, 'b) either = Left of 'a | Right of 'b - -let partition_map p l = - let rec part left right = function - | [] -> List.rev left, List.rev right - | x :: l -> begin - match p x with - | Left v -> part (v :: left) right l - | Right v -> part left (v :: right) l - end in - part [] [] l - -let run () = - OS.Cmd.run_out Cmd.(v "ocamlc" % "-config") |> OS.Cmd.out_string - >>= fun (cfg, _) -> - let cfg = String.cuts ~sep:"\n" cfg in - let cfg = List.map (String.cut ~sep:":") cfg in - let cfg, _ = - partition_map (function Some (k, v) -> Left (k, v) | None -> Right ()) cfg - in - match List.assoc_opt "native_c_libraries" cfg with - | Some v -> Ok v - | None -> Error (`Msg "native_c_libraries key not found") - -let () = - match run () with - | Ok v -> print_endline v ; exit 0 - | Error (`Msg err) -> Format.eprintf "%s: %s.\n%!" Sys.argv.(0) err From b5386fc3c0a99f028f4675d05caf9eb82de5fcc3 Mon Sep 17 00:00:00 2001 From: Calascibetta Romain Date: Fri, 15 Sep 2023 10:25:53 +0200 Subject: [PATCH 2/2] Update benchmark (cmdliner) --- bench/densld.ml | 6 +++--- bench/dune | 10 ++++------ 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/bench/densld.ml b/bench/densld.ml index 0132ad57..ed6437a9 100644 --- a/bench/densld.ml +++ b/bench/densld.ml @@ -21,7 +21,7 @@ let d = Arg.(value & flag & info ["d"] ~doc) let cmd = - ( Term.(const inflate $ file $ d) - , Term.info "bench" ~doc:"Run benchmarks for ns implementation" ) + let info = Cmd.info "bench" ~doc:"Run benchmarks for ns implementation" in + Cmd.v info Term.(const inflate $ file $ d) -let () = Term.(exit @@ eval cmd) +let () = Cmd.(exit @@ eval cmd) diff --git a/bench/dune b/bench/dune index 43e71557..20536460 100644 --- a/bench/dune +++ b/bench/dune @@ -14,8 +14,8 @@ decompress.de decompress.zl cmdliner - yojson - ppx_deriving_yojson)) + ppx_deriving_yojson.runtime + yojson)) (executable (name run) @@ -46,13 +46,12 @@ (library (name lz_landmarks) - (optional) (modules lz_landmarks) (enabled_if (= %{profile} benchmark)) (libraries checkseum optint landmarks de) (preprocess - (pps landmarks.ppx --auto))) + (pps landmarks-ppx --auto))) (rule (copy ../lib/lz.ml lz_landmarks.ml)) @@ -69,7 +68,6 @@ (library (name de_landmarks) - (optional) (modules de_landmarks) (enabled_if (= %{profile} benchmark)) @@ -77,7 +75,7 @@ (flags (:standard -w -55)) (preprocess - (pps landmarks.ppx --auto))) + (pps landmarks-ppx --auto))) (rule (copy ../lib/de.ml de_landmarks.ml))