Merge pull request #1941 from sliquister/ocamlcp-dedup3
reduce boilerplate in compiler command line parsingmaster
Florian Angeletti
GitHub
commit
f15ee3be5d
3
Changes
3
Changes
|
|
@ -594,6 +594,9 @@ OCaml 4.08.0
|
|||
- GPR#1938: always check ast invariants after preprocessing
|
||||
(Florian Angeletti, review by Alain Frisch and Gabriel Scherer)
|
||||
|
||||
- GPR#1941: refactor the command line parsing of ocamlcp and ocamloptp
|
||||
(Valentin Gatien-Baron, review by Florian Angeletti)
|
||||
|
||||
- GPR#1948: Refactor Stdlib.Format. Notably, use Stdlib.Stack and Stdlib.Queue,
|
||||
and avoid exceptions for control flow.
|
||||
(Vladimir Keleshev, review by Nicolás Ojeda Bär and Gabriel Scherer)
|
||||
|
|
|
|||
|
|
@ -1536,3 +1536,46 @@ struct
|
|||
mk__ F.anonymous;
|
||||
]
|
||||
end;;
|
||||
|
||||
[@@@ocaml.warning "-40"]
|
||||
let options_with_command_line_syntax_inner r after_rest =
|
||||
let rec loop ~name_opt (spec : Arg.spec) : Arg.spec =
|
||||
let option =
|
||||
match name_opt with
|
||||
| None -> ignore
|
||||
| Some name -> (fun () -> r := name :: !r)
|
||||
in
|
||||
let arg a = r := Filename.quote a :: !r in
|
||||
let option_with_arg a = option (); arg a in
|
||||
let rest a =
|
||||
if not !after_rest then (after_rest := true; option ());
|
||||
arg a
|
||||
in
|
||||
match spec with
|
||||
| Unit f -> Unit (fun a -> f a; option ())
|
||||
| Bool f -> Bool (fun a -> f a; option_with_arg (string_of_bool a))
|
||||
| Set r -> Unit (fun () -> r := true; option ())
|
||||
| Clear r -> Unit (fun () -> r := false; option ())
|
||||
| String f -> String (fun a -> f a; option_with_arg a)
|
||||
| Set_string r -> String (fun a -> r := a; option_with_arg a)
|
||||
| Int f -> Int (fun a -> f a; option_with_arg (string_of_int a))
|
||||
| Set_int r -> Int (fun a -> r := a; option_with_arg (string_of_int a))
|
||||
| Float f -> Float (fun a -> f a; option_with_arg (string_of_float a))
|
||||
| Set_float r ->
|
||||
Float (fun a -> r := a; option_with_arg (string_of_float a))
|
||||
| Tuple [] -> Unit option
|
||||
| Tuple (hd :: tl) ->
|
||||
Tuple (loop ~name_opt hd :: List.map (loop ~name_opt:None) tl)
|
||||
| Symbol (l, f) -> Symbol (l, (fun a -> f a; option_with_arg a))
|
||||
| Rest f -> Rest (fun a -> f a; rest a)
|
||||
| Expand f -> Expand f
|
||||
in
|
||||
loop
|
||||
|
||||
let options_with_command_line_syntax options r =
|
||||
let rest = ref false in
|
||||
List.map (fun (name, spec, doc) ->
|
||||
(name,
|
||||
options_with_command_line_syntax_inner r rest
|
||||
~name_opt:(Some name) spec, doc)
|
||||
) options
|
||||
|
|
|
|||
|
|
@ -254,3 +254,13 @@ module Make_bytetop_options (F : Bytetop_options) : Arg_list;;
|
|||
module Make_optcomp_options (F : Optcomp_options) : Arg_list;;
|
||||
module Make_opttop_options (F : Opttop_options) : Arg_list;;
|
||||
module Make_ocamldoc_options (F : Ocamldoc_options) : Arg_list;;
|
||||
|
||||
(** [options_with_command_line_syntax options r] returns [options2] that behaves
|
||||
like [options], but additionally pushes command line argument on [r] (quoted
|
||||
by [Filename.quote] when necessary).
|
||||
This is meant for ocaml{c,opt}p, which use this to forward most of their
|
||||
arguments to ocaml{c,opt}. *)
|
||||
val options_with_command_line_syntax
|
||||
: (string * Arg.spec * string) list
|
||||
-> string list ref
|
||||
-> (string * Arg.spec * string) list
|
||||
|
|
|
|||
221
tools/ocamlcp.ml
221
tools/ocamlcp.ml
|
|
@ -15,18 +15,6 @@
|
|||
|
||||
open Printf
|
||||
|
||||
let compargs = ref ([] : string list)
|
||||
let profargs = ref ([] : string list)
|
||||
let toremove = ref ([] : string list)
|
||||
|
||||
let option opt () = compargs := opt :: !compargs
|
||||
let option_with_arg opt arg =
|
||||
compargs := (Filename.quote arg) :: opt :: !compargs
|
||||
;;
|
||||
let option_with_int opt arg =
|
||||
compargs := (Int.to_string arg) :: opt :: !compargs
|
||||
;;
|
||||
|
||||
let make_archive = ref false;;
|
||||
let with_impl = ref false;;
|
||||
let with_intf = ref false;;
|
||||
|
|
@ -36,7 +24,6 @@ let with_ml = ref false;;
|
|||
let process_file filename =
|
||||
if Filename.check_suffix filename ".ml" then with_ml := true;
|
||||
if Filename.check_suffix filename ".mli" then with_mli := true;
|
||||
compargs := (Filename.quote filename) :: !compargs
|
||||
;;
|
||||
|
||||
let usage = "Usage: ocamlcp <options> <files>\noptions are:"
|
||||
|
|
@ -46,106 +33,114 @@ let incompatible o =
|
|||
exit 2
|
||||
|
||||
module Options = Main_args.Make_bytecomp_options (struct
|
||||
let _a () = make_archive := true; option "-a" ()
|
||||
let _absname = option "-absname"
|
||||
let _alert = option_with_arg "-alert"
|
||||
let _annot = option "-annot"
|
||||
let _binannot = option "-bin-annot"
|
||||
let _c = option "-c"
|
||||
let _cc s = option_with_arg "-cc" s
|
||||
let _cclib s = option_with_arg "-cclib" s
|
||||
let _ccopt s = option_with_arg "-ccopt" s
|
||||
let _config = option "-config"
|
||||
let _config_var s = option_with_arg "-config-var" s
|
||||
let _compat_32 = option "-compat-32"
|
||||
let _custom = option "-custom"
|
||||
let _dllib = option_with_arg "-dllib"
|
||||
let _dllpath = option_with_arg "-dllpath"
|
||||
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
|
||||
let _intf s = with_intf := true; option_with_arg "-intf" s
|
||||
let _intf_suffix s = option_with_arg "-intf-suffix" s
|
||||
let _keep_docs = option "-keep-docs"
|
||||
let _no_keep_docs = option "-no-keep-docs"
|
||||
let _keep_locs = option "-keep-locs"
|
||||
let _no_keep_locs = option "-no-keep-locs"
|
||||
let _labels = option "-labels"
|
||||
let _linkall = option "-linkall"
|
||||
let _make_runtime = option "-make-runtime"
|
||||
let _alias_deps = option "-alias-deps"
|
||||
let _no_alias_deps = option "-no-alias-deps"
|
||||
let _app_funct = option "-app-funct"
|
||||
let _no_app_funct = option "-no-app-funct"
|
||||
let _no_check_prims = option "-no-check-prims"
|
||||
let _noassert = option "-noassert"
|
||||
let _nolabels = option "-nolabels"
|
||||
let _noautolink = option "-noautolink"
|
||||
let _nostdlib = option "-nostdlib"
|
||||
let _o s = option_with_arg "-o" s
|
||||
let _opaque = option "-opaque"
|
||||
let _open s = option_with_arg "-open" s
|
||||
let _output_obj = option "-output-obj"
|
||||
let _output_complete_obj = option "-output-complete-obj"
|
||||
let _pack = option "-pack"
|
||||
let _plugin = option_with_arg "-plugin"
|
||||
let _pp _s = incompatible "-pp"
|
||||
let _ppx _s = incompatible "-ppx"
|
||||
let _principal = option "-principal"
|
||||
let _no_principal = option "-no-principal"
|
||||
let _rectypes = option "-rectypes"
|
||||
let _no_rectypes = option "-no-rectypes"
|
||||
let _runtime_variant s = option_with_arg "-runtime-variant" s
|
||||
let _safe_string = option "-safe-string"
|
||||
let _short_paths = option "-short-paths"
|
||||
let _strict_sequence = option "-strict-sequence"
|
||||
let _no_strict_sequence = option "-no-strict-sequence"
|
||||
let _strict_formats = option "-strict-formats"
|
||||
let _no_strict_formats = option "-no-strict-formats"
|
||||
let _thread () = option "-thread" ()
|
||||
let _vmthread () = option "-vmthread" ()
|
||||
let _unboxed_types = option "-unboxed-types"
|
||||
let _no_unboxed_types = option "-no-unboxed-types"
|
||||
let _unsafe = option "-unsafe"
|
||||
let _unsafe_string = option "-unsafe-string"
|
||||
let _use_prims s = option_with_arg "-use-prims" s
|
||||
let _use_runtime s = option_with_arg "-use-runtime" s
|
||||
let _v = option "-v"
|
||||
let _version = option "-version"
|
||||
let _vnum = option "-vnum"
|
||||
let _verbose = option "-verbose"
|
||||
let _w = option_with_arg "-w"
|
||||
let _warn_error = option_with_arg "-warn-error"
|
||||
let _warn_help = option "-warn-help"
|
||||
let _color s = option_with_arg "-color" s
|
||||
let _error_style s = option_with_arg "-error-style" s
|
||||
let _where = option "-where"
|
||||
let _nopervasives = option "-nopervasives"
|
||||
let _match_context_rows n = option_with_int "-match-context-rows" n
|
||||
let _dump_into_file = option "-dump-into-file"
|
||||
let _dno_unique_ids = option "-dno-unique-ids"
|
||||
let _dunique_ids = option "-dunique-ids"
|
||||
let _dsource = option "-dsource"
|
||||
let _dparsetree = option "-dparsetree"
|
||||
let _dtypedtree = option "-dtypedtree"
|
||||
let _drawlambda = option "-drawlambda"
|
||||
let _dlambda = option "-dlambda"
|
||||
let _dflambda = option "-dflambda"
|
||||
let _dinstr = option "-dinstr"
|
||||
let _dcamlprimc = option "-dcamlprimc"
|
||||
let _dtimings = option "-dtimings"
|
||||
let _dprofile = option "-dprofile"
|
||||
let _a () = make_archive := true
|
||||
let _absname = ignore
|
||||
let _alert = ignore
|
||||
let _annot = ignore
|
||||
let _binannot = ignore
|
||||
let _c = ignore
|
||||
let _cc = ignore
|
||||
let _cclib = ignore
|
||||
let _ccopt = ignore
|
||||
let _config = ignore
|
||||
let _config_var = ignore
|
||||
let _compat_32 = ignore
|
||||
let _custom = ignore
|
||||
let _dllib = ignore
|
||||
let _dllpath = ignore
|
||||
let _dtypes = ignore
|
||||
let _for_pack = ignore
|
||||
let _g = ignore
|
||||
let _stop_after = ignore
|
||||
let _i = ignore
|
||||
let _I = ignore
|
||||
let _impl _ = with_impl := true
|
||||
let _intf _ = with_intf := true
|
||||
let _intf_suffix = ignore
|
||||
let _keep_docs = ignore
|
||||
let _no_keep_docs = ignore
|
||||
let _keep_locs = ignore
|
||||
let _no_keep_locs = ignore
|
||||
let _labels = ignore
|
||||
let _linkall = ignore
|
||||
let _make_runtime = ignore
|
||||
let _alias_deps = ignore
|
||||
let _no_alias_deps = ignore
|
||||
let _app_funct = ignore
|
||||
let _no_app_funct = ignore
|
||||
let _no_check_prims = ignore
|
||||
let _noassert = ignore
|
||||
let _nolabels = ignore
|
||||
let _noautolink = ignore
|
||||
let _nostdlib = ignore
|
||||
let _o = ignore
|
||||
let _opaque = ignore
|
||||
let _open = ignore
|
||||
let _output_obj = ignore
|
||||
let _output_complete_obj = ignore
|
||||
let _pack = ignore
|
||||
let _plugin = ignore
|
||||
let _pp _ = incompatible "-pp"
|
||||
let _ppx _ = incompatible "-ppx"
|
||||
let _principal = ignore
|
||||
let _no_principal = ignore
|
||||
let _rectypes = ignore
|
||||
let _no_rectypes = ignore
|
||||
let _runtime_variant = ignore
|
||||
let _safe_string = ignore
|
||||
let _short_paths = ignore
|
||||
let _strict_sequence = ignore
|
||||
let _no_strict_sequence = ignore
|
||||
let _strict_formats = ignore
|
||||
let _no_strict_formats = ignore
|
||||
let _thread = ignore
|
||||
let _vmthread = ignore
|
||||
let _unboxed_types = ignore
|
||||
let _no_unboxed_types = ignore
|
||||
let _unsafe = ignore
|
||||
let _unsafe_string = ignore
|
||||
let _use_prims = ignore
|
||||
let _use_runtime = ignore
|
||||
let _v = ignore
|
||||
let _version = ignore
|
||||
let _vnum = ignore
|
||||
let _verbose = ignore
|
||||
let _w = ignore
|
||||
let _warn_error = ignore
|
||||
let _warn_help = ignore
|
||||
let _color = ignore
|
||||
let _error_style = ignore
|
||||
let _where = ignore
|
||||
let _nopervasives = ignore
|
||||
let _match_context_rows = ignore
|
||||
let _dump_into_file = ignore
|
||||
let _dno_unique_ids = ignore
|
||||
let _dunique_ids = ignore
|
||||
let _dsource = ignore
|
||||
let _dparsetree = ignore
|
||||
let _dtypedtree = ignore
|
||||
let _drawlambda = ignore
|
||||
let _dlambda = ignore
|
||||
let _dflambda = ignore
|
||||
let _dinstr = ignore
|
||||
let _dcamlprimc = ignore
|
||||
let _dtimings = ignore
|
||||
let _dprofile = ignore
|
||||
let _args = Arg.read_arg
|
||||
let _args0 = Arg.read_arg0
|
||||
let anonymous = process_file
|
||||
end);;
|
||||
|
||||
let rev_compargs = ref ([] : string list)
|
||||
let rev_profargs = ref ([] : string list)
|
||||
|
||||
let add_profarg s =
|
||||
profargs := (Filename.quote s) :: "-m" :: !profargs
|
||||
rev_profargs := (Filename.quote s) :: "-m" :: !rev_profargs
|
||||
;;
|
||||
|
||||
let anon filename =
|
||||
process_file filename;
|
||||
rev_compargs := Filename.quote filename :: !rev_compargs
|
||||
;;
|
||||
|
||||
let optlist =
|
||||
|
|
@ -158,9 +153,9 @@ let optlist =
|
|||
\032 m match ... with\n\
|
||||
\032 t try ... with")
|
||||
:: ("-p", Arg.String add_profarg, "[afilmt] Same as option -P")
|
||||
:: Options.list
|
||||
:: Main_args.options_with_command_line_syntax Options.list rev_compargs
|
||||
in
|
||||
Arg.parse_expand optlist process_file usage;
|
||||
Arg.parse_expand optlist anon usage;
|
||||
if !with_impl && !with_intf then begin
|
||||
fprintf stderr "ocamlcp cannot deal with both \"-impl\" and \"-intf\"\n";
|
||||
fprintf stderr "please compile interfaces and implementations separately\n";
|
||||
|
|
@ -174,14 +169,14 @@ end else if !with_intf && !with_ml then begin
|
|||
fprintf stderr "please compile interfaces and implementations separately\n";
|
||||
exit 2;
|
||||
end;
|
||||
if !with_impl then profargs := "-impl" :: !profargs;
|
||||
if !with_intf then profargs := "-intf" :: !profargs;
|
||||
if !with_impl then rev_profargs := "-impl" :: !rev_profargs;
|
||||
if !with_intf then rev_profargs := "-intf" :: !rev_profargs;
|
||||
let status =
|
||||
Sys.command
|
||||
(Printf.sprintf "ocamlc -pp \"ocamlprof -instrument %s\" %s %s"
|
||||
(String.concat " " (List.rev !profargs))
|
||||
(String.concat " " (List.rev !rev_profargs))
|
||||
(if !make_archive then "" else "profiling.cmo")
|
||||
(String.concat " " (List.rev !compargs)))
|
||||
(String.concat " " (List.rev !rev_compargs)))
|
||||
in
|
||||
exit status
|
||||
;;
|
||||
|
|
|
|||
|
|
@ -15,21 +15,6 @@
|
|||
|
||||
open Printf
|
||||
|
||||
let compargs = ref ([] : string list)
|
||||
let profargs = ref ([] : string list)
|
||||
let toremove = ref ([] : string list)
|
||||
|
||||
let option opt () = compargs := opt :: !compargs
|
||||
let option_with_arg opt arg =
|
||||
compargs := (Filename.quote arg) :: opt :: !compargs
|
||||
;;
|
||||
let option_with_int opt arg =
|
||||
compargs := (Int.to_string arg) :: opt :: !compargs
|
||||
;;
|
||||
let option_with_float opt arg =
|
||||
compargs := (string_of_float arg) :: opt :: !compargs
|
||||
;;
|
||||
|
||||
let make_archive = ref false;;
|
||||
let with_impl = ref false;;
|
||||
let with_intf = ref false;;
|
||||
|
|
@ -39,7 +24,6 @@ let with_ml = ref false;;
|
|||
let process_file filename =
|
||||
if Filename.check_suffix filename ".ml" then with_ml := true;
|
||||
if Filename.check_suffix filename ".mli" then with_mli := true;
|
||||
compargs := (Filename.quote filename) :: !compargs
|
||||
;;
|
||||
|
||||
let usage = "Usage: ocamloptp <options> <files>\noptions are:"
|
||||
|
|
@ -49,152 +33,160 @@ let incompatible o =
|
|||
exit 2
|
||||
|
||||
module Options = Main_args.Make_optcomp_options (struct
|
||||
let _a () = make_archive := true; option "-a" ()
|
||||
let _absname = option "-absname"
|
||||
let _afl_instrument = option "-afl-instrument"
|
||||
let _afl_inst_ratio n = option_with_int "-afl-inst-ratio" n
|
||||
let _alert = option_with_arg "-alert"
|
||||
let _annot = option "-annot"
|
||||
let _binannot = option "-bin-annot"
|
||||
let _c = option "-c"
|
||||
let _cc s = option_with_arg "-cc" s
|
||||
let _cclib s = option_with_arg "-cclib" s
|
||||
let _ccopt s = option_with_arg "-ccopt" s
|
||||
let _clambda_checks = option "-clambda-checks"
|
||||
let _compact = option "-compact"
|
||||
let _config = option "-config"
|
||||
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
|
||||
let _inline s = option_with_arg "-inline" s
|
||||
let _inline_toplevel n = option_with_arg "-inline-toplevel" n
|
||||
let _inlining_report = option "-inlining-report"
|
||||
let _dump_pass = option_with_arg "-dump-pass"
|
||||
let _inline_max_depth n = option_with_arg "-inline-max-depth" n
|
||||
let _rounds n = option_with_int "-rounds" n
|
||||
let _inline_max_unroll n = option_with_arg "-inline-max-unroll" n
|
||||
let _inline_call_cost n = option_with_arg "-inline-call-cost" n
|
||||
let _inline_alloc_cost n = option_with_arg "-inline-alloc-cost" n
|
||||
let _inline_prim_cost n = option_with_arg "-inline-prim-cost" n
|
||||
let _inline_branch_cost n = option_with_arg "-inline-branch-cost" n
|
||||
let _inline_indirect_cost n = option_with_arg "-inline-indirect-cost" n
|
||||
let _inline_lifting_benefit n = option_with_arg "-inline-lifting-benefit" n
|
||||
let _inline_branch_factor n = option_with_arg "-inline-branch-factor" n
|
||||
let _classic_inlining = option "-Oclassic"
|
||||
let _intf s = with_intf := true; option_with_arg "-intf" s
|
||||
let _intf_suffix s = option_with_arg "-intf-suffix" s
|
||||
let _keep_docs = option "-keep-docs"
|
||||
let _no_keep_docs = option "-no-keep-docs"
|
||||
let _keep_locs = option "-keep-locs"
|
||||
let _no_keep_locs = option "-no-keep-locs"
|
||||
let _labels = option "-labels"
|
||||
let _linkall = option "-linkall"
|
||||
let _alias_deps = option "-alias-deps"
|
||||
let _no_alias_deps = option "-no-alias-deps"
|
||||
let _app_funct = option "-app-funct"
|
||||
let _no_app_funct = option "-no-app-funct"
|
||||
let _no_float_const_prop = option "-no-float-const-prop"
|
||||
let _noassert = option "-noassert"
|
||||
let _noautolink = option "-noautolink"
|
||||
let _nodynlink = option "-nodynlink"
|
||||
let _nolabels = option "-nolabels"
|
||||
let _nostdlib = option "-nostdlib"
|
||||
let _no_unbox_free_vars_of_closures = option "-no-unbox-free-vars-of-closures"
|
||||
let _no_unbox_specialised_args = option "-no-unbox-specialised-args"
|
||||
let _o s = option_with_arg "-o" s
|
||||
let _o2 = option "-O2"
|
||||
let _o3 = option "-O3"
|
||||
let _open s = option_with_arg "-open" s
|
||||
let _output_obj = option "-output-obj"
|
||||
let _output_complete_obj = option "-output-complete-obj"
|
||||
let _p = option "-p"
|
||||
let _pack = option "-pack"
|
||||
let _plugin = option_with_arg "-plugin"
|
||||
let _a () = make_archive := true
|
||||
let _absname = ignore
|
||||
let _afl_instrument = ignore
|
||||
let _afl_inst_ratio = ignore
|
||||
let _alert = ignore
|
||||
let _annot = ignore
|
||||
let _binannot = ignore
|
||||
let _c = ignore
|
||||
let _cc = ignore
|
||||
let _cclib = ignore
|
||||
let _ccopt = ignore
|
||||
let _clambda_checks = ignore
|
||||
let _compact = ignore
|
||||
let _config = ignore
|
||||
let _config_var = ignore
|
||||
let _for_pack = ignore
|
||||
let _g = ignore
|
||||
let _stop_after = ignore
|
||||
let _i = ignore
|
||||
let _I = ignore
|
||||
let _impl _ = with_impl := true
|
||||
let _inline = ignore
|
||||
let _inline_toplevel = ignore
|
||||
let _inlining_report = ignore
|
||||
let _dump_pass = ignore
|
||||
let _inline_max_depth = ignore
|
||||
let _rounds = ignore
|
||||
let _inline_max_unroll = ignore
|
||||
let _inline_call_cost = ignore
|
||||
let _inline_alloc_cost = ignore
|
||||
let _inline_prim_cost = ignore
|
||||
let _inline_branch_cost = ignore
|
||||
let _inline_indirect_cost = ignore
|
||||
let _inline_lifting_benefit = ignore
|
||||
let _inline_branch_factor = ignore
|
||||
let _classic_inlining = ignore
|
||||
let _intf _ = with_intf := true
|
||||
let _intf_suffix = ignore
|
||||
let _keep_docs = ignore
|
||||
let _no_keep_docs = ignore
|
||||
let _keep_locs = ignore
|
||||
let _no_keep_locs = ignore
|
||||
let _labels = ignore
|
||||
let _linkall = ignore
|
||||
let _alias_deps = ignore
|
||||
let _no_alias_deps = ignore
|
||||
let _app_funct = ignore
|
||||
let _no_app_funct = ignore
|
||||
let _no_float_const_prop = ignore
|
||||
let _noassert = ignore
|
||||
let _noautolink = ignore
|
||||
let _nodynlink = ignore
|
||||
let _nolabels = ignore
|
||||
let _nostdlib = ignore
|
||||
let _no_unbox_free_vars_of_closures = ignore
|
||||
let _no_unbox_specialised_args = ignore
|
||||
let _o = ignore
|
||||
let _o2 = ignore
|
||||
let _o3 = ignore
|
||||
let _open = ignore
|
||||
let _output_obj = ignore
|
||||
let _output_complete_obj = ignore
|
||||
let _p = ignore
|
||||
let _pack = ignore
|
||||
let _plugin = ignore
|
||||
let _pp _s = incompatible "-pp"
|
||||
let _ppx _s = incompatible "-ppx"
|
||||
let _principal = option "-principal"
|
||||
let _no_principal = option "-no-principal"
|
||||
let _rectypes = option "-rectypes"
|
||||
let _no_rectypes = option "-no-rectypes"
|
||||
let _remove_unused_arguments = option "-remove-unused-arguments"
|
||||
let _runtime_variant s = option_with_arg "-runtime-variant" s
|
||||
let _S = option "-S"
|
||||
let _safe_string = option "-safe-string"
|
||||
let _short_paths = option "-short-paths"
|
||||
let _strict_sequence = option "-strict-sequence"
|
||||
let _no_strict_sequence = option "-no-strict-sequence"
|
||||
let _strict_formats = option "-strict-formats"
|
||||
let _no_strict_formats = option "-no-strict-formats"
|
||||
let _shared = option "-shared"
|
||||
let _thread = option "-thread"
|
||||
let _unbox_closures = option "-unbox-closures"
|
||||
let _unbox_closures_factor = option_with_int "-unbox-closures"
|
||||
let _unboxed_types = option "-unboxed-types"
|
||||
let _no_unboxed_types = option "-no-unboxed-types"
|
||||
let _unsafe = option "-unsafe"
|
||||
let _unsafe_string = option "-unsafe-string"
|
||||
let _v = option "-v"
|
||||
let _version = option "-version"
|
||||
let _vnum = option "-vnum"
|
||||
let _verbose = option "-verbose"
|
||||
let _w = option_with_arg "-w"
|
||||
let _warn_error = option_with_arg "-warn-error"
|
||||
let _warn_help = option "-warn-help"
|
||||
let _color s = option_with_arg "-color" s
|
||||
let _error_style s = option_with_arg "-error-style" s
|
||||
let _where = option "-where"
|
||||
let _principal = ignore
|
||||
let _no_principal = ignore
|
||||
let _rectypes = ignore
|
||||
let _no_rectypes = ignore
|
||||
let _remove_unused_arguments = ignore
|
||||
let _runtime_variant = ignore
|
||||
let _S = ignore
|
||||
let _safe_string = ignore
|
||||
let _short_paths = ignore
|
||||
let _strict_sequence = ignore
|
||||
let _no_strict_sequence = ignore
|
||||
let _strict_formats = ignore
|
||||
let _no_strict_formats = ignore
|
||||
let _shared = ignore
|
||||
let _thread = ignore
|
||||
let _unbox_closures = ignore
|
||||
let _unbox_closures_factor = ignore
|
||||
let _unboxed_types = ignore
|
||||
let _no_unboxed_types = ignore
|
||||
let _unsafe = ignore
|
||||
let _unsafe_string = ignore
|
||||
let _v = ignore
|
||||
let _version = ignore
|
||||
let _vnum = ignore
|
||||
let _verbose = ignore
|
||||
let _w = ignore
|
||||
let _warn_error = ignore
|
||||
let _warn_help = ignore
|
||||
let _color = ignore
|
||||
let _error_style = ignore
|
||||
let _where = ignore
|
||||
|
||||
let _linscan = option "-linscan"
|
||||
let _nopervasives = option "-nopervasives"
|
||||
let _match_context_rows n = option_with_int "-match-context-rows" n
|
||||
let _dump_into_file = option "-dump-into-file"
|
||||
let _dno_unique_ids = option "-dno-unique_ids"
|
||||
let _dunique_ids = option "-dunique_ids"
|
||||
let _dsource = option "-dsource"
|
||||
let _dparsetree = option "-dparsetree"
|
||||
let _dtypedtree = option "-dtypedtree"
|
||||
let _drawlambda = option "-drawlambda"
|
||||
let _dlambda = option "-dlambda"
|
||||
let _drawclambda = option "-drawclambda"
|
||||
let _dclambda = option "-dclambda"
|
||||
let _drawflambda = option "-drawflambda"
|
||||
let _dflambda = option "-dflambda"
|
||||
let _dflambda_invariants = option "-dflambda-invariants"
|
||||
let _dflambda_no_invariants = option "-dflambda-no-invariants"
|
||||
let _dflambda_let stamp = option_with_int "-dflambda-let" stamp
|
||||
let _dflambda_verbose = option "-dflambda-verbose"
|
||||
let _dcmm = option "-dcmm"
|
||||
let _dsel = option "-dsel"
|
||||
let _dcombine = option "-dcombine"
|
||||
let _dcse = option "-dcse"
|
||||
let _dlive = option "-dlive"
|
||||
let _davail = option "-davail"
|
||||
let _drunavail = option "-drunavail"
|
||||
let _dspill = option "-dspill"
|
||||
let _dsplit = option "-dsplit"
|
||||
let _dinterf = option "-dinterf"
|
||||
let _dprefer = option "-dprefer"
|
||||
let _dalloc = option "-dalloc"
|
||||
let _dreload = option "-dreload"
|
||||
let _dscheduling = option "-dscheduling"
|
||||
let _dlinear = option "-dlinear"
|
||||
let _dstartup = option "-dstartup"
|
||||
let _dinterval = option "-dinterval"
|
||||
let _dtimings = option "-dtimings"
|
||||
let _dprofile = option "-dprofile"
|
||||
let _opaque = option "-opaque"
|
||||
let _linscan = ignore
|
||||
let _nopervasives = ignore
|
||||
let _match_context_rows = ignore
|
||||
let _dump_into_file = ignore
|
||||
let _dno_unique_ids = ignore
|
||||
let _dunique_ids = ignore
|
||||
let _dsource = ignore
|
||||
let _dparsetree = ignore
|
||||
let _dtypedtree = ignore
|
||||
let _drawlambda = ignore
|
||||
let _dlambda = ignore
|
||||
let _drawclambda = ignore
|
||||
let _dclambda = ignore
|
||||
let _drawflambda = ignore
|
||||
let _dflambda = ignore
|
||||
let _dflambda_invariants = ignore
|
||||
let _dflambda_no_invariants = ignore
|
||||
let _dflambda_let = ignore
|
||||
let _dflambda_verbose = ignore
|
||||
let _dcmm = ignore
|
||||
let _dsel = ignore
|
||||
let _dcombine = ignore
|
||||
let _dcse = ignore
|
||||
let _dlive = ignore
|
||||
let _davail = ignore
|
||||
let _drunavail = ignore
|
||||
let _dspill = ignore
|
||||
let _dsplit = ignore
|
||||
let _dinterf = ignore
|
||||
let _dprefer = ignore
|
||||
let _dalloc = ignore
|
||||
let _dreload = ignore
|
||||
let _dscheduling = ignore
|
||||
let _dlinear = ignore
|
||||
let _dstartup = ignore
|
||||
let _dinterval = ignore
|
||||
let _dtimings = ignore
|
||||
let _dprofile = ignore
|
||||
let _opaque = ignore
|
||||
|
||||
let _args = Arg.read_arg
|
||||
let _args0 = Arg.read_arg0
|
||||
let anonymous = process_file
|
||||
end);;
|
||||
|
||||
let rev_compargs = ref ([] : string list)
|
||||
let rev_profargs = ref ([] : string list)
|
||||
|
||||
let add_profarg s =
|
||||
profargs := (Filename.quote s) :: "-m" :: !profargs
|
||||
rev_profargs := (Filename.quote s) :: "-m" :: !rev_profargs
|
||||
;;
|
||||
|
||||
let anon filename =
|
||||
process_file filename;
|
||||
rev_compargs := Filename.quote filename :: !rev_compargs
|
||||
;;
|
||||
|
||||
let optlist =
|
||||
|
|
@ -206,9 +198,9 @@ let optlist =
|
|||
\032 l while and for loops\n\
|
||||
\032 m match ... with\n\
|
||||
\032 t try ... with")
|
||||
:: Options.list
|
||||
:: Main_args.options_with_command_line_syntax Options.list rev_compargs
|
||||
in
|
||||
Arg.parse_expand optlist process_file usage;
|
||||
Arg.parse_expand optlist anon usage;
|
||||
if !with_impl && !with_intf then begin
|
||||
fprintf stderr "ocamloptp cannot deal with both \"-impl\" and \"-intf\"\n";
|
||||
fprintf stderr "please compile interfaces and implementations separately\n";
|
||||
|
|
@ -222,14 +214,14 @@ end else if !with_intf && !with_ml then begin
|
|||
fprintf stderr "please compile interfaces and implementations separately\n";
|
||||
exit 2;
|
||||
end;
|
||||
if !with_impl then profargs := "-impl" :: !profargs;
|
||||
if !with_intf then profargs := "-intf" :: !profargs;
|
||||
if !with_impl then rev_profargs := "-impl" :: !rev_profargs;
|
||||
if !with_intf then rev_profargs := "-intf" :: !rev_profargs;
|
||||
let status =
|
||||
Sys.command
|
||||
(Printf.sprintf "ocamlopt -pp \"ocamlprof -instrument %s\" %s %s"
|
||||
(String.concat " " (List.rev !profargs))
|
||||
(String.concat " " (List.rev !rev_profargs))
|
||||
(if !make_archive then "" else "profiling.cmx")
|
||||
(String.concat " " (List.rev !compargs)))
|
||||
(String.concat " " (List.rev !rev_compargs)))
|
||||
in
|
||||
exit status
|
||||
;;
|
||||
|
|
|
|||
Loading…
Reference in New Issue