@@ -75,59 +75,31 @@ end = struct
75
75
end
76
76
77
77
module Benchmark : sig
78
- type t
78
+ type test_result = { ms_per_run : float ; allocs_per_run : int }
79
79
80
- val make : name :string -> f :(t -> unit ) -> unit -> t
81
- val launch : t -> unit
82
- val report : t -> unit
80
+ val run : (unit -> unit ) -> num_iterations :int -> test_result
83
81
end = struct
84
82
type t = {
85
- name : string ;
86
83
mutable start : Time .t ;
87
- mutable n : int ; (* current iterations count *)
88
- mutable duration : Time .t ;
89
- bench_func : t -> unit ;
84
+ mutable n : int ; (* current iteration count *)
85
+ mutable total_duration : Time .t ;
86
+ bench_func : unit -> unit ;
90
87
mutable timer_on : bool ;
91
- (* mutable result: benchmarkResult; *)
92
- (* The initial states *)
93
88
mutable start_allocs : float ;
94
- mutable start_bytes : float ;
95
- (* The net total of this test after being run. *)
96
- mutable net_allocs : float ;
97
- mutable net_bytes : float ;
89
+ mutable total_allocs : float ;
98
90
}
99
91
100
- let report b =
101
- print_endline (Format. sprintf " Benchmark: %s" b.name);
102
- print_endline (Format. sprintf " Nbr of iterations: %d" b.n);
103
- print_endline
104
- (Format. sprintf " Benchmark ran during: %fms" (Time. print b.duration));
105
- print_endline
106
- (Format. sprintf " Avg time/op: %fms"
107
- (Time. print b.duration /. float_of_int b.n));
108
- print_endline
109
- (Format. sprintf " Allocs/op: %d"
110
- (int_of_float (b.net_allocs /. float_of_int b.n)));
111
- print_endline
112
- (Format. sprintf " B/op: %d"
113
- (int_of_float (b.net_bytes /. float_of_int b.n)));
114
-
115
- (* return (float64(r.Bytes) * float64(r.N) / 1e6) / r.T.Seconds() *)
116
- print_newline () ;
117
- ()
92
+ type test_result = {ms_per_run : float ; allocs_per_run : int }
118
93
119
- let make ~ name ~ f () =
94
+ let make f =
120
95
{
121
- name;
122
96
start = Time. zero;
123
97
n = 0 ;
124
98
bench_func = f;
125
- duration = Time. zero;
99
+ total_duration = Time. zero;
126
100
timer_on = false ;
127
101
start_allocs = 0. ;
128
- start_bytes = 0. ;
129
- net_allocs = 0. ;
130
- net_bytes = 0. ;
102
+ total_allocs = 0. ;
131
103
}
132
104
133
105
(* total amount of memory allocated by the program since it started in words *)
@@ -139,79 +111,74 @@ end = struct
139
111
if not b.timer_on then (
140
112
let allocated_words = mallocs () in
141
113
b.start_allocs < - allocated_words;
142
- b.start_bytes < - allocated_words *. 8. ;
143
114
b.start < - Time. now () ;
144
115
b.timer_on < - true )
145
116
146
117
let stop_timer b =
147
118
if b.timer_on then (
148
119
let allocated_words = mallocs () in
149
120
let diff = Time. diff b.start (Time. now () ) in
150
- b.duration < - Time. add b.duration diff;
151
- b.net_allocs < - b.net_allocs +. (allocated_words -. b.start_allocs);
152
- b.net_bytes < - b.net_bytes +. ((allocated_words *. 8. ) -. b.start_bytes);
121
+ b.total_duration < - Time. add b.total_duration diff;
122
+ b.total_allocs < - b.total_allocs +. (allocated_words -. b.start_allocs);
153
123
b.timer_on < - false )
154
124
155
125
let reset_timer b =
156
126
if b.timer_on then (
157
127
let allocated_words = mallocs () in
158
128
b.start_allocs < - allocated_words;
159
- b.net_allocs < - allocated_words *. 8. ;
160
- b.start < - Time. now () );
161
- b.net_allocs < - 0. ;
162
- b.net_bytes < - 0.
129
+ b.start < - Time. now () )
163
130
164
131
let run_iteration b n =
165
132
Gc. full_major () ;
166
133
b.n < - n;
167
134
reset_timer b;
168
135
start_timer b;
169
- b.bench_func b ;
136
+ b.bench_func () ;
170
137
stop_timer b
171
138
172
- let launch b =
173
- (* 150 runs * all the benchmarks means around 1m of benchmark time *)
174
- for n = 1 to 150 do
139
+ let run f ~ num_iterations =
140
+ let b = make f in
141
+ for n = 1 to num_iterations do
175
142
run_iteration b n
176
- done
143
+ done ;
144
+ {
145
+ ms_per_run = Time. print b.total_duration /. float_of_int b.n;
146
+ allocs_per_run = int_of_float (b.total_allocs /. float_of_int b.n);
147
+ }
177
148
end
178
149
179
150
module Benchmarks : sig
180
151
val run : unit -> unit
181
152
end = struct
182
153
type action = Parse | Print
154
+
183
155
let string_of_action action =
184
156
match action with
185
- | Parse -> " parser"
186
- | Print -> " printer"
187
-
188
- (* TODO: we could at Reason here *)
189
- type lang = Rescript
190
- let string_of_lang lang =
191
- match lang with
192
- | Rescript -> " rescript"
157
+ | Parse -> " Parse"
158
+ | Print -> " Print"
193
159
194
160
let parse_rescript src filename =
195
161
let p = Parser. make src filename in
196
162
let structure = ResParser. parse_implementation p in
197
163
assert (p.diagnostics == [] );
198
164
structure
199
165
200
- let benchmark filename lang action =
201
- let src = IO. read_file filename in
202
- let name =
203
- filename ^ " " ^ string_of_lang lang ^ " " ^ string_of_action action
204
- in
166
+ let data_dir = " tests/syntax_benchmarks/data"
167
+ let num_iterations = 150
168
+
169
+ let benchmark (filename , action ) =
170
+ let path = Filename. concat data_dir filename in
171
+ let src = IO. read_file path in
205
172
let benchmark_fn =
206
- match (lang, action) with
207
- | Rescript , Parse ->
208
- fun _ ->
209
- let _ = Sys. opaque_identity (parse_rescript src filename ) in
173
+ match action with
174
+ | Parse ->
175
+ fun () ->
176
+ let _ = Sys. opaque_identity (parse_rescript src path ) in
210
177
()
211
- | Rescript , Print ->
212
- let p = Parser. make src filename in
178
+ | Print ->
179
+ let p = Parser. make src path in
213
180
let ast = ResParser. parse_implementation p in
214
- fun _ ->
181
+ fun () ->
215
182
let _ =
216
183
Sys. opaque_identity
217
184
(let cmt_tbl = CommentTable. make () in
@@ -221,21 +188,45 @@ end = struct
221
188
in
222
189
()
223
190
in
224
- let b = Benchmark. make ~name ~f: benchmark_fn () in
225
- Benchmark. launch b;
226
- Benchmark. report b
191
+ Benchmark. run benchmark_fn ~num_iterations
192
+
193
+ let specs =
194
+ [
195
+ (" RedBlackTree.res" , Parse );
196
+ (" RedBlackTree.res" , Print );
197
+ (" RedBlackTreeNoComments.res" , Print );
198
+ (" Napkinscript.res" , Parse );
199
+ (" Napkinscript.res" , Print );
200
+ (" HeroGraphic.res" , Parse );
201
+ (" HeroGraphic.res" , Print );
202
+ ]
227
203
228
204
let run () =
229
- let data_dir = " tests/syntax_benchmarks/data" in
230
- benchmark (Filename. concat data_dir " RedBlackTree.res" ) Rescript Parse ;
231
- benchmark (Filename. concat data_dir " RedBlackTree.res" ) Rescript Print ;
232
- benchmark
233
- (Filename. concat data_dir " RedBlackTreeNoComments.res" )
234
- Rescript Print ;
235
- benchmark (Filename. concat data_dir " Napkinscript.res" ) Rescript Parse ;
236
- benchmark (Filename. concat data_dir " Napkinscript.res" ) Rescript Print ;
237
- benchmark (Filename. concat data_dir " HeroGraphic.res" ) Rescript Parse ;
238
- benchmark (Filename. concat data_dir " HeroGraphic.res" ) Rescript Print
205
+ List. to_seq specs
206
+ |> Seq. flat_map (fun spec ->
207
+ let filename, action = spec in
208
+ let test_name = string_of_action action ^ " " ^ filename in
209
+ let {Benchmark. ms_per_run; allocs_per_run} = benchmark spec in
210
+ [
211
+ `Assoc
212
+ [
213
+ (" name" , `String (Format. sprintf " %s - time/run" test_name));
214
+ (" unit" , `String " ms" );
215
+ (" value" , `Float ms_per_run);
216
+ ];
217
+ `Assoc
218
+ [
219
+ (" name" , `String (Format. sprintf " %s - allocs/run" test_name));
220
+ (" unit" , `String " words" );
221
+ (" value" , `Int allocs_per_run);
222
+ ];
223
+ ]
224
+ |> List. to_seq)
225
+ |> Seq. iteri (fun i json ->
226
+ print_endline (if i == 0 then " [" else " ," );
227
+ print_string (Yojson. to_string json));
228
+ print_newline () ;
229
+ print_endline " ]"
239
230
end
240
231
241
232
let () = Benchmarks. run ()
0 commit comments