From a59f01e145f3c4cef22561739be60a5fe375f425 Mon Sep 17 00:00:00 2001 From: Ilias Garnier Date: Mon, 1 Aug 2022 09:39:18 +0200 Subject: [PATCH 1/3] lib_benchmark: fix bug in Csv.concat --- src/lib_benchmark/csv.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/lib_benchmark/csv.ml b/src/lib_benchmark/csv.ml index af998fc60705..3c83c4abc875 100644 --- a/src/lib_benchmark/csv.ml +++ b/src/lib_benchmark/csv.ml @@ -37,14 +37,14 @@ let concat (csv1 : csv) (csv2 : csv) : csv = if Compare.List_lengths.(csv1 <> csv2) then Stdlib.failwith "Csv.concat: CSVs have different length" else - (* Check that each CSV has the same number of *) + (* Check that each line has the same number of columns *) let lengths1 = List.map List.length csv1 in - let lengths2 = List.map List.length csv1 in + let lengths2 = List.map List.length csv2 in if not (all_equal lengths1) then let msg = "Csv.concat: first argument has uneven # of lines" in Stdlib.failwith msg else if not (all_equal lengths2) then - let msg = "Csv.concat: first argument has uneven # of lines" in + let msg = "Csv.concat: second argument has uneven # of lines" in Stdlib.failwith msg else (* see top if condition *) -- GitLab From fbcdb7fcc7d6c41e05bd711d58729a90c0e8dbc6 Mon Sep 17 00:00:00 2001 From: Ilias Garnier Date: Mon, 1 Aug 2022 09:48:27 +0200 Subject: [PATCH 2/3] lib_benchmark: use {In,Out}_channel --- src/lib_benchmark/codegen.ml | 14 ++------------ src/lib_benchmark/csv.ml | 16 +++++----------- 2 files changed, 7 insertions(+), 23 deletions(-) diff --git a/src/lib_benchmark/codegen.ml b/src/lib_benchmark/codegen.ml index ccda7170317a..2378d4dd8073 100644 --- a/src/lib_benchmark/codegen.ml +++ b/src/lib_benchmark/codegen.ml @@ -133,20 +133,10 @@ module Lift_then_print = Costlang.Let_lift (Codegen) type solution = float Free_variable.Map.t let load_solution (fn : string) : solution = - let infile = open_in fn in - try - let res = Marshal.from_channel infile in - close_in infile ; - res - with exn -> - close_in infile ; - Format.eprintf "Codegen.load_solution: could not load %s@." fn ; - raise exn + In_channel.with_open_bin fn Marshal.from_channel let save_solution (s : solution) (fn : string) = - let outfile = open_out fn in - Marshal.to_channel outfile s [] ; - close_out outfile + Out_channel.with_open_bin fn @@ fun outfile -> Marshal.to_channel outfile s [] (* ------------------------------------------------------------------------- *) diff --git a/src/lib_benchmark/csv.ml b/src/lib_benchmark/csv.ml index 3c83c4abc875..eb7e76fdef24 100644 --- a/src/lib_benchmark/csv.ml +++ b/src/lib_benchmark/csv.ml @@ -57,7 +57,7 @@ let concat (csv1 : csv) (csv2 : csv) : csv = let export ~filename ?(separator = ',') ?(linebreak = '\n') (data : csv) = Format.eprintf "Exporting to %s@." filename ; let sep_str = String.make 1 separator in - let outfile = open_out filename in + Out_channel.with_open_text filename @@ fun outfile -> let fmtr = Format.formatter_of_out_channel outfile in List.iter (fun line -> @@ -66,20 +66,14 @@ let export ~filename ?(separator = ',') ?(linebreak = '\n') (data : csv) = | _ -> let s = String.concat sep_str line in Format.fprintf fmtr "%s%c@?" s linebreak) - data ; - close_out outfile + data -(* shamelessly stolen from - https://stackoverflow.com/questions/5774934/how-do-i-read-in-lines-from-a-text-file-in-ocaml *) let read_lines name : string list = - let ic = open_in name in - let try_read () = try Some (input_line ic) with End_of_file -> None in + In_channel.with_open_text name @@ fun ic -> let rec loop acc = - match try_read () with + match In_channel.input_line ic with | Some s -> loop (s :: acc) - | None -> - close_in ic ; - List.rev acc + | None -> List.rev acc in loop [] -- GitLab From 5d8a76f21c81856c9afec07aefc8ff3882905eef Mon Sep 17 00:00:00 2001 From: Ilias Garnier Date: Mon, 1 Aug 2022 11:30:15 +0200 Subject: [PATCH 3/3] lib_benchmark: check CSV header disjointness before concat --- src/lib_benchmark/csv.ml | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/src/lib_benchmark/csv.ml b/src/lib_benchmark/csv.ml index eb7e76fdef24..8fd58ab95c8d 100644 --- a/src/lib_benchmark/csv.ml +++ b/src/lib_benchmark/csv.ml @@ -31,8 +31,18 @@ let all_equal (l : int list) = in match l with [] -> true | hd :: tl -> loop tl hd +module String_set = Set.Make (String) + +let disjoint_headers (csv1 : csv) (csv2 : csv) = + match (csv1, csv2) with + | [], _ | _, [] -> true + | header1 :: _, header2 :: _ -> + let header1 = String_set.of_list header1 in + let header2 = String_set.of_list header2 in + String_set.disjoint header1 header2 + (* Horizontally concat CSVs *) -let concat (csv1 : csv) (csv2 : csv) : csv = +let concat ?(check_disjoint_headers = true) (csv1 : csv) (csv2 : csv) : csv = (* Check that both CSVs have the same number of lines. *) if Compare.List_lengths.(csv1 <> csv2) then Stdlib.failwith "Csv.concat: CSVs have different length" @@ -46,6 +56,9 @@ let concat (csv1 : csv) (csv2 : csv) : csv = else if not (all_equal lengths2) then let msg = "Csv.concat: second argument has uneven # of lines" in Stdlib.failwith msg + else if check_disjoint_headers && not (disjoint_headers csv1 csv2) then + let msg = "Csv.concat: headers are not disjoint" in + Stdlib.failwith msg else (* see top if condition *) WithExceptions.List.map2 -- GitLab