@@ -75,59 +75,31 @@ end = struct
7575end
7676
7777module Benchmark : sig
78- type t
78+ type test_result = { ms_per_run : float ; allocs_per_run : int }
7979
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
8381end = struct
8482 type t = {
85- name : string ;
8683 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 ;
9087 mutable timer_on : bool ;
91- (* mutable result: benchmarkResult; *)
92- (* The initial states *)
9388 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 ;
9890 }
9991
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 }
11893
119- let make ~ name ~ f () =
94+ let make f =
12095 {
121- name;
12296 start = Time. zero;
12397 n = 0 ;
12498 bench_func = f;
125- duration = Time. zero;
99+ total_duration = Time. zero;
126100 timer_on = false ;
127101 start_allocs = 0. ;
128- start_bytes = 0. ;
129- net_allocs = 0. ;
130- net_bytes = 0. ;
102+ total_allocs = 0. ;
131103 }
132104
133105 (* total amount of memory allocated by the program since it started in words *)
@@ -139,79 +111,74 @@ end = struct
139111 if not b.timer_on then (
140112 let allocated_words = mallocs () in
141113 b.start_allocs < - allocated_words;
142- b.start_bytes < - allocated_words *. 8. ;
143114 b.start < - Time. now () ;
144115 b.timer_on < - true )
145116
146117 let stop_timer b =
147118 if b.timer_on then (
148119 let allocated_words = mallocs () in
149120 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);
153123 b.timer_on < - false )
154124
155125 let reset_timer b =
156126 if b.timer_on then (
157127 let allocated_words = mallocs () in
158128 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 () )
163130
164131 let run_iteration b n =
165132 Gc. full_major () ;
166133 b.n < - n;
167134 reset_timer b;
168135 start_timer b;
169- b.bench_func b ;
136+ b.bench_func () ;
170137 stop_timer b
171138
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
175142 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+ }
177148end
178149
179150module Benchmarks : sig
180151 val run : unit -> unit
181152end = struct
182153 type action = Parse | Print
154+
183155 let string_of_action action =
184156 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"
193159
194160 let parse_rescript src filename =
195161 let p = Parser. make src filename in
196162 let structure = ResParser. parse_implementation p in
197163 assert (p.diagnostics == [] );
198164 structure
199165
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
205172 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
210177 ()
211- | Rescript , Print ->
212- let p = Parser. make src filename in
178+ | Print ->
179+ let p = Parser. make src path in
213180 let ast = ResParser. parse_implementation p in
214- fun _ ->
181+ fun () ->
215182 let _ =
216183 Sys. opaque_identity
217184 (let cmt_tbl = CommentTable. make () in
@@ -221,21 +188,45 @@ end = struct
221188 in
222189 ()
223190 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+ ]
227203
228204 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 " ]"
239230end
240231
241232let () = Benchmarks. run ()
0 commit comments