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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
|
(************************************************************************)
(* * The Rocq Prover / The Rocq Development Team *)
(* v * Copyright INRIA, CNRS and contributors *)
(* <O___,, * (see version control and CREDITS file for authors & dates) *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(* * (see LICENSE file for the text of the license) *)
(************************************************************************)
open BenchUtil
let die fmt = Printf.kfprintf (fun _ -> exit 1) stderr (fmt^^"\n%!")
let colors = [|"#F08080"; "#EEE8AA"; "#98FB98"|]
let max_data_count = Array.length colors
let htmlescape =
let r = Str.regexp "[&<>\"]" in
let subst s = match Str.matched_string s with
| "&" -> "&"
| "<" -> "<"
| ">" -> ">"
| "\"" -> """
| _ -> assert false
in
fun s -> Str.global_substitute r subst s
let percentage ~max:m v =
Q.to_float Q.(v * of_int 100 / m)
let pp_words ~need_comma which w =
if w = "0 w" then need_comma, ""
else
true, (if need_comma then ", " else "")^(String.sub w 0 (String.length w - 1))^which^" w"
let pp_collect ~need_comma which c =
if c = 0 then need_comma, ""
else
true, Printf.sprintf "%s%d %s %s"
(if need_comma then ", " else "") c which
(if c = 1 then "collection" else "collections")
let pp_memory ch = function
| None -> ()
| Some {major_words; minor_words; major_collect; minor_collect} ->
(* need_comma <-> prefix is nontrivial *)
let need_comma, minor_words = pp_words ~need_comma:false "minor" minor_words in
let need_comma, major_words = pp_words ~need_comma "major" major_words in
let need_comma, minor_collect = pp_collect ~need_comma "minor" minor_collect in
let need_comma, major_collect = pp_collect ~need_comma "major" major_collect in
if need_comma then
Printf.fprintf ch " (%s%s%s%s)" minor_words major_words minor_collect major_collect
let output ch ~vname ~data_files all_data =
let out fmt = Printf.fprintf ch fmt in
let ndata = Array.length data_files in
let totals = Array.fold_left (fun acc (_,data) ->
Array.map2 (fun acc d -> Q.add acc d.time.q) acc data)
(Array.make ndata Q.zero)
all_data
in
let maxq =
Array.fold_left (fun max (_,data) ->
Array.fold_left (fun max d ->
let dq = d.time.q in
if Q.lt max dq then dq
else max)
max
data)
Q.zero all_data
in
let () =
out
{|<html>
<head>
<title>%s</title>
<style>
|} vname
in
let () = data_files |> Array.iteri (fun i _ ->
let color = colors.(i) in
out
{|.time%d {
background-color: %s;
height: %d%%;
top: %d%%;
z-index: -1;
position: absolute;
opacity: 50%%;
}
|} (i+1) color (100 / ndata) (100 / ndata * i))
in
let () =
out
{|.code {
z-index: 0;
position: relative;
border-style: solid;
border-color: transparent;
border-width: 1px;
}
.code:hover {
border-color: black;
}
code::before {
content: attr(data-line);
right: 0.5em;
position: absolute;
text-align: right;
}
</style>
</head>
<body>
|}
in
let () = out "<h1>Timings for %s</h1>\n" vname in
let () = out "<ol>\n" in
let () = data_files |> Array.iteri (fun i data_file ->
out "<li style=\"background-color: %s\">%s (total time: %.3Gs)</li>\n"
colors.(i)
data_file
(Q.to_float totals.(i)))
in
let () = out "</ol>\n" in
let () = out "<pre>" in
let last_seen_line = ref 0 in
let line_id fmt l =
if l > !last_seen_line then begin
last_seen_line := l;
Printf.fprintf fmt "id=\"L%d\" " l
end
in
let () = all_data |> Array.iteri (fun j (loc,data) ->
let () = out {|<div class="code" title="File: %s
Line: %d
|} vname loc.line
in
let () = data |> Array.iteri (fun k d ->
out "Time%d: %ss%a\n" (k+1) d.time.str pp_memory d.memory)
in
let () = out {|">|} in
let () = data |> Array.iteri (fun k d ->
out {|<div class="time%d" style="width: %f%%"></div>|}
(k+1)
(percentage d.time.q ~max:maxq))
in
let text = loc.text in
let text = if text <> "" && text.[0] = '\n'
then String.sub text 1 (String.length text - 1)
else text
in
let sublines = String.split_on_char '\n' text in
let () = sublines |> List.iteri (fun i line ->
let lnum = loc.line + i in
out "<code %adata-line=\"%d\">%s</code>\n" line_id lnum lnum (htmlescape line))
in
let () = out "</div>" in
())
in
let () =
out
{|
</pre>
</body>
</html>
|}
in
()
let raw_output ch ~min_diff all_data =
all_data |> Array.iteri @@ fun j (loc,data) ->
let d1, d2 = match data with
| [|d1; d2|] -> d1, d2
| _ -> die "-raw-o only supports 2 data files, got %d" (Array.length data)
in
let diff = Q.(d2.time.q - d1.time.q) in
let ignore = Q.lt (Q.abs diff) min_diff in
if not ignore then begin
let pdiff = if Q.(equal zero d1.time.q) then Float.infinity
else Q.(to_float @@ ((of_int 100 * diff) / d1.time.q))
in
(* XXX %.4f makes sense for min_diff=1e-4 but should be smarter for other min_diff *)
Printf.fprintf ch "%s %s %.4f %3.2f%% %d\n"
d1.time.str d2.time.str (Q.to_float diff) pdiff loc.line
end
|
