Skip to content

Commit

Permalink
add a dump-dir flags, make dprofile respect dump directives
Browse files Browse the repository at this point in the history
  • Loading branch information
Octachron authored and gretay-js committed Dec 29, 2021
1 parent 2d607ac commit 3930a4d
Show file tree
Hide file tree
Showing 8 changed files with 42 additions and 12 deletions.
2 changes: 2 additions & 0 deletions ocaml/driver/compenv.ml
Original file line number Diff line number Diff line change
Expand Up @@ -468,6 +468,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" ->
Expand Down
33 changes: 24 additions & 9 deletions ocaml/driver/compmisc.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
8 changes: 8 additions & 0 deletions ocaml/driver/main_args.ml
Original file line number Diff line number Diff line change
Expand Up @@ -729,6 +729,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 =
Expand Down Expand Up @@ -1041,6 +1045,7 @@ module type Compiler_options = sig
val _dprofile : unit -> unit
val _disable_all_extensions : unit -> unit
val _dump_into_file : unit -> unit
val _dump_dir : string -> unit

val _args: string -> string array
val _args0: string -> string array
Expand Down Expand Up @@ -1294,6 +1299,7 @@ struct
mk_disable_all_extensions F._disable_all_extensions;
mk_dump_into_file F._dump_into_file;
mk_extension F._extension;
mk_dump_dir F._dump_dir;

mk_args F._args;
mk_args0 F._args0;
Expand Down Expand Up @@ -1520,6 +1526,7 @@ struct
mk_dprofile F._dprofile;
mk_disable_all_extensions F._disable_all_extensions;
mk_dump_into_file F._dump_into_file;
mk_dump_dir F._dump_dir;
mk_dump_pass F._dump_pass;
mk_extension F._extension;

Expand Down Expand Up @@ -1894,6 +1901,7 @@ module Default = struct
let _dtimings () = profile_columns := [`Time]
let _disable_all_extensions = Extension.disable_all
let _dump_into_file = set dump_into_file
let _dump_dir s = dump_dir := Some s
let _for_pack s = for_package := (Some s)
let _g = set debug
let _i = set print_types
Expand Down
1 change: 1 addition & 0 deletions ocaml/driver/main_args.mli
Original file line number Diff line number Diff line change
Expand Up @@ -121,6 +121,7 @@ module type Compiler_options = sig
val _dprofile : unit -> unit
val _disable_all_extensions : unit -> unit
val _dump_into_file : unit -> unit
val _dump_dir : string -> unit

val _args: string -> string array
val _args0: string -> string array
Expand Down
3 changes: 2 additions & 1 deletion ocaml/driver/maindriver.ml
Original file line number Diff line number Diff line change
Expand Up @@ -110,5 +110,6 @@ let main argv ppf =
Location.report_exception ppf x;
2
| () ->
Profile.print Format.std_formatter !Clflags.profile_columns;
Compmisc.with_ppf_dump ~file_prefix:"profile"
(fun ppf -> Profile.print ppf !Clflags.profile_columns);
0
5 changes: 3 additions & 2 deletions ocaml/driver/optmaindriver.ml
Original file line number Diff line number Diff line change
Expand Up @@ -136,5 +136,6 @@ let main argv ppf =
Location.report_exception ppf x;
2
| () ->
Profile.print Format.std_formatter !Clflags.profile_columns;
0
Compmisc.with_ppf_dump ~file_prefix:"profile"
(fun ppf -> Profile.print ppf !Clflags.profile_columns);
0
1 change: 1 addition & 0 deletions ocaml/utils/clflags.ml
Original file line number Diff line number Diff line change
Expand Up @@ -402,6 +402,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;
Expand Down
1 change: 1 addition & 0 deletions ocaml/utils/clflags.mli
Original file line number Diff line number Diff line change
Expand Up @@ -200,6 +200,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
Expand Down

0 comments on commit 3930a4d

Please sign in to comment.