summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFlorian Angeletti <florian.angeletti@inria.fr>2019-09-27 12:16:09 +0200
committerFlorian Angeletti <florian.angeletti@inria.fr>2019-09-30 15:56:40 +0200
commita509157eb975d469db9eb934c96f913e11b4c789 (patch)
treee51936e7d3a80662560fab55692564addb4f3a5f
parente6605d6a80855e36c52b205ed13319132c8fd392 (diff)
downloadocaml-a509157eb975d469db9eb934c96f913e11b4c789.tar.gz
share argument implementation across executable
This commit defines five default argument modules in Main_args.default. Those modules provide a default implementation for the argument of ocaml, ocamlnat, ocamlc, ocamlopt, ocamldoc, ocamlcp, ocamloptp, and expect_test. Grouping together those implementations allow to share as much as possible similar implementation across executables. It should make easier to keep synchronized the various implementation, or reuse those implementation in alternative drivers.
-rw-r--r--.depend20
-rw-r--r--Makefile4
-rw-r--r--driver/main.ml130
-rw-r--r--driver/main_args.ml332
-rw-r--r--driver/main_args.mli10
-rw-r--r--driver/optmain.ml224
-rw-r--r--ocamldoc/.depend6
-rw-r--r--ocamldoc/odoc_args.ml44
-rw-r--r--testsuite/tools/expect_test.ml58
-rw-r--r--tools/Makefile4
-rw-r--r--tools/ocamlcp.ml108
-rw-r--r--tools/ocamloptp.ml139
-rw-r--r--toplevel/opttopmain.ml168
-rw-r--r--toplevel/topmain.ml72
14 files changed, 375 insertions, 944 deletions
diff --git a/.depend b/.depend
index 91a64e288c..d2ecf3022b 100644
--- a/.depend
+++ b/.depend
@@ -5681,7 +5681,6 @@ driver/errors.cmi :
driver/main.cmo : \
utils/warnings.cmi \
utils/profile.cmi \
- utils/misc.cmi \
driver/makedepend.cmi \
driver/main_args.cmi \
parsing/location.cmi \
@@ -5697,7 +5696,6 @@ driver/main.cmo : \
driver/main.cmx : \
utils/warnings.cmx \
utils/profile.cmx \
- utils/misc.cmx \
driver/makedepend.cmx \
driver/main_args.cmx \
parsing/location.cmx \
@@ -5714,13 +5712,17 @@ driver/main.cmi :
driver/main_args.cmo : \
utils/warnings.cmi \
utils/profile.cmi \
+ utils/misc.cmi \
utils/config.cmi \
+ driver/compenv.cmi \
utils/clflags.cmi \
driver/main_args.cmi
driver/main_args.cmx : \
utils/warnings.cmx \
utils/profile.cmx \
+ utils/misc.cmx \
utils/config.cmx \
+ driver/compenv.cmx \
utils/clflags.cmx \
driver/main_args.cmi
driver/main_args.cmi :
@@ -5798,9 +5800,7 @@ driver/optmain.cmo : \
utils/warnings.cmi \
utils/profile.cmi \
asmcomp/proc.cmi \
- asmcomp/printmach.cmi \
driver/optcompile.cmi \
- utils/misc.cmi \
driver/makedepend.cmi \
driver/main_args.cmi \
parsing/location.cmi \
@@ -5820,9 +5820,7 @@ driver/optmain.cmx : \
utils/warnings.cmx \
utils/profile.cmx \
asmcomp/proc.cmx \
- asmcomp/printmach.cmx \
driver/optcompile.cmx \
- utils/misc.cmx \
driver/makedepend.cmx \
driver/main_args.cmx \
parsing/location.cmx \
@@ -6050,27 +6048,21 @@ toplevel/opttoploop.cmi : \
parsing/location.cmi \
typing/env.cmi
toplevel/opttopmain.cmo : \
- utils/warnings.cmi \
- asmcomp/printmach.cmi \
toplevel/opttoploop.cmi \
toplevel/opttopdirs.cmi \
utils/misc.cmi \
driver/main_args.cmi \
parsing/location.cmi \
driver/compmisc.cmi \
- driver/compenv.cmi \
utils/clflags.cmi \
toplevel/opttopmain.cmi
toplevel/opttopmain.cmx : \
- utils/warnings.cmx \
- asmcomp/printmach.cmx \
toplevel/opttoploop.cmx \
toplevel/opttopdirs.cmx \
utils/misc.cmx \
driver/main_args.cmx \
parsing/location.cmx \
driver/compmisc.cmx \
- driver/compenv.cmx \
utils/clflags.cmx \
toplevel/opttopmain.cmi
toplevel/opttopmain.cmi :
@@ -6234,10 +6226,8 @@ toplevel/toploop.cmi : \
parsing/location.cmi \
typing/env.cmi
toplevel/topmain.cmo : \
- utils/warnings.cmi \
toplevel/toploop.cmi \
toplevel/topdirs.cmi \
- utils/profile.cmi \
utils/misc.cmi \
driver/main_args.cmi \
parsing/location.cmi \
@@ -6246,10 +6236,8 @@ toplevel/topmain.cmo : \
utils/clflags.cmi \
toplevel/topmain.cmi
toplevel/topmain.cmx : \
- utils/warnings.cmx \
toplevel/toploop.cmx \
toplevel/topdirs.cmx \
- utils/profile.cmx \
utils/misc.cmx \
driver/main_args.cmx \
parsing/location.cmx \
diff --git a/Makefile b/Makefile
index 37bfc27f8e..4b83dfb123 100644
--- a/Makefile
+++ b/Makefile
@@ -124,8 +124,8 @@ COMP=\
bytecomp/meta.cmo bytecomp/opcodes.cmo \
bytecomp/bytesections.cmo bytecomp/dll.cmo \
bytecomp/symtable.cmo \
- driver/pparse.cmo driver/main_args.cmo \
- driver/compenv.cmo driver/compmisc.cmo \
+ driver/pparse.cmo driver/compenv.cmo \
+ driver/main_args.cmo driver/compmisc.cmo \
driver/makedepend.cmo \
driver/compile_common.cmo
diff --git a/driver/main.ml b/driver/main.ml
index 0e97d42a9e..adf66644f6 100644
--- a/driver/main.ml
+++ b/driver/main.ml
@@ -21,135 +21,7 @@ let usage = "Usage: ocamlc <options> <files>\nOptions are:"
(* Error messages to standard error formatter *)
let ppf = Format.err_formatter
-let vmthread_removed_message = "\
-The -vmthread argument of ocamlc is no longer supported\n\
-since OCaml 4.09.0. Please switch to system threads, which have the\n\
-same API. Lightweight threads with VM-level scheduling are provided by\n\
-third-party libraries such as Lwt, but with a different API."
-
-module Options = Main_args.Make_bytecomp_options (struct
- let set r () = r := true
- let unset r () = r := false
- let _a = set make_archive
- let _absname = set Clflags.absname
- let _alert = Warnings.parse_alert_option
- let _annot = set annotations
- let _binannot = set binary_annotations
- let _c = set compile_only
- let _cc s = c_compiler := Some s
- let _cclib s = Compenv.defer (ProcessObjects (Misc.rev_split_words s))
- let _ccopt s = first_ccopts := s :: !first_ccopts
- let _compat_32 = set bytecode_compatible_32
- let _config = Misc.show_config_and_exit
- let _config_var = Misc.show_config_variable_and_exit
- let _custom = set custom_runtime
- let _no_check_prims = set no_check_prims
- let _dllib s = defer (ProcessDLLs (Misc.rev_split_words s))
- 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;
- 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
- let _intf_suffix s = Config.interface_suffix := s
- let _keep_docs = set keep_docs
- let _no_keep_docs = unset keep_docs
- let _keep_locs = set keep_locs
- let _no_keep_locs = unset keep_locs
- let _labels = unset classic
- let _linkall = set link_everything
- let _make_runtime () =
- custom_runtime := true; make_runtime := true; link_everything := true
- let _alias_deps = unset transparent_modules
- let _no_alias_deps = set transparent_modules
- let _app_funct = set applicative_functors
- let _no_app_funct = unset applicative_functors
- let _noassert = set noassert
- let _nolabels = set classic
- let _noautolink = set no_auto_link
- let _nostdlib = set no_std_include
- let _o s = output_name := Some s
- let _opaque = set opaque
- let _open s = open_modules := s :: !open_modules
- let _output_obj () = output_c_object := true; custom_runtime := true
- let _output_complete_obj () =
- output_c_object := true;
- output_complete_object := true;
- custom_runtime := true
- let _output_complete_exe () =
- _output_complete_obj ();
- output_complete_executable := true
- let _pack = set make_package
- let _pp s = preprocessor := Some s
- let _ppx s = first_ppx := s :: !first_ppx
- let _plugin _p = plugin := true
- let _principal = set principal
- let _no_principal = unset principal
- let _rectypes = set recursive_types
- let _no_rectypes = unset recursive_types
- let _runtime_variant s = runtime_variant := s
- let _with_runtime = set with_runtime
- let _without_runtime = unset with_runtime
- let _safe_string = unset unsafe_string
- let _short_paths = unset real_paths
- let _strict_sequence = set strict_sequence
- let _no_strict_sequence = unset strict_sequence
- let _strict_formats = set strict_formats
- let _no_strict_formats = unset strict_formats
- let _thread = set use_threads
- let _vmthread = fun () -> fatal vmthread_removed_message
- let _unboxed_types = set unboxed_types
- let _no_unboxed_types = unset unboxed_types
- let _unsafe = set unsafe
- let _unsafe_string = set unsafe_string
- let _use_prims s = use_prims := s
- let _use_runtime s = use_runtime := s
- let _v () = print_version_and_library "compiler"
- let _version = print_version_string
- let _vnum = print_version_string
- let _w = (Warnings.parse_options false)
- let _warn_error = (Warnings.parse_options true)
- let _warn_help = Warnings.help_warnings
- let _color = Misc.set_or_ignore color_reader.parse color
- let _error_style = Misc.set_or_ignore error_style_reader.parse error_style
- let _where = print_standard_library
- let _verbose = set verbose
- let _nopervasives = set nopervasives
- let _match_context_rows n = match_context_rows := n
- let _dump_into_file = set dump_into_file
- let _dno_unique_ids = unset unique_ids
- let _dunique_ids = set unique_ids
- let _dsource = set dump_source
- let _dparsetree = set dump_parsetree
- let _dtypedtree = set dump_typedtree
- let _drawlambda = set dump_rawlambda
- let _dlambda = set dump_lambda
- let _dinstr = set dump_instr
- let _dcamlprimc = set keep_camlprimc_file
- let _dtimings () = profile_columns := [ `Time ]
- let _dprofile () = profile_columns := Profile.all_columns
-
- let _args = Arg.read_arg
- let _args0 = Arg.read_arg0
-
- let anonymous = anonymous
-end)
+module Options = Main_args.Make_bytecomp_options (Main_args.Default.Main)
let main () =
Clflags.add_arguments __LOC__ Options.list;
diff --git a/driver/main_args.ml b/driver/main_args.ml
index 2677a92e82..a58250dad2 100644
--- a/driver/main_args.ml
+++ b/driver/main_args.ml
@@ -1631,3 +1631,335 @@ let options_with_command_line_syntax options r =
options_with_command_line_syntax_inner r rest
~name_opt:(Some name) spec, doc)
) options
+
+module Default = struct
+ open Clflags
+ open Compenv
+ let set r () = r := true
+ let clear r () = r := false
+
+ module Common = struct
+ let _absname = set Clflags.absname
+ let _alert = Warnings.parse_alert_option
+ let _alias_deps = clear transparent_modules
+ let _app_funct = set applicative_functors
+ let _labels = clear classic
+ let _no_alias_deps = set transparent_modules
+ let _no_app_funct = clear applicative_functors
+ let _no_principal = clear principal
+ let _no_rectypes = clear recursive_types
+ let _no_strict_formats = clear strict_formats
+ let _no_strict_sequence = clear strict_sequence
+ let _no_unboxed_types = clear unboxed_types
+ let _noassert = set noassert
+ let _nolabels = set classic
+ let _nostdlib = set no_std_include
+ let _open s = open_modules := (s :: (!open_modules))
+ let _principal = set principal
+ let _rectypes = set recursive_types
+ let _safe_string = clear unsafe_string
+ let _short_paths = clear real_paths
+ let _strict_formats = set strict_formats
+ let _strict_sequence = set strict_sequence
+ let _unboxed_types = set unboxed_types
+ let _unsafe_string = set unsafe_string
+ let _w s = Warnings.parse_options false s
+
+ let anonymous = anonymous
+
+ end
+
+ module Core = struct
+ include Common
+ let _I dir = include_dirs := (dir :: (!include_dirs))
+ let _color = Misc.set_or_ignore color_reader.parse color
+ let _dlambda = set dump_lambda
+ let _dno_unique_ids = clear unique_ids
+ let _dparsetree = set dump_parsetree
+ let _drawlambda = set dump_rawlambda
+ let _dsource = set dump_source
+ let _dtypedtree = set dump_typedtree
+ let _dunique_ids = set unique_ids
+ let _error_style =
+ Misc.set_or_ignore error_style_reader.parse error_style
+ let _nopervasives = set nopervasives
+ let _ppx s = first_ppx := (s :: (!first_ppx))
+ let _unsafe = set unsafe
+ let _warn_error s = Warnings.parse_options true s
+ let _warn_help = Warnings.help_warnings
+ end
+
+ module Native = struct
+ let _S = set keep_asm_file
+ let _clambda_checks () = clambda_checks := true
+ let _classic_inlining () = classic_inlining := true
+ let _compact = clear optimize_for_speed
+ let _dalloc = set dump_regalloc
+ let _davail () = dump_avail := true
+ let _dclambda = set dump_clambda
+ let _dcmm = set dump_cmm
+ let _dcombine = set dump_combine
+ let _dcse = set dump_cse
+ let _dflambda = set dump_flambda
+ let _dflambda_invariants = set flambda_invariant_checks
+ let _dflambda_let stamp = dump_flambda_let := (Some stamp)
+ let _dflambda_no_invariants = clear flambda_invariant_checks
+ let _dflambda_verbose () =
+ set dump_flambda (); set dump_flambda_verbose ()
+ let _dinterf = set dump_interf
+ let _dlinear = set dump_linear
+ let _dlive () = dump_live := true
+ let _dprefer = set dump_prefer
+ let _drawclambda = set dump_rawclambda
+ let _drawflambda = set dump_rawflambda
+ let _dreload = set dump_reload
+ let _drunavail () = debug_runavail := true
+ let _dscheduling = set dump_scheduling
+ let _dsel = set dump_selection
+ let _dspill = set dump_spill
+ let _dsplit = set dump_split
+ let _dstartup = set keep_startup_file
+ let _dump_pass pass = set_dumped_pass pass true
+ let _inline spec =
+ Float_arg_helper.parse spec "Syntax: -inline <n> | <round>=<n>[,...]"
+ inline_threshold
+ let _inline_alloc_cost spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-alloc-cost <n> | <round>=<n>[,...]"
+ inline_alloc_cost
+ let _inline_branch_cost spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-branch-cost <n> | <round>=<n>[,...]"
+ inline_branch_cost
+ let _inline_branch_factor spec =
+ Float_arg_helper.parse spec
+ "Syntax: -inline-branch-factor <n> | <round>=<n>[,...]"
+ inline_branch_factor
+ let _inline_call_cost spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-call-cost <n> | <round>=<n>[,...]" inline_call_cost
+ let _inline_indirect_cost spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-indirect-cost <n> | <round>=<n>[,...]"
+ inline_indirect_cost
+ let _inline_lifting_benefit spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-lifting-benefit <n> | <round>=<n>[,...]"
+ inline_lifting_benefit
+ let _inline_max_depth spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-max-depth <n> | <round>=<n>[,...]" inline_max_depth
+ let _inline_max_unroll spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-max-unroll <n> | <round>=<n>[,...]"
+ inline_max_unroll
+ let _inline_prim_cost spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-prim-cost <n> | <round>=<n>[,...]" inline_prim_cost
+ let _inline_toplevel spec =
+ Int_arg_helper.parse spec
+ "Syntax: -inline-toplevel <n> | <round>=<n>[,...]"
+ inline_toplevel_threshold
+ let _inlining_report () = inlining_report := true
+ let _insn_sched = set insn_sched
+ let _no_insn_sched = clear insn_sched
+ let _no_unbox_free_vars_of_closures = clear unbox_free_vars_of_closures
+ let _no_unbox_specialised_args = clear unbox_specialised_args
+ (* CR-someday mshinwell: should stop e.g. -O2 -classic-inlining
+ lgesbert: could be done in main() below, like for -pack and -c, but that
+ would prevent overriding using OCAMLPARAM.
+ mshinwell: We're going to defer this for the moment and add a note in
+ the manual that the behaviour is unspecified in cases such as this.
+ We should refactor the code so that the user's requirements are
+ collected, then checked all at once for illegal combinations, and then
+ transformed into the settings of the individual parameters.
+ *)
+ let _o2 () =
+ default_simplify_rounds := 2;
+ use_inlining_arguments_set o2_arguments;
+ use_inlining_arguments_set ~round:0 o1_arguments
+ let _o3 () =
+ default_simplify_rounds := 3;
+ use_inlining_arguments_set o3_arguments;
+ use_inlining_arguments_set ~round:1 o2_arguments;
+ use_inlining_arguments_set ~round:0 o1_arguments
+ let _remove_unused_arguments = set remove_unused_arguments
+ let _rounds n = simplify_rounds := (Some n)
+ let _unbox_closures = set unbox_closures
+ let _unbox_closures_factor f = unbox_closures_factor := f
+ let _verbose = set verbose
+ end
+
+ module Compiler = struct
+ let _a = set make_archive
+ let _annot = set annotations
+ let _args = Arg.read_arg
+ let _args0 = Arg.read_arg0
+ let _binannot = set binary_annotations
+ let _c = set compile_only
+ let _cc s = c_compiler := (Some s)
+ let _cclib s = defer (ProcessObjects (Misc.rev_split_words s))
+ let _ccopt s = first_ccopts := (s :: (!first_ccopts))
+ let _config = Misc.show_config_and_exit
+ let _config_var = Misc.show_config_variable_and_exit
+ let _dprofile () = profile_columns := Profile.all_columns
+ let _dtimings () = profile_columns := [`Time]
+ let _dump_into_file = set dump_into_file
+ let _for_pack s = for_package := (Some s)
+ let _g = set debug
+ let _i () =
+ print_types := true;
+ compile_only := true;
+ stop_after := (Some Compiler_pass.Typing);
+ ()
+ let _impl = impl
+ let _intf = intf
+ let _intf_suffix s = Config.interface_suffix := s
+ let _keep_docs = set keep_docs
+ let _keep_locs = set keep_locs
+ let _linkall = set link_everything
+ let _match_context_rows n = match_context_rows := n
+ let _no_keep_docs = clear keep_docs
+ let _no_keep_locs = clear keep_locs
+ let _noautolink = set no_auto_link
+ let _o s = output_name := (Some s)
+ let _opaque = set opaque
+ let _pack = set make_package
+ let _plugin _p = plugin := true
+ let _pp s = preprocessor := (Some s)
+ let _runtime_variant s = runtime_variant := s
+ let _stop_after pass =
+ let module P = Compiler_pass in
+ match P.of_string pass with
+ | None -> () (* this should not occur as we use Arg.Symbol *)
+ | Some pass ->
+ stop_after := (Some pass);
+ match pass with
+ | P.Parsing | P.Typing -> compile_only := true
+ let _thread = set use_threads
+ let _verbose = set verbose
+ let _version () = print_version_string ()
+ let _vnum () = print_version_string ()
+ let _where () = print_standard_library ()
+ let _with_runtime = set with_runtime
+ let _without_runtime = clear with_runtime
+ end
+
+ module Toplevel = struct
+
+ let print_version () =
+ Printf.printf "The OCaml toplevel, version %s\n" Sys.ocaml_version;
+ exit 0;
+ ;;
+
+ let print_version_num () =
+ Printf.printf "%s\n" Sys.ocaml_version;
+ exit 0;
+ ;;
+
+ let _args (_:string) = (* placeholder: wrap_expand Arg.read_arg *) [||]
+ let _args0 (_:string) = (* placeholder: wrap_expand Arg.read_arg0 *) [||]
+ let _init s = init_file := (Some s)
+ let _no_version = set noversion
+ let _noinit = set noinit
+ let _noprompt = set noprompt
+ let _nopromptcont = set nopromptcont
+ let _stdin () = (* placeholder: file_argument ""*) ()
+ let _version () = print_version ()
+ let _vnum () = print_version_num ()
+ end
+
+ module Topmain = struct
+ include Toplevel
+ include Core
+ let _dinstr = set dump_instr
+ end
+
+ module Opttopmain = struct
+ include Toplevel
+ include Native
+ include Core
+ end
+
+ module Optmain = struct
+ include Native
+ include Core
+ include Compiler
+ let _afl_inst_ratio n = afl_inst_ratio := n
+ let _afl_instrument = set afl_instrument
+ let _dinterval = set dump_interval
+ let _function_sections () =
+ assert Config.function_sections;
+ first_ccopts := ("-ffunction-sections" :: (!first_ccopts));
+ function_sections := true
+ let _linscan = set use_linscan
+ let _no_float_const_prop = clear float_const_prop
+ let _nodynlink = clear dlcode
+ let _output_complete_obj () =
+ set output_c_object (); set output_complete_object ()
+ let _output_obj = set output_c_object
+ let _p () =
+ fatal
+ "Profiling with \"gprof\" (option `-p') is only supported up to \
+ OCaml 4.08.0"
+ let _shared () = shared := true; dlcode := true
+ let _v () = print_version_and_library "native-code compiler"
+ end
+
+ module Odoc_args = struct
+ include Common
+ let _I(_:string) =
+ (* placeholder:
+ Odoc_global.include_dirs := (s :: (!Odoc_global.include_dirs))
+ *) ()
+ let _impl (_:string) =
+ (* placeholder:
+ Odoc_global.files := ((!Odoc_global.files) @ [Odoc_global.Impl_file s])
+ *) ()
+ let _intf (_:string) = (* placeholder:
+ Odoc_global.files := ((!Odoc_global.files) @ [Odoc_global.Intf_file s])
+ *) ()
+ let _intf_suffix s = Config.interface_suffix := s
+ let _pp s = Clflags.preprocessor := (Some s)
+ let _ppx s = Clflags.all_ppx := (s :: (!Clflags.all_ppx))
+ let _thread = set Clflags.use_threads
+ let _v () = Compenv.print_version_and_library "documentation generator"
+ let _verbose = set Clflags.verbose
+ let _version = Compenv.print_version_string
+ let _vmthread = ignore
+ let _vnum = Compenv.print_version_string
+ end
+
+ module Main = struct
+
+ let vmthread_removed_message = "\
+The -vmthread argument of ocamlc is no longer supported\n\
+since OCaml 4.09.0. Please switch to system threads, which have the\n\
+same API. Lightweight threads with VM-level scheduling are provided by\n\
+third-party libraries such as Lwt, but with a different API."
+
+ include Core
+ include Compiler
+ let _compat_32 = set bytecode_compatible_32
+ let _custom = set custom_runtime
+ let _dcamlprimc = set keep_camlprimc_file
+ let _dinstr = set dump_instr
+ let _dllib s = defer (ProcessDLLs (Misc.rev_split_words s))
+ let _dllpath s = dllpaths := ((!dllpaths) @ [s])
+ let _make_runtime () =
+ custom_runtime := true; make_runtime := true; link_everything := true
+ let _no_check_prims = set no_check_prims
+ let _output_complete_obj () =
+ output_c_object := true;
+ output_complete_object := true;
+ custom_runtime := true
+ let _output_complete_exe () =
+ _output_complete_obj (); output_complete_executable := true
+ let _output_obj () = output_c_object := true; custom_runtime := true
+ let _use_prims s = use_prims := s
+ let _use_runtime s = use_runtime := s
+ let _v () = print_version_and_library "compiler"
+ let _vmthread () = fatal vmthread_removed_message
+ end
+
+end
diff --git a/driver/main_args.mli b/driver/main_args.mli
index cc56c4b989..d0dae873ee 100644
--- a/driver/main_args.mli
+++ b/driver/main_args.mli
@@ -16,8 +16,6 @@
(* ATTENTION ! When you add or modify a parsing or typing option, do not forget
to update ocamldoc options too, in odoc_args.ml. *)
-
-
module type Common_options = sig
val _absname : unit -> unit
val _alert : string -> unit
@@ -274,3 +272,11 @@ val options_with_command_line_syntax
: (string * Arg.spec * string) list
-> string list ref
-> (string * Arg.spec * string) list
+
+module Default: sig
+ module Topmain: Bytetop_options
+ module Opttopmain: Opttop_options
+ module Main: Bytecomp_options
+ module Optmain: Optcomp_options
+ module Odoc_args: Ocamldoc_options
+end
diff --git a/driver/optmain.ml b/driver/optmain.ml
index 2f7e5afa15..f26631d756 100644
--- a/driver/optmain.ml
+++ b/driver/optmain.ml
@@ -36,229 +36,7 @@ let backend = (module Backend : Backend_intf.S)
let usage = "Usage: ocamlopt <options> <files>\nOptions are:"
-module Options = Main_args.Make_optcomp_options (struct
- let set r () = r := true
- let clear r () = r := false
-
- let _a = set make_archive
- let _absname = set Clflags.absname
- let _afl_instrument = set afl_instrument
- let _afl_inst_ratio n = afl_inst_ratio := n
- let _alert = Warnings.parse_alert_option
- let _annot = set annotations
- let _binannot = set binary_annotations
- let _c = set compile_only
- let _cc s = c_compiler := Some s
- let _cclib s = defer (ProcessObjects (Misc.rev_split_words s))
- let _ccopt s = first_ccopts := s :: !first_ccopts
- let _clambda_checks () = clambda_checks := true
- let _compact = clear optimize_for_speed
- let _config = Misc.show_config_and_exit
- let _config_var = Misc.show_config_variable_and_exit
- let _for_pack s = for_package := Some s
- let _function_sections () =
- assert (Config.function_sections);
- first_ccopts := "-ffunction-sections" :: !first_ccopts;
- function_sections := true
- let _g = set debug
- 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 =
- Float_arg_helper.parse spec
- "Syntax: -inline <n> | <round>=<n>[,...]" inline_threshold
- let _inline_toplevel spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-toplevel <n> | <round>=<n>[,...]"
- inline_toplevel_threshold
- let _inlining_report () = inlining_report := true
- let _dump_pass pass = set_dumped_pass pass true
- let _rounds n = simplify_rounds := Some n
- let _inline_max_unroll spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-max-unroll <n> | <round>=<n>[,...]"
- inline_max_unroll
- let _classic_inlining () = classic_inlining := true
- let _inline_call_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-call-cost <n> | <round>=<n>[,...]"
- inline_call_cost
- let _inline_alloc_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-alloc-cost <n> | <round>=<n>[,...]"
- inline_alloc_cost
- let _inline_prim_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-prim-cost <n> | <round>=<n>[,...]"
- inline_prim_cost
- let _inline_branch_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-branch-cost <n> | <round>=<n>[,...]"
- inline_branch_cost
- let _inline_indirect_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-indirect-cost <n> | <round>=<n>[,...]"
- inline_indirect_cost
- let _inline_lifting_benefit spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-lifting-benefit <n> | <round>=<n>[,...]"
- inline_lifting_benefit
- let _inline_branch_factor spec =
- Float_arg_helper.parse spec
- "Syntax: -inline-branch-factor <n> | <round>=<n>[,...]"
- inline_branch_factor
- let _intf_suffix s = Config.interface_suffix := s
- let _insn_sched = set insn_sched
- let _intf = intf
- let _keep_docs = set keep_docs
- let _no_keep_docs = clear keep_docs
- let _keep_locs = set keep_locs
- let _no_keep_locs = clear keep_locs
- let _labels = clear classic
- let _linkall = set link_everything
- let _inline_max_depth spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-max-depth <n> | <round>=<n>[,...]"
- inline_max_depth
- let _alias_deps = clear transparent_modules
- let _no_alias_deps = set transparent_modules
- let _linscan = set use_linscan
- let _app_funct = set applicative_functors
- let _no_app_funct = clear applicative_functors
- let _no_float_const_prop = clear float_const_prop
- let _noassert = set noassert
- let _noautolink = set no_auto_link
- let _nodynlink = clear dlcode
- let _no_insn_sched = clear insn_sched
- let _nolabels = set classic
- let _nostdlib = set no_std_include
- let _no_unbox_free_vars_of_closures = clear unbox_free_vars_of_closures
- let _no_unbox_specialised_args = clear unbox_specialised_args
- let _o s = output_name := Some s
- (* CR-someday mshinwell: should stop e.g. -O2 -classic-inlining
- lgesbert: could be done in main() below, like for -pack and -c, but that
- would prevent overriding using OCAMLPARAM.
- mshinwell: We're going to defer this for the moment and add a note in
- the manual that the behaviour is unspecified in cases such as this.
- We should refactor the code so that the user's requirements are
- collected, then checked all at once for illegal combinations, and then
- transformed into the settings of the individual parameters.
- *)
- let _o2 () =
- default_simplify_rounds := 2;
- use_inlining_arguments_set o2_arguments;
- use_inlining_arguments_set ~round:0 o1_arguments
- let _o3 () =
- default_simplify_rounds := 3;
- use_inlining_arguments_set o3_arguments;
- use_inlining_arguments_set ~round:1 o2_arguments;
- use_inlining_arguments_set ~round:0 o1_arguments
- let _open s = open_modules := s :: !open_modules
- let _output_obj = set output_c_object
- let _output_complete_obj () =
- set output_c_object (); set output_complete_object ()
- let _p () =
- fatal "Profiling with \"gprof\" (option `-p') is only supported up \
- to OCaml 4.08.0"
- let _pack = set make_package
- let _plugin _p = plugin := true
- let _pp s = preprocessor := Some s
- let _ppx s = first_ppx := s :: !first_ppx
- let _principal = set principal
- let _no_principal = clear principal
- let _rectypes = set recursive_types
- let _no_rectypes = clear recursive_types
- let _remove_unused_arguments = set remove_unused_arguments
- let _runtime_variant s = runtime_variant := s
- let _with_runtime = set with_runtime
- let _without_runtime = clear with_runtime
- let _safe_string = clear unsafe_string
- let _short_paths = clear real_paths
- let _strict_sequence = set strict_sequence
- let _no_strict_sequence = clear strict_sequence
- let _strict_formats = set strict_formats
- let _no_strict_formats = clear strict_formats
- let _shared () = shared := true; dlcode := true
- let _S = set keep_asm_file
- let _thread = set use_threads
- let _unbox_closures = set unbox_closures
- let _unbox_closures_factor f = unbox_closures_factor := f
- let _unboxed_types = set unboxed_types
- let _no_unboxed_types = clear unboxed_types
- let _unsafe = set unsafe
- let _unsafe_string = set unsafe_string
- let _v () = print_version_and_library "native-code compiler"
- let _version () = print_version_string ()
- let _vnum () = print_version_string ()
- let _verbose = set verbose
- let _w s = Warnings.parse_options false s
- let _warn_error s = Warnings.parse_options true s
- let _warn_help = Warnings.help_warnings
- let _color = Misc.set_or_ignore color_reader.parse color
- let _error_style = Misc.set_or_ignore error_style_reader.parse error_style
- let _where () = print_standard_library ()
- let _nopervasives = set nopervasives
- let _match_context_rows n = match_context_rows := n
- let _dump_into_file = set dump_into_file
- let _dno_unique_ids = clear unique_ids
- let _dunique_ids = set unique_ids
- let _dsource = set dump_source
- let _dparsetree = set dump_parsetree
- let _dtypedtree = set dump_typedtree
- let _drawlambda = set dump_rawlambda
- let _dlambda = set dump_lambda
- let _drawclambda = set dump_rawclambda
- let _dclambda = set dump_clambda
- let _drawflambda = set dump_rawflambda
- let _dflambda = set dump_flambda
- let _dflambda_let stamp = dump_flambda_let := Some stamp
- let _dflambda_verbose () =
- set dump_flambda ();
- set dump_flambda_verbose ()
- let _dflambda_invariants = set flambda_invariant_checks
- let _dflambda_no_invariants = clear flambda_invariant_checks
- let _dcmm = set dump_cmm
- let _dsel = set dump_selection
- let _dcombine = set dump_combine
- let _dcse = set dump_cse
- let _dlive () = dump_live := true
- let _davail () = dump_avail := true
- let _drunavail () = debug_runavail := true
- let _dspill = set dump_spill
- let _dsplit = set dump_split
- let _dinterf = set dump_interf
- let _dprefer = set dump_prefer
- let _dalloc = set dump_regalloc
- let _dreload = set dump_reload
- let _dscheduling = set dump_scheduling
- let _dlinear = set dump_linear
- let _dinterval = set dump_interval
- let _dstartup = set keep_startup_file
- let _dtimings () = profile_columns := [ `Time ]
- let _dprofile () = profile_columns := Profile.all_columns
- let _opaque = set opaque
-
- let _args = Arg.read_arg
- let _args0 = Arg.read_arg0
-
- let anonymous = anonymous
-end);;
-
+module Options = Main_args.Make_optcomp_options (Main_args.Default.Optmain)
let main () =
native_code := true;
let ppf = Format.err_formatter in
diff --git a/ocamldoc/.depend b/ocamldoc/.depend
index a11d256579..4bc98ad3c6 100644
--- a/ocamldoc/.depend
+++ b/ocamldoc/.depend
@@ -74,7 +74,6 @@ odoc_analyse.cmi : \
odoc_module.cmo \
odoc_global.cmi
odoc_args.cmo : \
- ../utils/warnings.cmi \
odoc_types.cmi \
odoc_texi.cmo \
odoc_messages.cmo \
@@ -87,11 +86,8 @@ odoc_args.cmo : \
odoc_config.cmi \
../driver/main_args.cmi \
../utils/config.cmi \
- ../driver/compenv.cmi \
- ../utils/clflags.cmi \
odoc_args.cmi
odoc_args.cmx : \
- ../utils/warnings.cmx \
odoc_types.cmx \
odoc_texi.cmx \
odoc_messages.cmx \
@@ -104,8 +100,6 @@ odoc_args.cmx : \
odoc_config.cmx \
../driver/main_args.cmx \
../utils/config.cmx \
- ../driver/compenv.cmx \
- ../utils/clflags.cmx \
odoc_args.cmi
odoc_args.cmi : \
odoc_gen.cmi
diff --git a/ocamldoc/odoc_args.ml b/ocamldoc/odoc_args.ml
index e5bc2cfbab..46fcb58bea 100644
--- a/ocamldoc/odoc_args.ml
+++ b/ocamldoc/odoc_args.ml
@@ -197,46 +197,10 @@ let anonymous f =
Odoc_global.files := !Odoc_global.files @ [sf]
module Options = Main_args.Make_ocamldoc_options(struct
- let set r () = r := true
- let unset r () = r := false
- let _absname = set Clflags.absname
- let _alert = Warnings.parse_alert_option
- let _I s = Odoc_global.include_dirs := s :: !Odoc_global.include_dirs
- let _impl s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Impl_file s]
- let _intf s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Intf_file s]
- let _intf_suffix s = Config.interface_suffix := s
- let _labels = unset Clflags.classic
- let _alias_deps = unset Clflags.transparent_modules
- let _no_alias_deps = set Clflags.transparent_modules
- let _app_funct = set Clflags.applicative_functors
- let _no_app_funct = unset Clflags.applicative_functors
- let _noassert = set Clflags.noassert
- let _nolabels = set Clflags.classic
- let _nostdlib = set Clflags.no_std_include
- let _open s = Clflags.open_modules := s :: !Clflags.open_modules
- let _pp s = Clflags.preprocessor := Some s
- let _ppx s = Clflags.all_ppx := s :: !Clflags.all_ppx
- let _principal = set Clflags.principal
- let _no_principal = unset Clflags.principal
- let _rectypes = set Clflags.recursive_types
- let _no_rectypes = unset Clflags.recursive_types
- let _safe_string = unset Clflags.unsafe_string
- let _short_paths = unset Clflags.real_paths
- let _strict_sequence = set Clflags.strict_sequence
- let _no_strict_sequence = unset Clflags.strict_sequence
- let _strict_formats = set Clflags.strict_formats
- let _no_strict_formats = unset Clflags.strict_formats
- let _thread = set Clflags.use_threads
- let _vmthread = ignore
- let _unboxed_types = set Clflags.unboxed_types
- let _no_unboxed_types = unset Clflags.unboxed_types
- let _unsafe_string = set Clflags.unsafe_string
- let _v () = Compenv.print_version_and_library "documentation generator"
- let _version = Compenv.print_version_string
- let _vnum = Compenv.print_version_string
- let _w = (Warnings.parse_options false)
- let _verbose = set Clflags.verbose
- let anonymous = anonymous
+ include Main_args.Default.Odoc_args
+ let _I s = Odoc_global.include_dirs := s :: !Odoc_global.include_dirs
+ let _impl s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Impl_file s]
+ let _intf s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Intf_file s]
end)
(** The default option list *)
diff --git a/testsuite/tools/expect_test.ml b/testsuite/tools/expect_test.ml
index 8481388914..2f18024768 100644
--- a/testsuite/tools/expect_test.ml
+++ b/testsuite/tools/expect_test.ml
@@ -341,66 +341,10 @@ let main fname =
exit 0
module Options = Main_args.Make_bytetop_options (struct
- let set r () = r := true
- let clear r () = r := false
- open Clflags
- let _absname = set absname
- let _alert = Warnings.parse_alert_option
- let _I dir = include_dirs := dir :: !include_dirs
- let _init s = init_file := Some s
- let _noinit = set noinit
- let _labels = clear classic
- let _alias_deps = clear transparent_modules
- let _no_alias_deps = set transparent_modules
- let _app_funct = set applicative_functors
- let _no_app_funct = clear applicative_functors
- let _noassert = set noassert
- let _nolabels = set classic
- let _noprompt = set noprompt
- let _nopromptcont = set nopromptcont
- let _nostdlib = set no_std_include
- let _nopervasives = set nopervasives
- let _open s = open_modules := s :: !open_modules
- let _ppx _s = (* disabled *) ()
- let _principal = set principal
- let _no_principal = clear principal
- let _rectypes = set recursive_types
- let _no_rectypes = clear recursive_types
- let _safe_string = clear unsafe_string
- let _short_paths = clear real_paths
+ include Main_args.Default.Topmain
let _stdin () = (* disabled *) ()
- let _strict_sequence = set strict_sequence
- let _no_strict_sequence = clear strict_sequence
- let _strict_formats = set strict_formats
- let _no_strict_formats = clear strict_formats
- let _unboxed_types = set unboxed_types
- let _no_unboxed_types = clear unboxed_types
- let _unsafe = set unsafe
- let _unsafe_string = set unsafe_string
- let _version () = (* disabled *) ()
- let _vnum () = (* disabled *) ()
- let _no_version = set noversion
- let _w s = Warnings.parse_options false s
- let _warn_error s = Warnings.parse_options true s
- let _warn_help = Warnings.help_warnings
- let _dparsetree = set dump_parsetree
- let _dtypedtree = set dump_typedtree
- let _dno_unique_ids = clear unique_ids
- let _dunique_ids = set unique_ids
- let _dsource = set dump_source
- let _drawlambda = set dump_rawlambda
- let _dlambda = set dump_lambda
- let _dflambda = set dump_flambda
- let _dtimings () = profile_columns := [ `Time ]
- let _dprofile () = profile_columns := Profile.all_columns
- let _dinstr = set dump_instr
- let _dcamlprimc = set keep_camlprimc_file
- let _color = Misc.set_or_ignore color_reader.parse color
- let _error_style = Misc.set_or_ignore error_style_reader.parse error_style
-
let _args = Arg.read_arg
let _args0 = Arg.read_arg0
-
let anonymous s = main s
end);;
diff --git a/tools/Makefile b/tools/Makefile
index 1b3014a3ab..2502cb4299 100644
--- a/tools/Makefile
+++ b/tools/Makefile
@@ -121,7 +121,9 @@ $(call byte_and_opt,ocamlprof,$(CSLPROF_IMPORTS) profiling.cmo $(CSLPROF),)
ocamlcp_cmos = config.cmo build_path_prefix_map.cmo misc.cmo profile.cmo \
warnings.cmo identifiable.cmo numbers.cmo arg_helper.cmo \
- clflags.cmo main_args.cmo
+ clflags.cmo \
+ terminfo.cmo location.cmo load_path.cmo ccomp.cmo compenv.cmo \
+ main_args.cmo
$(call byte_and_opt,ocamlcp,$(ocamlcp_cmos) ocamlcp.cmo,)
diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml
index 22e5e028a0..d799fff4ff 100644
--- a/tools/ocamlcp.ml
+++ b/tools/ocamlcp.ml
@@ -33,106 +33,14 @@ let incompatible o =
exit 2
module Options = Main_args.Make_bytecomp_options (struct
- 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 _output_complete_exe = 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 _with_runtime = ignore
- let _without_runtime = 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);;
+ include Main_args.Default.Main
+ let _a () = make_archive := true
+ let _impl _ = with_impl := true
+ let _intf _ = with_intf := true
+ let _pp _ = incompatible "-pp"
+ let _ppx _ = incompatible "-ppx"
+ let anonymous = process_file
+ end);;
let rev_compargs = ref ([] : string list)
let rev_profargs = ref ([] : string list)
diff --git a/tools/ocamloptp.ml b/tools/ocamloptp.ml
index 888dbf5b58..9b92d3b0fc 100644
--- a/tools/ocamloptp.ml
+++ b/tools/ocamloptp.ml
@@ -33,149 +33,12 @@ let incompatible o =
exit 2
module Options = Main_args.Make_optcomp_options (struct
+ include Main_args.Default.Optmain
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 _insn_sched = 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 _no_insn_sched = 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 = ignore
- let _no_principal = ignore
- let _rectypes = ignore
- let _no_rectypes = ignore
- let _remove_unused_arguments = ignore
- let _runtime_variant = ignore
- let _with_runtime = ignore
- let _without_runtime = 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 = 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
diff --git a/toplevel/opttopmain.ml b/toplevel/opttopmain.ml
index d26c47be10..b0573173cd 100644
--- a/toplevel/opttopmain.ml
+++ b/toplevel/opttopmain.ml
@@ -78,16 +78,6 @@ let file_argument name =
else exit 2
end
-let print_version () =
- Printf.printf "The OCaml toplevel, version %s\n" Sys.ocaml_version;
- exit 0;
-;;
-
-let print_version_num () =
- Printf.printf "%s\n" Sys.ocaml_version;
- exit 0;
-;;
-
let wrap_expand f s =
let start = !current in
let arr = f s in
@@ -95,159 +85,11 @@ let wrap_expand f s =
arr
module Options = Main_args.Make_opttop_options (struct
- let set r () = r := true
- let clear r () = r := false
-
- let _absname = set absname
- let _alert = Warnings.parse_alert_option
- let _compact = clear optimize_for_speed
- let _I dir = include_dirs := dir :: !include_dirs
- let _init s = init_file := Some s
- let _noinit = set noinit
- let _clambda_checks () = clambda_checks := true
- let _inline spec =
- Float_arg_helper.parse spec
- "Syntax: -inline <n> | <round>=<n>[,...]"
- inline_threshold
- let _inline_indirect_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-indirect-cost <n> | <round>=<n>[,...]"
- inline_indirect_cost
- let _inline_toplevel spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-toplevel <n> | <round>=<n>[,...]"
- inline_toplevel_threshold
- let _inlining_report () = inlining_report := true
- let _dump_pass pass = set_dumped_pass pass true
- let _rounds n = simplify_rounds := Some n
- let _inline_max_unroll spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-max-unroll <n> | <round>=<n>[,...]"
- inline_max_unroll
- let _classic_inlining () = classic_inlining := true
- let _inline_call_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-call-cost <n> | <round>=<n>[,...]"
- inline_call_cost
- let _inline_alloc_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-alloc-cost <n> | <round>=<n>[,...]"
- inline_alloc_cost
- let _inline_prim_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-prim-cost <n> | <round>=<n>[,...]"
- inline_prim_cost
- let _inline_branch_cost spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-branch-cost <n> | <round>=<n>[,...]"
- inline_branch_cost
- let _inline_lifting_benefit spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-lifting-benefit <n> | <round>=<n>[,...]"
- inline_lifting_benefit
- let _inline_branch_factor spec =
- Float_arg_helper.parse spec
- "Syntax: -inline-branch-factor <n> | <round>=<n>[,...]"
- inline_branch_factor
- let _inline_max_depth spec =
- Int_arg_helper.parse spec
- "Syntax: -inline-max-depth <n> | <round>=<n>[,...]"
- inline_max_depth
- let _insn_sched = set insn_sched
- let _no_insn_sched = clear insn_sched
- let _no_unbox_free_vars_of_closures = clear unbox_free_vars_of_closures
- let _no_unbox_specialised_args = clear unbox_specialised_args
- let _o2 () =
- default_simplify_rounds := 2;
- use_inlining_arguments_set o2_arguments;
- use_inlining_arguments_set ~round:0 o1_arguments
- let _o3 () =
- default_simplify_rounds := 3;
- use_inlining_arguments_set o3_arguments;
- use_inlining_arguments_set ~round:1 o2_arguments;
- use_inlining_arguments_set ~round:0 o1_arguments
- let _remove_unused_arguments = set remove_unused_arguments
- let _unbox_closures = set unbox_closures
- let _unbox_closures_factor f = unbox_closures_factor := f
- let _drawclambda = set dump_rawclambda
- let _dclambda = set dump_clambda
- let _drawflambda = set dump_rawflambda
- let _dflambda = set dump_flambda
- let _dflambda_let stamp = dump_flambda_let := Some stamp
- let _dflambda_verbose () =
- set dump_flambda ();
- set dump_flambda_verbose ()
- let _dflambda_invariants = set flambda_invariant_checks
- let _dflambda_no_invariants = clear flambda_invariant_checks
- let _labels = clear classic
- let _alias_deps = clear transparent_modules
- let _no_alias_deps = set transparent_modules
- let _app_funct = set applicative_functors
- let _no_app_funct = clear applicative_functors
- let _noassert = set noassert
- let _nolabels = set classic
- let _noprompt = set noprompt
- let _nopromptcont = set nopromptcont
- let _nostdlib = set no_std_include
- let _nopervasives = set nopervasives
- let _ppx s = Compenv.first_ppx := s :: !Compenv.first_ppx
- let _principal = set principal
- let _no_principal = clear principal
- let _rectypes = set recursive_types
- let _no_rectypes = clear recursive_types
- let _strict_sequence = set strict_sequence
- let _no_strict_sequence = clear strict_sequence
- let _strict_formats = set strict_formats
- let _no_strict_formats = clear strict_formats
- let _S = set keep_asm_file
- let _short_paths = clear real_paths
- let _stdin () = file_argument ""
- let _unboxed_types = set unboxed_types
- let _no_unboxed_types = clear unboxed_types
- let _unsafe = set unsafe
- let _verbose = set verbose
- let _version () = print_version ()
- let _vnum () = print_version_num ()
- let _no_version = set noversion
- let _w s = Warnings.parse_options false s
- let _warn_error s = Warnings.parse_options true s
- let _warn_help = Warnings.help_warnings
-
- let _dno_unique_ids = clear unique_ids
- let _dunique_ids = set unique_ids
- let _dsource = set dump_source
- let _dparsetree = set dump_parsetree
- let _dtypedtree = set dump_typedtree
- let _drawlambda = set dump_rawlambda
- let _dlambda = set dump_lambda
- let _drawclambda = set dump_rawclambda
- let _dclambda = set dump_clambda
- let _dcmm = set dump_cmm
- let _dsel = set dump_selection
- let _dcombine = set dump_combine
- let _dcse = set dump_cse
- let _dlive () = dump_live := true
- let _davail () = dump_avail := true
- let _drunavail () = debug_runavail := true
- let _dspill = set dump_spill
- let _dsplit = set dump_split
- let _dinterf = set dump_interf
- let _dprefer = set dump_prefer
- let _dalloc = set dump_regalloc
- let _dreload = set dump_reload
- let _dscheduling = set dump_scheduling
- let _dlinear = set dump_linear
- let _dstartup = set keep_startup_file
- let _safe_string = clear unsafe_string
- let _unsafe_string = set unsafe_string
- let _open s = open_modules := s :: !open_modules
- let _color = Misc.set_or_ignore color_reader.parse color
- let _error_style = Misc.set_or_ignore error_style_reader.parse error_style
-
- let _args = wrap_expand Arg.read_arg
- let _args0 = wrap_expand Arg.read_arg0
-
- let anonymous = file_argument
+ include Main_args.Default.Opttopmain
+ let _stdin () = file_argument ""
+ let _args = wrap_expand Arg.read_arg
+ let _args0 = wrap_expand Arg.read_arg0
+ let anonymous s = file_argument s
end);;
let () =
diff --git a/toplevel/topmain.ml b/toplevel/topmain.ml
index 8dfb488207..dec1659dce 100644
--- a/toplevel/topmain.ml
+++ b/toplevel/topmain.ml
@@ -13,7 +13,6 @@
(* *)
(**************************************************************************)
-open Clflags
open Compenv
let usage = "Usage: ocaml <options> <object-files> [script-file [arguments]]\n\
@@ -81,15 +80,6 @@ let file_argument name =
else exit 2
end
-let print_version () =
- Printf.printf "The OCaml toplevel, version %s\n" Sys.ocaml_version;
- exit 0;
-;;
-
-let print_version_num () =
- Printf.printf "%s\n" Sys.ocaml_version;
- exit 0;
-;;
let wrap_expand f s =
let start = !current in
@@ -98,63 +88,11 @@ let wrap_expand f s =
arr
module Options = Main_args.Make_bytetop_options (struct
- let set r () = r := true
- let clear r () = r := false
-
- let _absname = set Clflags.absname
- let _alert = Warnings.parse_alert_option
- let _I dir = include_dirs := dir :: !include_dirs
- let _init s = init_file := Some s
- let _noinit = set noinit
- let _labels = clear classic
- let _alias_deps = clear transparent_modules
- let _no_alias_deps = set transparent_modules
- let _app_funct = set applicative_functors
- let _no_app_funct = clear applicative_functors
- let _noassert = set noassert
- let _nolabels = set classic
- let _noprompt = set noprompt
- let _nopromptcont = set nopromptcont
- let _nostdlib = set no_std_include
- let _nopervasives = set nopervasives
- let _open s = open_modules := s :: !open_modules
- let _ppx s = first_ppx := s :: !first_ppx
- let _principal = set principal
- let _no_principal = clear principal
- let _rectypes = set recursive_types
- let _no_rectypes = clear recursive_types
- let _safe_string = clear unsafe_string
- let _short_paths = clear real_paths
- let _stdin () = file_argument ""
- let _strict_sequence = set strict_sequence
- let _no_strict_sequence = clear strict_sequence
- let _strict_formats = set strict_formats
- let _no_strict_formats = clear strict_formats
- let _unboxed_types = set unboxed_types
- let _no_unboxed_types = clear unboxed_types
- let _unsafe = set unsafe
- let _unsafe_string = set unsafe_string
- let _version () = print_version ()
- let _vnum () = print_version_num ()
- let _no_version = set noversion
- let _w s = Warnings.parse_options false s
- let _warn_error s = Warnings.parse_options true s
- let _warn_help = Warnings.help_warnings
- let _dparsetree = set dump_parsetree
- let _dtypedtree = set dump_typedtree
- let _dno_unique_ids = clear unique_ids
- let _dunique_ids = set unique_ids
- let _dsource = set dump_source
- let _drawlambda = set dump_rawlambda
- let _dlambda = set dump_lambda
- let _dinstr = set dump_instr
- let _color = Misc.set_or_ignore color_reader.parse color
- let _error_style = Misc.set_or_ignore error_style_reader.parse error_style
-
- let _args = wrap_expand Arg.read_arg
- let _args0 = wrap_expand Arg.read_arg0
-
- let anonymous s = file_argument s
+ include Main_args.Default.Topmain
+ let _stdin () = file_argument ""
+ let _args = wrap_expand Arg.read_arg
+ let _args0 = wrap_expand Arg.read_arg0
+ let anonymous s = file_argument s
end);;
let () =