add a dump-dir flags, make dprofile respect dump directives

ocaml/ocaml#10575

driver/compenv.ml

@@ -483,6 +483,8 @@ let read_one_param ppf position name v =
       | None -> ()
       | Some pass -> set_save_ir_after pass true
     end
+  | "dump-into-file" -> Clflags.dump_into_file := true
+  | "dump-dir" -> Clflags.dump_dir := Some v
 
   | "extension" -> Clflags.Extension.enable v
   | "disable-all-extensions" ->

driver/compmisc.ml

@@ -71,16 +71,31 @@ let read_clflags_from_env () =
   set_from_env Clflags.error_style Clflags.error_style_reader;
   ()
 
+let rec make_directory dir =
+  if Sys.file_exists dir then () else
+    begin
+      make_directory (Filename.dirname dir);
+      Sys.mkdir dir 0o777
+    end
+
 let with_ppf_dump ~file_prefix f =
+  let with_ch ch =
+    let ppf = Format.formatter_of_out_channel ch in
+    ppf,
+    (fun () ->
+       Format.pp_print_flush ppf ();
+       close_out ch)
+  in
   let ppf_dump, finally =
-    if not !Clflags.dump_into_file
-    then Format.err_formatter, ignore
-    else
-       let ch = open_out (file_prefix ^ ".dump") in
-       let ppf = Format.formatter_of_out_channel ch in
-       ppf,
-       (fun () ->
-         Format.pp_print_flush ppf ();
-         close_out ch)
+    match !Clflags.dump_dir, !Clflags.dump_into_file with
+    | None, false -> Format.err_formatter, ignore
+    | None, true -> with_ch (open_out (file_prefix ^ ".dump"))
+    | Some d, _ ->
+        let () = make_directory Filename.(dirname @@ concat d @@ file_prefix) in
+        let _, ch =
+          Filename.open_temp_file ~temp_dir:d (file_prefix ^ ".")  ".dump"
+        in
+        with_ch ch
+
   in
   Misc.try_finally (fun () -> f ppf_dump) ~always:finally

driver/main_args.ml

@@ -735,6 +735,10 @@ let mk_disable_all_extensions f =
   \    overrides the -extension flag (whether specified before or after this\n\
   \    flag), disables any extensions that are enabled by default, and\n\
   \    ignores any extensions requested in OCAMLPARAM."
+
+let mk_dump_dir f =
+  "-dump-dir", Arg.String f,
+  "<dir> dump output like -dlambda into <dir>/<target>.dump"
 ;;
 
 let mk_dparsetree f =
@@ -1051,6 +1055,7 @@ module type Compiler_options = sig
   val _dtimings_precision : int -> unit
   val _dprofile : unit -> unit
   val _dump_into_file : unit -> unit
+  val _dump_dir : string -> unit
 
   val _args: string -> string array
   val _args0: string -> string array
@@ -1306,6 +1311,7 @@ struct
     mk_dtimings_precision F._dtimings_precision;
     mk_dprofile F._dprofile;
     mk_dump_into_file F._dump_into_file;
+    mk_dump_dir F._dump_dir;
 
     mk_args F._args;
     mk_args0 F._args0;
@@ -1535,6 +1541,7 @@ struct
     mk_dtimings_precision F._dtimings_precision;
     mk_dprofile F._dprofile;
     mk_dump_into_file F._dump_into_file;
+    mk_dump_dir F._dump_dir;
     mk_dump_pass F._dump_pass;
     mk_alloc_check F._alloc_check;
 
@@ -1915,6 +1922,7 @@ module Default = struct
     let _dtimings () = profile_columns := [`Time]
     let _dtimings_precision n = timings_precision := n
     let _dump_into_file = set dump_into_file
+    let _dump_dir s = dump_dir := Some s
     let _for_pack s = for_package := (Some (String.capitalize_ascii s))
     let _g = set debug
     let _i = set print_types

driver/main_args.mli

@@ -123,6 +123,7 @@ module type Compiler_options = sig
   val _dtimings_precision : int -> unit
   val _dprofile : unit -> unit
   val _dump_into_file : unit -> unit
+  val _dump_dir : string -> unit
 
   val _args: string -> string array
   val _args0: string -> string array

driver/maindriver.ml

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

driver/optmaindriver.ml

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

utils/clflags.ml

@@ -426,6 +426,7 @@ module Extension = struct
 end
 
 let dump_into_file = ref false (* -dump-into-file *)
+let dump_dir: string option ref = ref None (* -dump-dir *)
 
 type 'a env_reader = {
   parse : string -> 'a option;

utils/clflags.mli

@@ -202,6 +202,7 @@ val dumped_pass : string -> bool
 val set_dumped_pass : string -> bool -> unit
 
 val dump_into_file : bool ref
+val dump_dir : string option ref
 
 module Extension : sig
   type t = Comprehensions | Local | Include_functor