Merge pull request #1945 from gasche/stop-after-parse
new -stop-after-parse option: stop after the parsing phasemaster
commit
6e2891c324
4
Changes
4
Changes
|
@ -170,6 +170,10 @@ Working version
|
|||
(Xavier Clerc, review by Gabriel Scherer, Sébastien Hinderer, and
|
||||
Xavier Leroy)
|
||||
|
||||
- GPR#1945: new "-stop-after parse" option to stop compilation
|
||||
after the parsing pass
|
||||
(Gabriel Scherer, review by Jérémie Dimino)
|
||||
|
||||
- GRP#1953: Add locations to attributes in the parsetree.
|
||||
(Hugo Heuzard, review by Gabriel Radanne)
|
||||
|
||||
|
|
|
@ -105,6 +105,10 @@ type readenv_position =
|
|||
or ':', '|', ';', ' ' or ',' *)
|
||||
exception SyntaxError of string
|
||||
|
||||
let print_error ppf msg =
|
||||
Location.print_warning Location.none ppf
|
||||
(Warnings.Bad_env_variable ("OCAMLPARAM", msg))
|
||||
|
||||
let parse_args s =
|
||||
let args =
|
||||
let len = String.length s in
|
||||
|
@ -148,25 +152,22 @@ let setter ppf f name options s =
|
|||
in
|
||||
List.iter (fun b -> b := f bool) options
|
||||
with Not_found ->
|
||||
Location.print_warning Location.none ppf
|
||||
(Warnings.Bad_env_variable ("OCAMLPARAM",
|
||||
Printf.sprintf "bad value for %s" name))
|
||||
Printf.ksprintf (print_error ppf)
|
||||
"bad value %s for %s" s name
|
||||
|
||||
let int_setter ppf name option s =
|
||||
try
|
||||
option := int_of_string s
|
||||
with _ ->
|
||||
Location.print_warning Location.none ppf
|
||||
(Warnings.Bad_env_variable
|
||||
("OCAMLPARAM", Printf.sprintf "non-integer parameter for \"%s\"" name))
|
||||
Printf.ksprintf (print_error ppf)
|
||||
"non-integer parameter %s for %S" s name
|
||||
|
||||
let int_option_setter ppf name option s =
|
||||
try
|
||||
option := Some (int_of_string s)
|
||||
with _ ->
|
||||
Location.print_warning Location.none ppf
|
||||
(Warnings.Bad_env_variable
|
||||
("OCAMLPARAM", Printf.sprintf "non-integer parameter for \"%s\"" name))
|
||||
Printf.ksprintf (print_error ppf)
|
||||
"non-integer parameter %s for %S" s name
|
||||
|
||||
(*
|
||||
let float_setter ppf name option s =
|
||||
|
@ -185,9 +186,8 @@ let check_bool ppf name s =
|
|||
| "0" -> false
|
||||
| "1" -> true
|
||||
| _ ->
|
||||
Location.print_warning Location.none ppf
|
||||
(Warnings.Bad_env_variable ("OCAMLPARAM",
|
||||
Printf.sprintf "bad value for %s" name));
|
||||
Printf.ksprintf (print_error ppf)
|
||||
"bad value %s for %s" s name;
|
||||
false
|
||||
|
||||
(* 'can-discard=' specifies which arguments can be discarded without warning
|
||||
|
@ -260,12 +260,8 @@ let read_one_param ppf position name v =
|
|||
begin match F.parse_no_error v inline_threshold with
|
||||
| F.Ok -> ()
|
||||
| F.Parse_failed exn ->
|
||||
let error =
|
||||
Printf.sprintf "bad syntax for \"inline\": %s"
|
||||
(Printexc.to_string exn)
|
||||
in
|
||||
Location.print_warning Location.none ppf
|
||||
(Warnings.Bad_env_variable ("OCAMLPARAM", error))
|
||||
Printf.ksprintf (print_error ppf)
|
||||
"bad syntax %s for \"inline\": %s" v (Printexc.to_string exn)
|
||||
end
|
||||
|
||||
| "inline-toplevel" ->
|
||||
|
@ -348,10 +344,9 @@ let read_one_param ppf position name v =
|
|||
| "color" ->
|
||||
begin match parse_color_setting v with
|
||||
| None ->
|
||||
Location.print_warning Location.none ppf
|
||||
(Warnings.Bad_env_variable ("OCAMLPARAM",
|
||||
"bad value for \"color\", \
|
||||
(expected \"auto\", \"always\" or \"never\")"))
|
||||
Printf.ksprintf (print_error ppf)
|
||||
"bad value %s for \"color\", \
|
||||
(expected \"auto\", \"always\" or \"never\")" v
|
||||
| Some setting -> color := Some setting
|
||||
end
|
||||
|
||||
|
@ -426,10 +421,24 @@ let read_one_param ppf position name v =
|
|||
|
||||
| "plugin" -> !load_plugin v
|
||||
|
||||
| "stop-after" ->
|
||||
let module P = Clflags.Compiler_pass in
|
||||
begin match P.of_string v with
|
||||
| None ->
|
||||
Printf.ksprintf (print_error ppf)
|
||||
"bad value %s for option \"stop-after\" (expected one of: %s)"
|
||||
v (String.concat ", " P.pass_names)
|
||||
| Some pass ->
|
||||
Clflags.stop_after := Some pass;
|
||||
begin match pass with
|
||||
| P.Parsing | P.Typing ->
|
||||
compile_only := true
|
||||
end;
|
||||
end
|
||||
| _ ->
|
||||
if not (List.mem name !can_discard) then begin
|
||||
can_discard := name :: !can_discard;
|
||||
Printf.eprintf
|
||||
Printf.ksprintf (print_error ppf)
|
||||
"Warning: discarding value of variable %S in OCAMLPARAM\n%!"
|
||||
name
|
||||
end
|
||||
|
@ -441,9 +450,8 @@ let read_OCAMLPARAM ppf position =
|
|||
try
|
||||
parse_args s
|
||||
with SyntaxError s ->
|
||||
Location.print_warning Location.none ppf
|
||||
(Warnings.Bad_env_variable ("OCAMLPARAM", s));
|
||||
[],[]
|
||||
print_error ppf s;
|
||||
[],[]
|
||||
in
|
||||
List.iter (fun (name, v) -> read_one_param ppf position name v)
|
||||
(match position with
|
||||
|
|
|
@ -112,11 +112,13 @@ let implementation ~tool_name ~native ~backend ~sourcefile ~outputprefix =
|
|||
in
|
||||
Profile.record_call info.sourcefile @@ fun () ->
|
||||
let parsed = parse_impl info in
|
||||
let typed = typecheck_impl info parsed in
|
||||
if not !Clflags.print_types then begin
|
||||
let exceptionally () =
|
||||
List.iter (fun suf -> remove_file (suf info)) sufs;
|
||||
in
|
||||
Misc.try_finally ~exceptionally (fun () -> backend info typed)
|
||||
if Clflags.(should_stop_after Compiler_pass.Parsing) then () else begin
|
||||
let typed = typecheck_impl info parsed in
|
||||
if Clflags.(should_stop_after Compiler_pass.Typing) then () else begin
|
||||
let exceptionally () =
|
||||
List.iter (fun suf -> remove_file (suf info)) sufs;
|
||||
in
|
||||
Misc.try_finally ~exceptionally (fun () -> backend info typed)
|
||||
end;
|
||||
end;
|
||||
Warnings.check_fatal ();
|
||||
|
|
|
@ -41,7 +41,22 @@ module Options = Main_args.Make_bytecomp_options (struct
|
|||
let _dllpath s = dllpaths := !dllpaths @ [s]
|
||||
let _for_pack s = for_package := Some s
|
||||
let _g = set debug
|
||||
let _i () = print_types := true; compile_only := true
|
||||
let _i () =
|
||||
print_types := true;
|
||||
compile_only := true;
|
||||
stop_after := Some Compiler_pass.Typing;
|
||||
()
|
||||
let _stop_after pass =
|
||||
let module P = Compiler_pass in
|
||||
begin match P.of_string pass with
|
||||
| None -> () (* this should not occur as we use Arg.Symbol *)
|
||||
| Some pass ->
|
||||
stop_after := Some pass;
|
||||
begin match pass with
|
||||
| P.Parsing | P.Typing ->
|
||||
compile_only := true
|
||||
end;
|
||||
end
|
||||
let _I s = include_dirs := s :: !include_dirs
|
||||
let _impl = impl
|
||||
let _intf = intf
|
||||
|
@ -156,11 +171,17 @@ let main () =
|
|||
(List.filter (fun x -> !x)
|
||||
[make_archive;make_package;compile_only;output_c_object])
|
||||
> 1
|
||||
then
|
||||
if !print_types then
|
||||
fatal "Option -i is incompatible with -pack, -a, -output-obj"
|
||||
else
|
||||
then begin
|
||||
let module P = Clflags.Compiler_pass in
|
||||
match !stop_after with
|
||||
| None ->
|
||||
fatal "Please specify at most one of -pack, -a, -c, -output-obj";
|
||||
| Some (P.Parsing | P.Typing) ->
|
||||
Printf.ksprintf fatal
|
||||
"Options -i and -stop-after (%s)\
|
||||
are incompatible with -pack, -a, -output-obj"
|
||||
(String.concat "|" P.pass_names)
|
||||
end;
|
||||
if !make_archive then begin
|
||||
Compmisc.init_path false;
|
||||
|
||||
|
|
|
@ -83,6 +83,11 @@ let mk_dllpath f =
|
|||
"<dir> Add <dir> to the run-time search path for shared libraries"
|
||||
;;
|
||||
|
||||
let mk_stop_after f =
|
||||
"-stop-after", Arg.Symbol (Clflags.Compiler_pass.pass_names, f),
|
||||
" Stop after the given compilation pass."
|
||||
;;
|
||||
|
||||
let mk_dtypes f =
|
||||
"-dtypes", Arg.Unit f, " (deprecated) same as -annot"
|
||||
;;
|
||||
|
@ -867,6 +872,7 @@ module type Compiler_options = sig
|
|||
val _config_var : string -> unit
|
||||
val _for_pack : string -> unit
|
||||
val _g : unit -> unit
|
||||
val _stop_after : string -> unit
|
||||
val _i : unit -> unit
|
||||
val _impl : string -> unit
|
||||
val _intf : string -> unit
|
||||
|
@ -1059,6 +1065,7 @@ struct
|
|||
mk_dtypes F._annot;
|
||||
mk_for_pack_byt F._for_pack;
|
||||
mk_g_byt F._g;
|
||||
mk_stop_after F._stop_after;
|
||||
mk_i F._i;
|
||||
mk_I F._I;
|
||||
mk_impl F._impl;
|
||||
|
@ -1224,6 +1231,7 @@ struct
|
|||
mk_dtypes F._annot;
|
||||
mk_for_pack_opt F._for_pack;
|
||||
mk_g_opt F._g;
|
||||
mk_stop_after F._stop_after;
|
||||
mk_i F._i;
|
||||
mk_I F._I;
|
||||
mk_impl F._impl;
|
||||
|
|
|
@ -73,6 +73,7 @@ module type Compiler_options = sig
|
|||
val _config_var : string -> unit
|
||||
val _for_pack : string -> unit
|
||||
val _g : unit -> unit
|
||||
val _stop_after : string -> unit
|
||||
val _i : unit -> unit
|
||||
val _impl : string -> unit
|
||||
val _intf : string -> unit
|
||||
|
|
|
@ -56,7 +56,22 @@ module Options = Main_args.Make_optcomp_options (struct
|
|||
let _config_var = Misc.show_config_variable_and_exit
|
||||
let _for_pack s = for_package := Some s
|
||||
let _g = set debug
|
||||
let _i () = print_types := true; compile_only := true
|
||||
let _i () =
|
||||
print_types := true;
|
||||
compile_only := true;
|
||||
stop_after := Some Compiler_pass.Typing;
|
||||
()
|
||||
let _stop_after pass =
|
||||
let module P = Compiler_pass in
|
||||
begin match P.of_string pass with
|
||||
| None -> () (* this should not occur as we use Arg.Symbol *)
|
||||
| Some pass ->
|
||||
stop_after := Some pass;
|
||||
begin match pass with
|
||||
| P.Parsing | P.Typing ->
|
||||
compile_only := true
|
||||
end;
|
||||
end
|
||||
let _I dir = include_dirs := dir :: !include_dirs
|
||||
let _impl = impl
|
||||
let _inline spec =
|
||||
|
|
|
@ -620,6 +620,12 @@ then the
|
|||
.B d
|
||||
suffix is supported and gives a debug version of the runtime.
|
||||
.TP
|
||||
.BI \-stop\-after \ pass
|
||||
Stop compilation after the given compilation pass. The currently
|
||||
supported passes are:
|
||||
.BR parsing ,
|
||||
.BR typing .
|
||||
.TP
|
||||
.B \-safe\-string
|
||||
Enforce the separation between types
|
||||
.BR string \ and\ bytes ,
|
||||
|
|
|
@ -569,6 +569,12 @@ code for the source file
|
|||
is saved in the file
|
||||
.IR x .s.
|
||||
.TP
|
||||
.BI \-stop\-after \ pass
|
||||
Stop compilation after the given compilation pass. The currently
|
||||
supported passes are:
|
||||
.BR parsing ,
|
||||
.BR typing .
|
||||
.TP
|
||||
.B \-safe\-string
|
||||
Enforce the separation between types
|
||||
.BR string \ and\ bytes ,
|
||||
|
|
|
@ -606,6 +606,12 @@ runtime, which is useful for debugging pointer problems in low-level
|
|||
code such as C stubs.
|
||||
}%notop
|
||||
|
||||
\notop{
|
||||
\item["-stop-after" \var{pass}]
|
||||
Stop compilation after the given compilation pass. The currently
|
||||
supported passes are: "parsing", "typing".
|
||||
}%notop
|
||||
|
||||
\nat{%
|
||||
\item["-S"]
|
||||
Keep the assembly code produced during the compilation. The assembly
|
||||
|
|
|
@ -63,6 +63,7 @@ module Options = Main_args.Make_bytecomp_options (struct
|
|||
let _dtypes = option "-dtypes"
|
||||
let _for_pack = option_with_arg "-for-pack"
|
||||
let _g = option "-g"
|
||||
let _stop_after = option_with_arg "-stop-after"
|
||||
let _i = option "-i"
|
||||
let _I s = option_with_arg "-I" s
|
||||
let _impl s = with_impl := true; option_with_arg "-impl" s
|
||||
|
|
|
@ -65,6 +65,7 @@ module Options = Main_args.Make_optcomp_options (struct
|
|||
let _config_var s = option_with_arg "-config-var" s
|
||||
let _for_pack s = option_with_arg "-for-pack" s
|
||||
let _g = option "-g"
|
||||
let _stop_after = option_with_arg "-stop-after"
|
||||
let _i = option "-i"
|
||||
let _I s = option_with_arg "-I" s
|
||||
let _impl s = with_impl := true; option_with_arg "-impl" s
|
||||
|
|
|
@ -376,6 +376,42 @@ let color = ref None ;; (* -color *)
|
|||
|
||||
let unboxed_types = ref false
|
||||
|
||||
(* This is used by the -stop-after option. *)
|
||||
module Compiler_pass = struct
|
||||
(* If you add a new pass, the following must be updated:
|
||||
- the variable `passes` below
|
||||
- the manpages in man/ocaml{c,opt}.m
|
||||
- the manual manual/manual/cmds/unified-options.etex
|
||||
*)
|
||||
type t = Parsing | Typing
|
||||
|
||||
let to_string = function
|
||||
| Parsing -> "parsing"
|
||||
| Typing -> "typing"
|
||||
|
||||
let of_string = function
|
||||
| "parsing" -> Some Parsing
|
||||
| "typing" -> Some Typing
|
||||
| _ -> None
|
||||
|
||||
let rank = function
|
||||
| Parsing -> 0
|
||||
| Typing -> 1
|
||||
|
||||
let passes = [
|
||||
Parsing;
|
||||
Typing;
|
||||
]
|
||||
let pass_names = List.map to_string passes
|
||||
end
|
||||
|
||||
let stop_after = ref None (* -stop-after *)
|
||||
|
||||
let should_stop_after pass =
|
||||
match !stop_after with
|
||||
| None -> false
|
||||
| Some stop -> Compiler_pass.rank stop <= Compiler_pass.rank pass
|
||||
|
||||
module String = Misc.Stdlib.String
|
||||
|
||||
let arg_spec = ref []
|
||||
|
|
|
@ -217,6 +217,16 @@ val color : Misc.Color.setting option ref
|
|||
|
||||
val unboxed_types : bool ref
|
||||
|
||||
module Compiler_pass : sig
|
||||
type t = Parsing | Typing
|
||||
val of_string : string -> t option
|
||||
val to_string : t -> string
|
||||
val passes : t list
|
||||
val pass_names : string list
|
||||
end
|
||||
val stop_after : Compiler_pass.t option ref
|
||||
val should_stop_after : Compiler_pass.t -> bool
|
||||
|
||||
val arg_spec : (string * Arg.spec * string) list ref
|
||||
|
||||
(* [add_arguments __LOC__ args] will add the arguments from [args] at
|
||||
|
|
Loading…
Reference in New Issue