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 @@ ...@@ -5,6 +5,9 @@
* Increase the maximum length of a production, which used to be 127, * 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. 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 ## 2020/01/21
* There used to be a distinction between two slightly different ways of * There used to be a distinction between two slightly different ways of
......
...@@ -179,6 +179,7 @@ ...@@ -179,6 +179,7 @@
\newcommand{\osuggestocamlfind}{\oo{suggest-ocamlfind}} \newcommand{\osuggestocamlfind}{\oo{suggest-ocamlfind}}
\newcommand{\otable}{\oo{table}} \newcommand{\otable}{\oo{table}}
\newcommand{\otimings}{\oo{timings}} \newcommand{\otimings}{\oo{timings}}
\newcommand{\otimingsto}{\oo{timings-to}}
\newcommand{\otrace}{\oo{trace}} \newcommand{\otrace}{\oo{trace}}
\newcommand{\ostdlib}{\oo{stdlib}} \newcommand{\ostdlib}{\oo{stdlib}}
\newcommand{\oversion}{\oo{version}} \newcommand{\oversion}{\oo{version}}
......
...@@ -293,6 +293,9 @@ The incremental API (\sref{sec:incremental}) and the inspection API ...@@ -293,6 +293,9 @@ The incremental API (\sref{sec:incremental}) and the inspection API
\docswitch{\otimings} This switch causes internal timing information to \docswitch{\otimings} This switch causes internal timing information to
be sent to the standard error channel. 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 \docswitch{\otrace} This switch causes tracing code to be inserted into
the generated parser, so that, when the parser is run, its actions are 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 logged to the standard error channel. This is analogous to \texttt{ocamlrun}'s
......
...@@ -180,7 +180,7 @@ let logG, logA, logC = ...@@ -180,7 +180,7 @@ let logG, logA, logC =
ref 0, ref 0, ref 0 ref 0, ref 0, ref 0
let timings = let timings =
ref false ref None
let filenames = let filenames =
ref StringSet.empty ref StringSet.empty
...@@ -355,7 +355,8 @@ let options = Arg.align [ ...@@ -355,7 +355,8 @@ let options = Arg.align [
"--suggest-ocamlfind", Arg.Unit (fun () -> suggestion := SuggestUseOcamlfind), "--suggest-ocamlfind", Arg.Unit (fun () -> suggestion := SuggestUseOcamlfind),
" (deprecated)"; " (deprecated)";
"--table", Arg.Set table, " Use the table-based back-end"; "--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"; "--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-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"; "--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 *) ...@@ -124,7 +124,7 @@ val logC: int (* diagnostics on the generated code *)
(* Whether tasks should be timed. *) (* 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. (* The base name that should be used for the files that we create.
This name can contain a path. *) This name can contain a path. *)
......
...@@ -11,9 +11,6 @@ ...@@ -11,9 +11,6 @@
(* *) (* *)
(******************************************************************************) (******************************************************************************)
let channel =
stderr
open Unix open Unix
open Printf open Printf
...@@ -21,13 +18,16 @@ let clock = ...@@ -21,13 +18,16 @@ let clock =
ref (times()) ref (times())
let tick msg = let tick msg =
if Settings.timings then match Settings.timings with
let times1 = !clock in | None ->
let times2 = times() in ()
fprintf channel "%s: %.02fs\n%!" | Some channel ->
msg let times1 = !clock in
(times2.tms_utime -. times1.tms_utime); let times2 = times() in
clock := times() fprintf channel "%s: %.02fs\n%!"
msg
(times2.tms_utime -. times1.tms_utime);
clock := times()
type chrono = type chrono =
float ref float ref
...@@ -36,19 +36,21 @@ let fresh () = ...@@ -36,19 +36,21 @@ let fresh () =
ref 0. ref 0.
let chrono (chrono : float ref) (task : unit -> 'a) : 'a = let chrono (chrono : float ref) (task : unit -> 'a) : 'a =
if Settings.timings then begin match Settings.timings with
let times1 = times() in | None ->
let result = task() in task()
let times2 = times() in | Some _channel ->
chrono := !chrono +. times2.tms_utime -. times1.tms_utime; let times1 = times() in
result let result = task() in
end let times2 = times() in
else chrono := !chrono +. times2.tms_utime -. times1.tms_utime;
task() result
let display (chrono : float ref) msg = let display (chrono : float ref) msg =
if Settings.timings then match Settings.timings with
fprintf channel "%s: %.02fs\n" | None ->
msg ()
!chrono | 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