Skip to content

Commit 3b8f7a7

Browse files
S41dredianthus
S41d
authored and
redianthus
committed
refactor bench stuff out of cmd modules
1 parent 101fc29 commit 3b8f7a7

File tree

11 files changed

+177
-207
lines changed

11 files changed

+177
-207
lines changed

‎src/bench.ml‎

Lines changed: 152 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,152 @@
1+
module Unix = struct
2+
include Unix
3+
include Bos.OS.U
4+
end
5+
6+
open Utils.Syntax
7+
8+
let runs tool timeout output_dir max_tests files =
9+
let output_chan =
10+
Fpath.(output_dir / "results") |> Fpath.to_string |> open_out
11+
in
12+
let fmt = Format.formatter_of_out_channel output_chan in
13+
let pp x = Fmt.pf fmt x in
14+
let files = List.sort Fpath.compare files in
15+
let len = List.length files in
16+
let results = ref Runs.empty in
17+
List.iteri
18+
(fun i file ->
19+
let i = succ i in
20+
if i <= max_tests then begin
21+
Logs.app (fun m -> m "%a" (Run.pp_header (min len max_tests)) (i, file));
22+
pp "%a@\n @[<v>" (Run.pp_header (min len max_tests)) (i, file);
23+
let result =
24+
Tool.fork_and_run_on_file ~i ~fmt ~output_dir ~file ~tool ~timeout
25+
|> Utils.ok_or_fail
26+
in
27+
let result = { Run.i; file; res = result } in
28+
results := Runs.add result !results;
29+
Logs.app (fun m -> m " %a@]" Runs.pp_quick_results !results);
30+
pp "%a@]@\n%!" Runs.pp_quick_results !results
31+
end )
32+
files;
33+
!results
34+
35+
let notify_finished runs timeout reference_name output_dir workers =
36+
let open Cohttp in
37+
let open Cohttp_lwt_unix in
38+
let headers =
39+
let headers = Header.init () in
40+
Header.add_list headers
41+
[ ("Content-type", "application/json"); ("User-Agent", "Owibot/1.1") ]
42+
in
43+
let send url body =
44+
let body = Cohttp_lwt.Body.of_string (Yojson.to_string body) in
45+
Client.post ~body ~headers url
46+
in
47+
let head () =
48+
let open Bos in
49+
let cmd = Cmd.(v "git" % "rev-parse" % "--short" % "HEAD") in
50+
let output = OS.Cmd.run_out ~err:OS.Cmd.err_run_out cmd in
51+
match OS.Cmd.out_string ~trim:true output with
52+
| Ok (stdout, (_, `Exited 0)) -> stdout
53+
| Error (`Msg err) ->
54+
Fmt.epr "ERROR: %s@." err;
55+
"unknown"
56+
| Ok (stdout, (_, (`Exited _ | `Signaled _))) ->
57+
Fmt.epr "%s@\nWARN: Unable to fetch git HEAD@." stdout;
58+
"unknown"
59+
in
60+
let text =
61+
Fmt.str
62+
"@[<v>Using:@;\
63+
- Tool: `%s`@;\
64+
- Timeout: `%F`@;\
65+
- Output dir: `%a`@]@\n\
66+
@\n\
67+
Results:@\n\
68+
@\n\
69+
%a@\n\
70+
@\n\
71+
Wall clock stats (in seconds):@\n\
72+
@\n\
73+
%a@\n\
74+
@\n\
75+
User time stats (in seconds):@\n\
76+
@\n\
77+
%a@\n\
78+
@\n\
79+
System time stats (in seconds):@\n\
80+
@\n\
81+
%a@\n\
82+
@\n\
83+
Parallelism stats (ratio of parallelism / wall clock) (percentage is \
84+
efficiency related to number of workers)(runs < 1s filtered out) :@\n\
85+
@\n\
86+
%a@\n\
87+
@\n\
88+
Memory stats (in MB):@\n\
89+
@\n\
90+
%a@."
91+
reference_name timeout Fpath.pp output_dir Runs.pp_table_results runs
92+
Runs.pp_table_wall_clock runs Runs.pp_table_user_time runs
93+
Runs.pp_table_system_time runs
94+
(Runs.pp_table_parallelism_ratio ~workers)
95+
runs Runs.pp_table_memory runs
96+
in
97+
(* Notify on `ZULIP_WEBHOOK` *)
98+
match Bos.OS.Env.var "ZULIP_WEBHOOK" with
99+
| None -> Fmt.epr "%s" text
100+
| Some url ->
101+
let url = Uri.of_string url in
102+
let title =
103+
Fmt.str "Benchmark results (commit hash=%s) :octopus:" (head ())
104+
in
105+
let body =
106+
(* Using Yojson just to ensure we're sending correct json *)
107+
`Assoc
108+
[ ( "blocks"
109+
, `List
110+
[ `Assoc
111+
[ ("type", `String "header")
112+
; ( "text"
113+
, `Assoc
114+
[ ("type", `String "plain_text")
115+
; ("text", `String title)
116+
; ("emoji", `Bool true)
117+
] )
118+
]
119+
; `Assoc
120+
[ ("type", `String "section")
121+
; ( "text"
122+
, `Assoc
123+
[ ("type", `String "mrkdwn"); ("text", `String text) ]
124+
)
125+
]
126+
] )
127+
]
128+
in
129+
let result, _ = Lwt_main.run @@ send url body in
130+
let status = Response.status result in
131+
Fmt.epr "Server responded: %s@." (Code.string_of_status status)
132+
133+
let run tool timeout max_tests files =
134+
let* () =
135+
match Bos.OS.Env.var Tool.tool_path_env_var_name with
136+
| None -> Tool.check_if_available tool
137+
| Some _ -> Ok ()
138+
in
139+
let t = Unix.localtime @@ Unix.gettimeofday () in
140+
let reference_name = Tool.to_reference_name tool in
141+
let filename =
142+
Fmt.str "results-testcomp-%s-%d-%02d-%02d_%02dh%02dm%02ds/" reference_name
143+
(1900 + t.tm_year) (1 + t.tm_mon) t.tm_mday t.tm_hour t.tm_min t.tm_sec
144+
in
145+
let output_dir = Fpath.v filename in
146+
let _ : bool =
147+
Bos.OS.Dir.create ~path:true ~mode:0o755 output_dir |> Utils.ok_or_fail
148+
in
149+
let runs = runs tool timeout output_dir max_tests files in
150+
let workers = Tool.get_number_of_workers tool in
151+
notify_finished runs timeout reference_name output_dir workers;
152+
Utils.gen_full_report runs output_dir reference_name

‎src/bench.mli‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
val runs : Tool.t -> float -> Fpath.t -> int -> Fpath.t list -> Runs.t
2+
3+
val notify_finished : Runs.t -> float -> string -> Fpath.t -> int -> unit
4+
5+
val run :
6+
Tool.t -> float -> int -> Fpath.t list -> (unit, [ `Msg of string ]) result

‎src/cmd_report.ml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,6 @@ let run result_file =
77
let workers = 8 in
88
let reference_name = "owi" in
99
let old_output_dir = output_dir in
10-
Cmd_testcomp.notify_finished runs timeout reference_name old_output_dir
10+
Bench.notify_finished runs timeout reference_name old_output_dir
1111
workers;
1212
Utils.gen_full_report runs output_dir "unknown_tool"

‎src/cmd_testcomp.ml‎

Lines changed: 3 additions & 147 deletions
Original file line numberDiff line numberDiff line change
@@ -85,150 +85,6 @@ let files () =
8585
in
8686
res
8787

88-
let runs tool timeout output_dir max_tests =
89-
let+ files = files () in
90-
let output_chan =
91-
Fpath.(output_dir / "results") |> Fpath.to_string |> open_out
92-
in
93-
let fmt = Format.formatter_of_out_channel output_chan in
94-
let pp x = Fmt.pf fmt x in
95-
let files = List.sort Fpath.compare files in
96-
let len = List.length files in
97-
let results = ref Runs.empty in
98-
List.iteri
99-
(fun i file ->
100-
let i = succ i in
101-
if i <= max_tests then begin
102-
Logs.app (fun m -> m "%a" (Run.pp_header (min len max_tests)) (i, file));
103-
pp "%a@\n @[<v>" (Run.pp_header (min len max_tests)) (i, file);
104-
let result =
105-
Tool.fork_and_run_on_file ~i ~fmt ~output_dir ~file ~tool ~timeout
106-
|> Utils.ok_or_fail
107-
in
108-
let result = { Run.i; file; res = result } in
109-
results := Runs.add result !results;
110-
Logs.app (fun m -> m " %a@]" Runs.pp_quick_results !results);
111-
pp "%a@]@\n%!" Runs.pp_quick_results !results
112-
end )
113-
files;
114-
!results
115-
116-
let notify_finished runs timeout reference_name output_dir workers =
117-
let open Cohttp in
118-
let open Cohttp_lwt_unix in
119-
let headers =
120-
let headers = Header.init () in
121-
Header.add_list headers
122-
[ ("Content-type", "application/json"); ("User-Agent", "Owibot/1.1") ]
123-
in
124-
let send url body =
125-
let body = Cohttp_lwt.Body.of_string (Yojson.to_string body) in
126-
Client.post ~body ~headers url
127-
in
128-
let head () =
129-
let open Bos in
130-
let cmd = Cmd.(v "git" % "rev-parse" % "--short" % "HEAD") in
131-
let output = OS.Cmd.run_out ~err:OS.Cmd.err_run_out cmd in
132-
match OS.Cmd.out_string ~trim:true output with
133-
| Ok (stdout, (_, `Exited 0)) -> stdout
134-
| Error (`Msg err) ->
135-
Fmt.epr "ERROR: %s@." err;
136-
"unknown"
137-
| Ok (stdout, (_, (`Exited _ | `Signaled _))) ->
138-
Fmt.epr "%s@\nWARN: Unable to fetch git HEAD@." stdout;
139-
"unknown"
140-
in
141-
let text =
142-
Fmt.str
143-
"@[<v>Using:@;\
144-
- Tool: `%s`@;\
145-
- Timeout: `%F`@;\
146-
- Output dir: `%a`@]@\n\
147-
@\n\
148-
Results:@\n\
149-
@\n\
150-
%a@\n\
151-
@\n\
152-
Wall clock stats (in seconds):@\n\
153-
@\n\
154-
%a@\n\
155-
@\n\
156-
User time stats (in seconds):@\n\
157-
@\n\
158-
%a@\n\
159-
@\n\
160-
System time stats (in seconds):@\n\
161-
@\n\
162-
%a@\n\
163-
@\n\
164-
Parallelism stats (ratio of parallelism / wall clock) (percentage is \
165-
efficiency related to number of workers)(runs < 1s filtered out) :@\n\
166-
@\n\
167-
%a@\n\
168-
@\n\
169-
Memory stats (in MB):@\n\
170-
@\n\
171-
%a@."
172-
reference_name timeout Fpath.pp output_dir Runs.pp_table_results runs
173-
Runs.pp_table_wall_clock runs Runs.pp_table_user_time runs
174-
Runs.pp_table_system_time runs
175-
(Runs.pp_table_parallelism_ratio ~workers)
176-
runs Runs.pp_table_memory runs
177-
in
178-
(* Notify on `ZULIP_WEBHOOK` *)
179-
match Bos.OS.Env.var "ZULIP_WEBHOOK" with
180-
| None -> Fmt.epr "%s" text
181-
| Some url ->
182-
let url = Uri.of_string url in
183-
let title =
184-
Fmt.str "Benchmark results (commit hash=%s) :octopus:" (head ())
185-
in
186-
let body =
187-
(* Using Yojson just to ensure we're sending correct json *)
188-
`Assoc
189-
[ ( "blocks"
190-
, `List
191-
[ `Assoc
192-
[ ("type", `String "header")
193-
; ( "text"
194-
, `Assoc
195-
[ ("type", `String "plain_text")
196-
; ("text", `String title)
197-
; ("emoji", `Bool true)
198-
] )
199-
]
200-
; `Assoc
201-
[ ("type", `String "section")
202-
; ( "text"
203-
, `Assoc
204-
[ ("type", `String "mrkdwn"); ("text", `String text) ]
205-
)
206-
]
207-
] )
208-
]
209-
in
210-
let result, _ = Lwt_main.run @@ send url body in
211-
let status = Response.status result in
212-
Fmt.epr "Server responded: %s@." (Code.string_of_status status)
213-
214-
let run tool timeout max_tests =
215-
let* () =
216-
match Bos.OS.Env.var Tool.tool_path_env_var_name with
217-
| None -> Tool.check_if_available tool
218-
| Some _ -> Ok ()
219-
in
220-
let t = Unix.localtime @@ Unix.gettimeofday () in
221-
let reference_name = Tool.to_reference_name tool in
222-
let filename =
223-
Fmt.str "results-testcomp-%s-%d-%02d-%02d_%02dh%02dm%02ds/" reference_name
224-
(1900 + t.tm_year) (1 + t.tm_mon) t.tm_mday t.tm_hour t.tm_min t.tm_sec
225-
in
226-
let output_dir = Fpath.v filename in
227-
let _ : bool =
228-
Bos.OS.Dir.create ~path:true ~mode:0o755 output_dir |> Utils.ok_or_fail
229-
in
230-
let runs = runs tool timeout output_dir max_tests in
231-
let runs = Utils.ok_or_fail runs in
232-
let workers = Tool.get_number_of_workers tool in
233-
notify_finished runs timeout reference_name output_dir workers;
234-
Utils.gen_full_report runs output_dir reference_name
88+
let run tool timeout max_test =
89+
let files = Utils.ok_or_fail (files ()) in
90+
Bench.run tool timeout max_test files

‎src/cmd_testcomp.mli‎

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1 @@
1-
val notify_finished : Runs.t -> float -> string -> Fpath.t -> int -> unit
2-
31
val run: Tool.t -> float -> int -> (unit, [`Msg of string]) Result.t

