Commit 8ba22f45 authored by POTTIER Francois's avatar POTTIER Francois
Browse files

New command line switch --timings-to <filename>.

parent f4193c43
......@@ -5,6 +5,9 @@
* Increase the maximum length of a production, which used to be 127,
up to 1023. Display a polite error message if this length is exceeded.
* The new switch `--timings-to <filename>` causes internal timing
information to be written to the file `<filename>`.
## 2020/01/21
* There used to be a distinction between two slightly different ways of
......
......@@ -179,6 +179,7 @@
\newcommand{\osuggestocamlfind}{\oo{suggest-ocamlfind}}
\newcommand{\otable}{\oo{table}}
\newcommand{\otimings}{\oo{timings}}
\newcommand{\otimingsto}{\oo{timings-to}}
\newcommand{\otrace}{\oo{trace}}
\newcommand{\ostdlib}{\oo{stdlib}}
\newcommand{\oversion}{\oo{version}}
......
......@@ -293,6 +293,9 @@ The incremental API (\sref{sec:incremental}) and the inspection API
\docswitch{\otimings} This switch causes internal timing information to
be sent to the standard error channel.
\docswitch{\otimingsto \nt{filename}} This switch causes internal timing
information to be written to the file \nt{filename}.
\docswitch{\otrace} This switch causes tracing code to be inserted into
the generated parser, so that, when the parser is run, its actions are
logged to the standard error channel. This is analogous to \texttt{ocamlrun}'s
......
......@@ -180,7 +180,7 @@ let logG, logA, logC =
ref 0, ref 0, ref 0
let timings =
ref false
ref None
let filenames =
ref StringSet.empty
......@@ -355,7 +355,8 @@ let options = Arg.align [
"--suggest-ocamlfind", Arg.Unit (fun () -> suggestion := SuggestUseOcamlfind),
" (deprecated)";
"--table", Arg.Set table, " Use the table-based back-end";
"--timings", Arg.Set timings, " Display internal timings";
"--timings", Arg.Unit (fun () -> timings := Some stderr), " Output internal timings to stderr";
"--timings-to", Arg.String (fun filename -> timings := Some (open_out filename)), "<filename> Output internal timings to <filename>";
"--trace", Arg.Set trace, " Generate tracing instructions";
"--unused-precedence-levels", Arg.Set ignore_all_unused_precedence_levels, " Do not warn about unused precedence levels";
"--unused-token", Arg.String ignore_unused_token, "<token> Do not warn that <token> is unused";
......
......@@ -124,7 +124,7 @@ val logC: int (* diagnostics on the generated code *)
(* Whether tasks should be timed. *)
val timings: bool
val timings: out_channel option
(* The base name that should be used for the files that we create.
This name can contain a path. *)
......
......@@ -11,9 +11,6 @@
(* *)
(******************************************************************************)
let channel =
stderr
open Unix
open Printf
......@@ -21,13 +18,16 @@ let clock =
ref (times())
let tick msg =
if Settings.timings then
let times1 = !clock in
let times2 = times() in
fprintf channel "%s: %.02fs\n%!"
msg
(times2.tms_utime -. times1.tms_utime);
clock := times()
match Settings.timings with
| None ->
()
| Some channel ->
let times1 = !clock in
let times2 = times() in
fprintf channel "%s: %.02fs\n%!"
msg
(times2.tms_utime -. times1.tms_utime);
clock := times()
type chrono =
float ref
......@@ -36,19 +36,21 @@ let fresh () =
ref 0.
let chrono (chrono : float ref) (task : unit -> 'a) : 'a =
if Settings.timings then begin
let times1 = times() in
let result = task() in
let times2 = times() in
chrono := !chrono +. times2.tms_utime -. times1.tms_utime;
result
end
else
task()
match Settings.timings with
| None ->
task()
| Some _channel ->
let times1 = times() in
let result = task() in
let times2 = times() in
chrono := !chrono +. times2.tms_utime -. times1.tms_utime;
result
let display (chrono : float ref) msg =
if Settings.timings then
fprintf channel "%s: %.02fs\n"
msg
!chrono
match Settings.timings with
| None ->
()
| Some channel ->
fprintf channel "%s: %.02fs\n"
msg
!chrono
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment