diff --git a/driver/optmaindriver.ml b/driver/optmaindriver.ml index 6b26cbf15a0..2bde70dc8ea 100644 --- a/driver/optmaindriver.ml +++ b/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 diff --git a/ocaml/driver/main_args.ml b/ocaml/driver/main_args.ml index 7979259de27..936f61fd7f7 100644 --- a/ocaml/driver/main_args.ml +++ b/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 " 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 diff --git a/ocaml/driver/main_args.mli b/ocaml/driver/main_args.mli index be03e93c233..16cccecaa8e 100644 --- a/ocaml/driver/main_args.mli +++ b/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 diff --git a/ocaml/driver/maindriver.ml b/ocaml/driver/maindriver.ml index 1d1f0af82da..e184a41904a 100644 --- a/ocaml/driver/maindriver.ml +++ b/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 diff --git a/ocaml/driver/optmaindriver.ml b/ocaml/driver/optmaindriver.ml index d176b1418df..5f05bb47f9d 100644 --- a/ocaml/driver/optmaindriver.ml +++ b/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 diff --git a/ocaml/testsuite/tools/codegen_main.ml b/ocaml/testsuite/tools/codegen_main.ml index cb2200d4996..314bbe50ca3 100644 --- a/ocaml/testsuite/tools/codegen_main.ml +++ b/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 diff --git a/ocaml/utils/clflags.ml b/ocaml/utils/clflags.ml index b69ef9ba9f5..e8ba917f482 100644 --- a/ocaml/utils/clflags.ml +++ b/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 *) diff --git a/ocaml/utils/clflags.mli b/ocaml/utils/clflags.mli index 8025f73a443..36c02a8b351 100644 --- a/ocaml/utils/clflags.mli +++ b/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 diff --git a/ocaml/utils/profile.ml b/ocaml/utils/profile.ml index 02e3a16d72d..fdf397a89fb 100644 --- a/ocaml/utils/profile.ml +++ b/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; diff --git a/ocaml/utils/profile.mli b/ocaml/utils/profile.mli index 7eff6957b61..3c6bf0570bc 100644 --- a/ocaml/utils/profile.mli +++ b/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 *) diff --git a/testsuite/tools/codegen_main.ml b/testsuite/tools/codegen_main.ml index e7c67ebd84e..7fc9d75f6e1 100644 --- a/testsuite/tools/codegen_main.ml +++ b/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