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

CHANGES.md

@@ -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

doc/macros.tex

@@ -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}}

doc/manual.tex

@@ -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

src/settings.ml

@@ -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";

src/settings.mli

@@ -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. *)

src/time.ml

@@ -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