‎src/cmd_wasm_btree.ml‎

Lines changed: 3 additions & 51 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,3 @@
1-
open Utils.Syntax
2-
31
let root = Fpath.v "benchs/btree"
42

53
let problems_root = Fpath.(root / "btree" / "native")
@@ -10,52 +8,6 @@ let files () =
108
if not (Fpath.has_ext ".wat" name) then acc else name :: acc )
119
[] problems_root
1210

13-
let runs tool timeout output_dir max_tests =
14-
let+ files = files () in
15-
let output_chan =
16-
Fpath.(output_dir / "results") |> Fpath.to_string |> open_out
17-
in
18-
let fmt = Format.formatter_of_out_channel output_chan in
19-
let pp x = Fmt.pf fmt x in
20-
let files = List.sort Fpath.compare files in
21-
let len = List.length files in
22-
let results = ref Runs.empty in
23-
List.iteri
24-
(fun i file ->
25-
let i = succ i in
26-
if i <= max_tests then begin
27-
Logs.app (fun m -> m "%a" (Run.pp_header (min len max_tests)) (i, file));
28-
pp "%a@\n @[<v>" (Run.pp_header (min len max_tests)) (i, file);
29-
let result =
30-
Tool.fork_and_run_on_file ~i ~fmt ~output_dir ~file ~tool ~timeout
31-
|> Utils.ok_or_fail
32-
in
33-
let result = { Run.i; file; res = result } in
34-
results := Runs.add result !results;
35-
Logs.app (fun m -> m " %a@]" Runs.pp_quick_results !results);
36-
pp "%a@]@\n%!" Runs.pp_quick_results !results
37-
end )
38-
files;
39-
!results
40-
41-
let run tool timeout max_tests =
42-
let* () =
43-
match Bos.OS.Env.var Tool.tool_path_env_var_name with
44-
| None -> Tool.check_if_available tool
45-
| Some _ -> Ok ()
46-
in
47-
let t = Unix.localtime @@ Unix.gettimeofday () in
48-
let reference_name = Tool.to_reference_name tool in
49-
let filename =
50-
Fmt.str "results-testcomp-%s-%d-%02d-%02d_%02dh%02dm%02ds/" reference_name
51-
(1900 + t.tm_year) (1 + t.tm_mon) t.tm_mday t.tm_hour t.tm_min t.tm_sec
52-
in
53-
let output_dir = Fpath.v filename in
54-
let _ : bool =
55-
Bos.OS.Dir.create ~path:true ~mode:0o755 output_dir |> Utils.ok_or_fail
56-
in
57-
let runs = runs tool timeout output_dir max_tests in
58-
let runs = Utils.ok_or_fail runs in
59-
let _workers = Tool.get_number_of_workers tool in
60-
(* notify_finished runs timeout reference_name output_dir workers; *)
61-
Utils.gen_full_report runs output_dir reference_name
11+
let run tool timeout max_test =
12+
let files = Utils.ok_or_fail (files ()) in
13+
Bench.run tool timeout max_test files

‎src/dune‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
(executable
22
(public_name symbocalypse)
33
(modules
4+
bench
45
cmd_wasm_btree
56
cmd_diff
67
cmd_report

0 commit comments

Comments
 (0)