1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
(** Recursively list .html files' relative directories in given directory *)
let list_html_files dir =
let rec loop result = function
| f :: fs when Sys.is_directory f ->
Sys.readdir f
|> Array.to_list
|> CList.map (Filename.concat f)
|> CList.append fs
|> loop result
| f :: fs ->
if Filename.check_suffix f ".html" then
loop (f::result) fs
else
loop result fs
| [] -> result
in
Sys.readdir dir
|> Array.to_list
|> loop []
exception UnableToParse
(** Read all the lines of a file into a list *)
let read_timing_lines file =
let ic = open_in file in
(* We tail recursively read lines in the file discarding the uninteresting ones *)
let rec read_lines_aux acc =
match input_line ic with
| line ->
if Str.string_match (Str.regexp "Line:.*") line 0 then
(* We know this line is ["Line:"] *)
let line_num = match Str.split (Str.regexp " ") line with
| _ :: ln :: _ -> int_of_string ln
| _ -> raise @@ UnableToParse
in
(* Second line is empty *)
let _ = input_line ic in
(* Time1 - we have floats written with s so with split that too *)
let time1 = match Str.split (Str.regexp "[ s]") (input_line ic) with
| _ :: time1_str :: _ -> float_of_string time1_str
| _ -> raise @@ UnableToParse
in
(* Time2 *)
let time2 = match Str.split (Str.regexp "[ s]") (input_line ic) with
| _ :: time2_str :: _ -> float_of_string time2_str
| _ -> raise @@ UnableToParse
in
(* Difference *)
let diff = time2 -. time1 in
(* Percentage diff *)
let pdiff = if time1 <> 0.0 then (diff *. 100.0) /. time1 else Float.infinity in
(* We accumulate the timing data in a tuple if the difference is non-zero *)
(* We also check that timed values are not too small (tolerence is trial and error) *)
if Float.abs diff <= 1e-4 then
acc |> read_lines_aux
else
(time1, time2, diff, pdiff, line_num, file) :: acc |> read_lines_aux
else
read_lines_aux acc
| exception End_of_file -> acc
in
let lines =
try Some (read_lines_aux [])
with End_of_file ->
Printf.eprintf "*** Error: Could not read file %s.\n" file; None
in
close_in ic; lines
type html_data = { link_prefix : string }
let get_html_data () =
match Sys.getenv_opt "CI_PAGES_DOMAIN",
Sys.getenv_opt "CI_PROJECT_NAMESPACE",
Sys.getenv_opt "CI_PROJECT_NAME",
Sys.getenv_opt "CI_JOB_ID" with
| Some domain, Some ns, Some project, Some id ->
Some { link_prefix =
Printf.sprintf "https://%s.%s/-/%s/-/jobs/%s/artifacts/_bench/html/"
ns domain project id }
| None, _, _, _ | _, None, _, _ | _, _, None, _ | _, _, _, None -> None
let html_str ?html lnum s = match html with
| None -> Table.raw_str s
| Some html ->
let size = String.length s in
let s = Printf.sprintf "<a href=\"%s%s#L%d\">%s</a>" html.link_prefix s lnum s in
{ Table.str = s; size }
let list_timing_data ?html (time1, time2, diff, pdiff, line_num, file) =
let str_time1 = Printf.sprintf "%.4f" time1 in
let str_time2 = Printf.sprintf "%.4f" time2 in
let str_diff = Printf.sprintf "%.4f" diff in
let str_pdiff = Printf.sprintf "%3.2f%%" pdiff in
let str_line_num = string_of_int line_num in
List.append
(List.map Table.raw_str [ str_time1; str_time2; str_diff; str_pdiff; str_line_num])
[ html_str ?html line_num file ]
let render_table ?(reverse=false) title num table =
let open Table.Align in
let headers = [Table.raw_str title] in
let top = Table.raw_row [["OLD"; "NEW"; "DIFF"; "%DIFF"; "Ln"; "FILE"]] in
let align_top = [[Middle; Middle; Middle; Middle; Middle; MidLeft]] in
let align_rows = [[Right; Right; Right; Right; Right; Left]] in
(if reverse then CList.rev table else table)
|> CList.firstn num
|> fun x -> Table.print headers top x ~align_top ~align_rows ()
let to_file fname fmt =
Printf.kfprintf close_out (open_out fname) fmt
let main () =
let () = Printexc.record_backtrace true in
let data =
Unix.getcwd ()
|> list_html_files
|> CList.filter_map read_timing_lines
|> CList.flatten
(* Do we want to do a unique sort? *)
(* |> CList.sort_uniq (fun (_,_,x,_,_,_) (_,_,y,_,_,_) -> Float.compare x y) *)
|> CList.sort (fun (_,_,x,_,_,_) (_,_,y,_,_,_) -> Float.compare x y)
in
let table =
data
|> CList.map list_timing_data
|> CList.map (fun x -> [ x ])
in
(* What is a good number to choose? *)
let num = 25 in
let num = min num (CList.length table) in
let slow_table = render_table (Printf.sprintf "TOP %d SLOW DOWNS" num) ~reverse:true num table in
let fast_table = render_table (Printf.sprintf "TOP %d SPEED UPS" num) num table in
let timings_table = render_table "Significant line time changes in bench" (CList.length table) table in
(* Print tables to stdout *)
Printf.printf "%s\n%s\n" slow_table fast_table;
(* Print tables to files *)
to_file "slow_table" "%s\n" slow_table;
to_file "fast_table" "%s\n" fast_table;
to_file "timings_table" "%s\n" timings_table;
(* html tables *)
match get_html_data () with
| None -> ()
| Some html ->
let table =
data
|> CList.map (list_timing_data ~html)
|> CList.map (fun x -> [ x ])
in
let slow_table = render_table (Printf.sprintf "TOP %d SLOW DOWNS" num) ~reverse:true num table in
let fast_table = render_table (Printf.sprintf "TOP %d SPEED UPS" num) num table in
let timings_table = render_table "Significant line time changes in bench" (CList.length table) table in
to_file "slow_table.html" "<pre>%s</pre>\n" slow_table;
to_file "fast_table.html" "<pre>%s</pre>\n" fast_table;
to_file "timings_table.html" "<pre>%s</pre>\n" timings_table;
()
let () = main ()
|
