Add new flag for timings precision.

driver/optmaindriver.ml

@@ -161,5 +161,5 @@ let main unix argv ppf ~flambda2 =
     Location.report_exception ppf x;
     2
   | () ->
-    Profile.print Format.std_formatter !Clflags.profile_columns;
+    Profile.print Format.std_formatter !Clflags.profile_columns ~timings_precision:!Clflags.timings_precision;
     0

ocaml/driver/main_args.ml

@@ -553,6 +553,12 @@ let mk_dtimings f =
   "-dtimings", Arg.Unit f, " Print timings information for each pass";
 ;;
 
+let mk_dtimings_precision f =
+  "-dtimings-precision", Arg.Int f, 
+    Printf.sprintf "<n>  Specify precision for timings information (default %d)"
+      Clflags.default_timings_precision
+;;
+
 let mk_dprofile f =
   "-dprofile", Arg.Unit f, Profile.options_doc
 ;;
@@ -1039,6 +1045,7 @@ module type Compiler_options = sig
 
   val _match_context_rows : int -> unit
   val _dtimings : unit -> unit
+  val _dtimings_precision : int -> unit
   val _dprofile : unit -> unit
   val _dump_into_file : unit -> unit
 
@@ -1292,6 +1299,7 @@ struct
     mk_dinstr F._dinstr;
     mk_dcamlprimc F._dcamlprimc;
     mk_dtimings F._dtimings;
+    mk_dtimings_precision F._dtimings_precision;
     mk_dprofile F._dprofile;
     mk_dump_into_file F._dump_into_file;
 
@@ -1520,6 +1528,7 @@ struct
     mk_dinterval F._dinterval;
     mk_dstartup F._dstartup;
     mk_dtimings F._dtimings;
+    mk_dtimings_precision F._dtimings_precision;
     mk_dprofile F._dprofile;
     mk_dump_into_file F._dump_into_file;
     mk_dump_pass F._dump_pass;
@@ -1899,6 +1908,7 @@ module Default = struct
     let _config_var = Misc.show_config_variable_and_exit
     let _dprofile () = profile_columns := Profile.all_columns
     let _dtimings () = profile_columns := [`Time]
+    let _dtimings_precision n = timings_precision := n
     let _dump_into_file = set dump_into_file
     let _for_pack s = for_package := (Some s)
     let _g = set debug

ocaml/driver/main_args.mli

@@ -120,6 +120,7 @@ module type Compiler_options = sig
 
   val _match_context_rows : int -> unit
   val _dtimings : unit -> unit
+  val _dtimings_precision : int -> unit
   val _dprofile : unit -> unit
   val _dump_into_file : unit -> unit
 

ocaml/driver/maindriver.ml

@@ -111,5 +111,5 @@ let main argv ppf =
     Location.report_exception ppf x;
     2
   | () ->
-    Profile.print Format.std_formatter !Clflags.profile_columns;
+    Profile.print Format.std_formatter !Clflags.profile_columns ~timings_precision:!Clflags.timings_precision;
     0

ocaml/driver/optmaindriver.ml

@@ -136,5 +136,5 @@ let main argv ppf =
     Location.report_exception ppf x;
     2
   | () ->
-    Profile.print Format.std_formatter !Clflags.profile_columns;
+    Profile.print Format.std_formatter !Clflags.profile_columns ~timings_precision:!Clflags.timings_precision;
     0

ocaml/testsuite/tools/codegen_main.ml

@@ -77,5 +77,5 @@ let main() =
 
 let () =
   main ();
-  Profile.print Format.std_formatter !Clflags.profile_columns;
+  Profile.print Format.std_formatter !Clflags.profile_columns ~timings_precision:!Clflags.timings_precision;
   exit 0

ocaml/utils/clflags.ml

@@ -131,6 +131,8 @@ let dump_linear = ref false             (* -dlinear *)
 let dump_interval = ref false           (* -dinterval *)
 let keep_startup_file = ref false       (* -dstartup *)
 let dump_combine = ref false            (* -dcombine *)
+let default_timings_precision  = 3
+let timings_precision = ref default_timings_precision (* -dtimings-precision *)
 let profile_columns : Profile.column list ref = ref [] (* -dprofile/-dtimings *)
 
 let debug_runavail = ref false          (* -drunavail *)

ocaml/utils/clflags.mli

@@ -176,6 +176,8 @@ val keep_docs : bool ref
 val keep_locs : bool ref
 val unsafe_string : bool ref
 val opaque : bool ref
+val default_timings_precision : int
+val timings_precision : int ref
 val profile_columns : Profile.column list ref
 val flambda_invariant_checks : bool ref
 val unbox_closures : bool ref

ocaml/utils/profile.ml

@@ -104,10 +104,10 @@ type display = {
   worth_displaying : max:float -> bool;
 }
 
-let time_display v : display =
+let time_display precision v : display =
   (* Because indentation is meaningful, and because the durations are
      the first element of each row, we can't pad them with spaces. *)
-  let to_string_without_unit v ~width = Printf.sprintf "%0*.03f" width v in
+  let to_string_without_unit v ~width = Printf.sprintf "%0*.*f" width precision v in
   let to_string ~max:_ ~width =
     to_string_without_unit v ~width:(width - 1) ^ "s" in
   let worth_displaying ~max:_ =
@@ -212,7 +212,7 @@ and rows_of_hierarchy_list ~nesting make_row hierarchy total env =
     a
   ) list
 
-let rows_of_hierarchy hierarchy measure_diff initial_measure columns =
+let rows_of_hierarchy hierarchy measure_diff initial_measure columns timings_precision =
   (* Computing top heap size is a bit complicated: if the compiler applies a
      list of passes n times (rather than applying pass1 n times, then pass2 n
      times etc), we only show one row for that pass but what does "top heap
@@ -238,7 +238,7 @@ let rows_of_hierarchy hierarchy measure_diff initial_measure columns =
       let make value ~f = value, f value in
       List.map (function
         | `Time ->
-          make p.duration ~f:time_display
+          make p.duration ~f:(time_display timings_precision)
         | `Alloc ->
           make p.allocated_words ~f:memory_word_display
         | `Top_heap ->
@@ -300,7 +300,7 @@ let display_rows ppf rows =
   in
   List.iter (loop ~indentation:"") rows
 
-let print ppf columns =
+let print ppf columns ~timings_precision =
   match columns with
   | [] -> ()
   | _ :: _ ->
@@ -311,7 +311,7 @@ let print ppf columns =
      in
      let total = Measure_diff.of_diff Measure.zero (Measure.create ()) in
      display_rows ppf
-       (rows_of_hierarchy !hierarchy total initial_measure columns)
+       (rows_of_hierarchy !hierarchy total initial_measure columns timings_precision)
 
 let column_mapping = [
   "time", `Time;

ocaml/utils/profile.mli

@@ -33,7 +33,7 @@ val record : ?accumulate:bool -> string -> ('a -> 'b) -> 'a -> 'b
 
 type column = [ `Time | `Alloc | `Top_heap | `Abs_top_heap ]
 
-val print : Format.formatter -> column list -> unit
+val print : Format.formatter -> column list -> timings_precision:int -> unit
 (** Prints the selected recorded profiling information to the formatter. *)
 
 (** Command line flags *)

testsuite/tools/codegen_main.ml

@@ -77,5 +77,5 @@ let main() =
 
 let () =
   main ();
-  Profile.print Format.std_formatter !Clflags.profile_columns;
+  Profile.print Format.std_formatter !Clflags.profile_columns ~timings_precision:!Clflags.timings_precision;
   exit 0