diff --git a/HACKING.md b/HACKING.md index 6672dfb4455..d07708afd01 100644 --- a/HACKING.md +++ b/HACKING.md @@ -16,6 +16,7 @@ want to modify the Flambda backend. Jump to: - [Pulling changes onto a release branch](#pulling-changes-onto-a-release-branch) - [Rebasing to a new major version of the upstream compiler](#rebasing-to-a-new-major-version-of-the-upstream-compiler) - [How to add a new intrinsic to the compiler](#how-to-add-a-new-intrinsic-to-the-compiler) + - [How to add a new command line option](#how-to-add-a-new-command-line-option) - [Installation tree comparison script](#installation-tree-comparison-script) ## Branches, pull requests, etc. @@ -293,6 +294,17 @@ library, and then the compiler. relies on the library tests to avoid duplication. Library tests use `Core`, but the library itself does not. +## How to add a new command line option + +1) Add a ref to `flambda_backend_flags.ml{i}` +2) Add the flag's constructor `mk_` in `flambda_backend_args.ml` +3) Add the callback for the new flag to `Flambda_backend_options` module type + in `flambda_backend_args.ml{i}` +4) List the flag in the body of `Make_flambda_backend_options` functor +5) Implement the flag in `Flambda_backend_options_impl` + by setting the corresponding ref in Flambda_backend_flags +6) Add the flag to `Extra_params` if it can be set via `OCAMLPARAM` + ## Installation tree comparison script A target `make compare` exists to run a comparison script that finds differences diff --git a/backend/asmgen.ml b/backend/asmgen.ml index 520c7e8cfd2..b0ebe677503 100644 --- a/backend/asmgen.ml +++ b/backend/asmgen.ml @@ -222,14 +222,14 @@ let compile_fundecl ~ppf_dump fd_cmm = ++ Profile.record ~accumulate:true "linearize" (fun (f : Mach.fundecl) -> let res = Linearize.fundecl f in (* CR xclerc for xclerc: temporary, for testing. *) - if !Clflags.use_ocamlcfg then begin + if !Flambda_backend_flags.use_ocamlcfg then begin test_cfgize f res; end; res) ++ pass_dump_linear_if ppf_dump dump_linear "Linearized code" ++ Compiler_hooks.execute_and_pipe Compiler_hooks.Linear ++ (fun (fd : Linear.fundecl) -> - if !use_ocamlcfg then begin + if !Flambda_backend_flags.use_ocamlcfg then begin fd ++ Profile.record ~accumulate:true "linear_to_cfg" (Linear_to_cfg.run ~preserve_orig_labels:true) diff --git a/driver/flambda_backend_args.ml b/driver/flambda_backend_args.ml new file mode 100644 index 00000000000..01bf9481bbb --- /dev/null +++ b/driver/flambda_backend_args.ml @@ -0,0 +1,763 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2021 OCamlPro SAS *) +(* Copyright 2014--2021 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) +let format_default flag = if flag then " (default)" else "" +let format_not_default flag = if flag then "" else " (default)" + +let mk_ocamlcfg f = + "-ocamlcfg", Arg.Unit f, " Use ocamlcfg" + +let mk_no_ocamlcfg f = + "-no-ocamlcfg", Arg.Unit f, " Do not use ocamlcfg" +;; + +module Flambda2 = Flambda_backend_flags.Flambda2 + +let mk_flambda2_join_points f = + "-flambda2-join-points", Arg.Unit f, + Printf.sprintf " Propagate information from all incoming edges to a join\n\ + \ point%s (Flambda 2 only)" + (format_default Flambda2.Default.join_points) +;; + +let mk_no_flambda2_join_points f = + "-no-flambda2-join-points", Arg.Unit f, + Printf.sprintf " Propagate information to a join point only if there are\n\ + \ zero or one incoming edge(s)%s (Flambda 2 only)" + (format_not_default Flambda2.Default.join_points) +;; + +let mk_flambda2_unbox_along_intra_function_control_flow f = + "-flambda2-unbox-along-intra-function-control-flow", Arg.Unit f, + Printf.sprintf " Pass values within\n\ + \ a function as unboxed where possible%s (Flambda 2 only)" + (format_default Flambda2.Default.unbox_along_intra_function_control_flow) +;; + +let mk_no_flambda2_unbox_along_intra_function_control_flow f = + "-no-flambda2-unbox-along-intra-function-control-flow", Arg.Unit f, + Printf.sprintf " Pass values within\n\ + \ a function in their normal representation%s (Flambda 2 only)" + (format_not_default + Flambda2.Default.unbox_along_intra_function_control_flow) +;; + +let mk_flambda2_backend_cse_at_toplevel f = + "-flambda2-backend-cse-at-toplevel", Arg.Unit f, + Printf.sprintf " Apply the backend CSE pass to module\n\ + \ initializers%s (Flambda 2 only)" + (format_default Flambda2.Default.backend_cse_at_toplevel) +;; + +let mk_no_flambda2_backend_cse_at_toplevel f = + "-no-flambda2-backend-cse-at-toplevel", Arg.Unit f, + Printf.sprintf " Do not apply the backend CSE pass to\n\ + \ module initializers%s (Flambda 2 only)" + (format_not_default Flambda2.Default.backend_cse_at_toplevel) +;; + +let mk_flambda2_cse_depth f = + "-flambda2-cse-depth", Arg.Int f, + Printf.sprintf " Depth threshold for eager tracking of CSE equations\n\ + \ (default %d) (Flambda 2 only)" + Flambda2.Default.cse_depth +;; + +let mk_flambda2_expert_code_id_and_symbol_scoping_checks f = + "-flambda2-expert-code-id-and-symbol-scoping-checks", Arg.Unit f, + Printf.sprintf " Perform checks on static\n\ + \ scopes of code IDs and symbols during To_cmm%s\n\ + \ (Flambda 2 only)" + (format_default Flambda2.Expert.Default.code_id_and_symbol_scoping_checks) +;; + +let mk_no_flambda2_expert_code_id_and_symbol_scoping_checks f = + "-no-flambda2-expert-code-id-and-symbol-scoping-checks", Arg.Unit f, + Printf.sprintf " Do not perform checks\n\ + \ on static scopes of code IDs and symbols during To_cmm%s\n\ + \ (Flambda 2 only)" + (format_not_default + Flambda2.Expert.Default.code_id_and_symbol_scoping_checks) +;; + +let mk_flambda2_expert_fallback_inlining_heuristic f = + "-flambda2-expert-fallback-inlining-heuristic", Arg.Unit f, + Printf.sprintf " Prevent inlining of functions\n\ + \ whose bodies contain closures%s (Flambda 2 only)" + (format_default Flambda2.Expert.Default.fallback_inlining_heuristic) +;; + +let mk_no_flambda2_expert_fallback_inlining_heuristic f = + "-no-flambda2-expert-fallback-inlining-heuristic", Arg.Unit f, + Printf.sprintf " Allow inlining of functions\n\ + \ whose bodies contain closures%s (Flambda 2 only)" + (format_not_default Flambda2.Expert.Default.fallback_inlining_heuristic) +;; + +let mk_flambda2_expert_inline_effects_in_cmm f = + "-flambda2-expert-inline-effects-in-cmm", Arg.Unit f, + Printf.sprintf " Allow inlining of effectful\n\ + \ expressions in the produced Cmm code%s (Flambda 2 only)" + (format_default Flambda2.Expert.Default.inline_effects_in_cmm) +;; + +let mk_no_flambda2_expert_inline_effects_in_cmm f = + "-no-flambda2-expert-inline-effects-in-cmm", Arg.Unit f, + Printf.sprintf " Prevent inlining of effectful\n\ + \ expressions in the produced Cmm code%s (Flambda 2 only)" + (format_not_default Flambda2.Expert.Default.inline_effects_in_cmm) +;; + +let mk_flambda2_expert_phantom_lets f = + "-flambda2-expert-phantom-lets", Arg.Unit f, + Printf.sprintf " Generate phantom lets when -g\n\ + \ is specified%s (Flambda 2 only)" + (format_default Flambda2.Expert.Default.phantom_lets) +;; + +let mk_no_flambda2_expert_phantom_lets f = + "-no-flambda2-expert-phantom-lets", Arg.Unit f, + Printf.sprintf " Do not generate phantom lets even when -g\n\ + \ is specified%s (Flambda 2 only)" + (format_not_default Flambda2.Expert.Default.phantom_lets) +;; + +let mk_flambda2_expert_max_block_size_for_projections f = + "-flambda2-expert-max-block-size-for-projections", Arg.Int f, + Printf.sprintf " Do not simplify projections\n\ + \ from blocks if the block size exceeds this value (default %s)\n\ + \ (Flambda 2 only)" + (match Flambda2.Expert.Default.max_block_size_for_projections with + | None -> "not set" + | Some max -> string_of_int max) +;; + +let mk_flambda2_expert_max_unboxing_depth f = + "-flambda2-expert-max-unboxing-depth", Arg.Int f, + Printf.sprintf " Do not unbox (nested) values deeper\n\ + \ than this many levels (default %d) (Flambda 2 only)" + Flambda2.Expert.Default.max_unboxing_depth +;; + +let mk_flambda2_expert_can_inline_recursive_functions f = + "-flambda2-expert-can-inline-recursive-functions", Arg.Unit f, + Printf.sprintf " Consider inlining\n\ + \ recursive functions (default %s) (Flambda 2 only)" + (format_default Flambda2.Expert.Default.can_inline_recursive_functions) +;; + +let mk_no_flambda2_expert_can_inline_recursive_functions f = + "-no-flambda2-expert-can-inline-recursive-functions", Arg.Unit f, + Printf.sprintf " Only inline recursive\n\ + \ functions if forced to so do by an attribute\n\ + \ (default %s) (Flambda 2 only)" + (format_not_default Flambda2.Expert.Default.can_inline_recursive_functions) +;; + +let mk_flambda2_debug_permute_every_name f = + "-flambda2-debug-permute-every-name", Arg.Unit f, + Printf.sprintf " Permute every name to test name\n\ + \ permutation code%s (Flambda 2 only)" + (format_default Flambda2.Debug.Default.permute_every_name) +;; + +let mk_no_flambda2_debug_permute_every_name f = + "-no-flambda2-debug-permute-every-name", Arg.Unit f, + Printf.sprintf " Do not permute every name to test\n\ + \ name permutation code%s (Flambda 2 only)" + (format_not_default Flambda2.Debug.Default.permute_every_name) +;; + +let mk_flambda2_debug_concrete_types_only_on_canonicals f = + "-flambda2-debug-concrete-types-only-on-canonicals", Arg.Unit f, + Printf.sprintf " Check that concrete\n\ + \ types are only assigned to canonical\n\ + \ names%s (Flambda 2 only)" + (format_default Flambda2.Debug.Default.concrete_types_only_on_canonicals) +;; + +let mk_no_flambda2_debug_concrete_types_only_on_canonicals f = + "-no-flambda2-debug-concrete-types-only-on-canonicals", Arg.Unit f, + Printf.sprintf " Do not check that\n\ + \ concrete types are only assigned to canonical\n\ + \ names%s (Flambda 2 only)" + (format_not_default + Flambda2.Debug.Default.concrete_types_only_on_canonicals) +;; + +let mk_flambda2_inline_max_depth f = + "-flambda2-inline-max-depth", Arg.String f, + Printf.sprintf "|=[,...]\n\ + \ Maximum depth of search for inlining opportunities inside\n\ + \ inlined functions (default %d) (Flambda 2 only)" + Flambda_backend_flags.Flambda2.Inlining.Default.max_depth +;; + +let mk_flambda2_inline_max_rec_depth f = + "-flambda2-inline-max-rec-depth", Arg.String f, + Printf.sprintf "|=[,...]\n\ + \ Maximum depth of search for inlining opportunities inside\n\ + \ inlined recursive functions (default %d) (Flambda 2 only)" + Flambda_backend_flags.Flambda2.Inlining.Default.max_rec_depth +;; + +let mk_flambda2_inline_cost arg descr ~default f = + Printf.sprintf "-flambda2-inline-%s-cost" arg, + Arg.String f, + Printf.sprintf "|=[,...]\n\ + \ The cost of not removing %s during inlining\n\ + \ (default %.03f, higher = more costly) (Flambda 2 only)" + descr + default +;; + +let mk_flambda2_inline_call_cost = + mk_flambda2_inline_cost "call" "a call" + ~default:Flambda_backend_flags.Flambda2.Inlining.Default.call_cost + +let mk_flambda2_inline_alloc_cost = + mk_flambda2_inline_cost "alloc" "an allocation" + ~default:Flambda_backend_flags.Flambda2.Inlining.Default.alloc_cost + +let mk_flambda2_inline_prim_cost = + mk_flambda2_inline_cost "prim" "a primitive" + ~default:Flambda_backend_flags.Flambda2.Inlining.Default.prim_cost + +let mk_flambda2_inline_branch_cost = + mk_flambda2_inline_cost "branch" "a conditional" + ~default:Flambda_backend_flags.Flambda2.Inlining.Default.branch_cost + +let mk_flambda2_inline_indirect_call_cost = + mk_flambda2_inline_cost "indirect" "an indirect call" + ~default:Flambda_backend_flags.Flambda2.Inlining.Default.indirect_call_cost + +let mk_flambda2_inline_poly_compare_cost = + mk_flambda2_inline_cost "poly-compare" "a polymorphic comparison" + ~default:Flambda_backend_flags.Flambda2.Inlining.Default.poly_compare_cost + +(* CR-someday mshinwell: We should have a check that the parameters provided by + the user are sensible, e.g. small_function_size <= large_function_size. *) + +let mk_flambda2_inline_small_function_size f = + "-flambda2-inline-small-function-size", Arg.String f, + Printf.sprintf "|=[,...]\n\ + \ Functions with a cost less than this will always be inlined\n\ + \ unless an attribute instructs otherwise (default %d)\n\ + \ (Flambda 2 only)" + Flambda_backend_flags.Flambda2.Inlining.Default.small_function_size +;; + +let mk_flambda2_inline_large_function_size f = + "-flambda2-inline-large-function-size", Arg.String f, + Printf.sprintf "|=[,...]\n\ + \ Functions with a cost greater than this will never be inlined\n\ + \ unless an attribute instructs otherwise (default %d); speculative\n\ + \ inlining will be disabled if equal to the small function size\n\ + \ (Flambda 2 only)" + Flambda_backend_flags.Flambda2.Inlining.Default.large_function_size +;; + +let mk_flambda2_inline_threshold f = + "-flambda2-inline-threshold", Arg.String f, + Printf.sprintf "|=[,...]\n\ + \ Aggressiveness of inlining (default %.02f, higher numbers mean\n\ + \ more aggressive) (Flambda 2 only)" + Flambda_backend_flags.Flambda2.Inlining.Default.threshold + +let mk_flambda2_speculative_inlining_only_if_arguments_useful f = + "-flambda2-speculative-inlining-only-if-arguments-useful", Arg.Unit f, + Printf.sprintf " Only\n\ + \ perform speculative inlining if the Flambda type system has\n\ + \ useful information about the argument(s) at the call site%s\n\ + \ (Flambda 2 only)" + (format_default + Flambda2.Inlining.Default.speculative_inlining_only_if_arguments_useful) + +let mk_no_flambda2_speculative_inlining_only_if_arguments_useful f = + "-no-flambda2-speculative-inlining-only-if-arguments-useful", Arg.Unit f, + Printf.sprintf " Ignore\n\ + \ whether the Flambda type system has useful information\n\ + \ about the argument(s) at the call site when performing\n\ + \ speculative inlining%s (Flambda 2 only)" + (format_not_default + Flambda2.Inlining.Default.speculative_inlining_only_if_arguments_useful) + +let mk_flambda2_treat_invalid_code_as_unreachable f = + "-flambda2-treat-invalid-code-as-unreachable", Arg.Unit f, + Printf.sprintf " Treat code deemed as\n\ + \ invalid by the Flambda 2 type system as unreachable, thus causing\n\ + \ it (and potentially calling code) to be deleted%s\n\ + \ (Flambda 2 only)" + (format_default Flambda2.Default.treat_invalid_code_as_unreachable) +;; + +let mk_no_flambda2_treat_invalid_code_as_unreachable f = + "-no-flambda2-treat-invalid-code-as-unreachable", Arg.Unit f, + Printf.sprintf " Do not treat code deemed as\n\ + \ invalid by the Flambda 2 type system as unreachable, instead\n\ + \ replacing it by a trap (which currently causes a segfault)%s\n\ + \ (Flambda 2 only)" + (format_not_default Flambda2.Default.treat_invalid_code_as_unreachable) +;; + +let mk_flambda2_inlining_report_bin f = + "-flambda2-inlining-report-bin", Arg.Unit f, " Write inlining report\n\ + \ in binary format (Flambda 2 only)" +;; + +let mk_flambda2_unicode f = + "-flambda2-unicode", Arg.Unit f, " Use Unicode output when printing\n\ + \ Flambda 2 code" +;; + +let mk_drawfexpr f = + "-drawfexpr", Arg.Unit f, " Like -drawflambda but outputs fexpr language\n\ + \ (Flambda 2 only)" +;; + +let mk_dfexpr f = + "-dfexpr", Arg.Unit f, " Like -dflambda but outputs fexpr language\n\ + \ (Flambda 2 only)" +;; + +let mk_dflexpect f = + "-dflexpect", Arg.Unit f, " Like -dflambda but outputs a .flt file\n\ + \ whose basename matches that of the input .ml file (Flambda 2 only)" +;; + +let mk_dclosure_offsets f = + "-dclosure-offsets", Arg.Unit f, " Dump closure offsets (Flambda 2 only)" +;; + +let mk_dfreshen f = + "-dfreshen", Arg.Unit f, " Freshen bound names when printing (Flambda 2 only)" +;; + +module type Flambda_backend_options = sig + val ocamlcfg : unit -> unit + val no_ocamlcfg : unit -> unit + + val flambda2_join_points : unit -> unit + val no_flambda2_join_points : unit -> unit + val flambda2_unbox_along_intra_function_control_flow : unit -> unit + val no_flambda2_unbox_along_intra_function_control_flow : unit -> unit + val flambda2_backend_cse_at_toplevel : unit -> unit + val no_flambda2_backend_cse_at_toplevel : unit -> unit + val flambda2_cse_depth : int -> unit + val flambda2_expert_code_id_and_symbol_scoping_checks : unit -> unit + val no_flambda2_expert_code_id_and_symbol_scoping_checks : unit -> unit + val flambda2_expert_fallback_inlining_heuristic : unit -> unit + val no_flambda2_expert_fallback_inlining_heuristic : unit -> unit + val flambda2_expert_inline_effects_in_cmm : unit -> unit + val no_flambda2_expert_inline_effects_in_cmm : unit -> unit + val flambda2_expert_phantom_lets : unit -> unit + val no_flambda2_expert_phantom_lets : unit -> unit + val flambda2_expert_max_block_size_for_projections : int -> unit + val flambda2_expert_max_unboxing_depth : int -> unit + val flambda2_expert_can_inline_recursive_functions : unit -> unit + val no_flambda2_expert_can_inline_recursive_functions : unit -> unit + val flambda2_debug_permute_every_name : unit -> unit + val no_flambda2_debug_permute_every_name : unit -> unit + val flambda2_debug_concrete_types_only_on_canonicals : unit -> unit + val no_flambda2_debug_concrete_types_only_on_canonicals : unit -> unit + + val flambda2_inline_max_depth : string -> unit + val flambda2_inline_max_rec_depth : string -> unit + val flambda2_inline_call_cost : string -> unit + val flambda2_inline_alloc_cost : string -> unit + val flambda2_inline_prim_cost : string -> unit + val flambda2_inline_branch_cost : string -> unit + val flambda2_inline_indirect_call_cost : string -> unit + val flambda2_inline_poly_compare_cost : string -> unit + val flambda2_inline_small_function_size : string -> unit + val flambda2_inline_large_function_size : string -> unit + val flambda2_inline_threshold : string -> unit + val flambda2_speculative_inlining_only_if_arguments_useful : unit -> unit + val no_flambda2_speculative_inlining_only_if_arguments_useful : unit -> unit + + val flambda2_inlining_report_bin : unit -> unit + + val flambda2_unicode : unit -> unit + + val flambda2_treat_invalid_code_as_unreachable : unit -> unit + val no_flambda2_treat_invalid_code_as_unreachable : unit -> unit + + val drawfexpr : unit -> unit + val dfexpr : unit -> unit + val dflexpect : unit -> unit + val dclosure_offsets : unit -> unit + val dfreshen : unit -> unit +end + +module Make_flambda_backend_options (F : Flambda_backend_options) = +struct + let list2 = [ + mk_ocamlcfg F.ocamlcfg; + mk_no_ocamlcfg F.no_ocamlcfg; + + mk_flambda2_join_points F.flambda2_join_points; + mk_no_flambda2_join_points F.no_flambda2_join_points; + mk_flambda2_unbox_along_intra_function_control_flow + F.flambda2_unbox_along_intra_function_control_flow; + mk_no_flambda2_unbox_along_intra_function_control_flow + F.no_flambda2_unbox_along_intra_function_control_flow; + mk_flambda2_backend_cse_at_toplevel F.flambda2_backend_cse_at_toplevel; + mk_no_flambda2_backend_cse_at_toplevel + F.no_flambda2_backend_cse_at_toplevel; + mk_flambda2_cse_depth F.flambda2_cse_depth; + mk_flambda2_expert_code_id_and_symbol_scoping_checks + F.flambda2_expert_code_id_and_symbol_scoping_checks; + mk_no_flambda2_expert_code_id_and_symbol_scoping_checks + F.no_flambda2_expert_code_id_and_symbol_scoping_checks; + mk_flambda2_expert_fallback_inlining_heuristic + F.flambda2_expert_fallback_inlining_heuristic; + mk_no_flambda2_expert_fallback_inlining_heuristic + F.no_flambda2_expert_fallback_inlining_heuristic; + mk_flambda2_expert_inline_effects_in_cmm + F.flambda2_expert_inline_effects_in_cmm; + mk_no_flambda2_expert_inline_effects_in_cmm + F.no_flambda2_expert_inline_effects_in_cmm; + mk_flambda2_expert_phantom_lets + F.flambda2_expert_phantom_lets; + mk_no_flambda2_expert_phantom_lets + F.no_flambda2_expert_phantom_lets; + mk_flambda2_expert_max_block_size_for_projections + F.flambda2_expert_max_block_size_for_projections; + mk_flambda2_expert_max_unboxing_depth + F.flambda2_expert_max_unboxing_depth; + mk_flambda2_expert_can_inline_recursive_functions + F.flambda2_expert_can_inline_recursive_functions; + mk_no_flambda2_expert_can_inline_recursive_functions + F.no_flambda2_expert_can_inline_recursive_functions; + mk_flambda2_debug_permute_every_name + F.flambda2_debug_permute_every_name; + mk_no_flambda2_debug_permute_every_name + F.no_flambda2_debug_permute_every_name; + mk_flambda2_debug_concrete_types_only_on_canonicals + F.flambda2_debug_concrete_types_only_on_canonicals; + mk_no_flambda2_debug_concrete_types_only_on_canonicals + F.no_flambda2_debug_concrete_types_only_on_canonicals; + + mk_flambda2_inline_max_depth F.flambda2_inline_max_depth; + mk_flambda2_inline_max_rec_depth F.flambda2_inline_max_rec_depth; + mk_flambda2_inline_alloc_cost F.flambda2_inline_alloc_cost; + mk_flambda2_inline_branch_cost F.flambda2_inline_branch_cost; + mk_flambda2_inline_call_cost F.flambda2_inline_call_cost; + mk_flambda2_inline_prim_cost F.flambda2_inline_prim_cost; + mk_flambda2_inline_indirect_call_cost F.flambda2_inline_indirect_call_cost; + mk_flambda2_inline_poly_compare_cost F.flambda2_inline_poly_compare_cost; + mk_flambda2_inline_small_function_size + F.flambda2_inline_small_function_size; + mk_flambda2_inline_large_function_size + F.flambda2_inline_large_function_size; + mk_flambda2_inline_threshold F.flambda2_inline_threshold; + mk_flambda2_speculative_inlining_only_if_arguments_useful + F.flambda2_speculative_inlining_only_if_arguments_useful; + mk_no_flambda2_speculative_inlining_only_if_arguments_useful + F.no_flambda2_speculative_inlining_only_if_arguments_useful; + + mk_flambda2_inlining_report_bin F.flambda2_inlining_report_bin; + + mk_flambda2_unicode F.flambda2_unicode; + + mk_flambda2_treat_invalid_code_as_unreachable + F.flambda2_treat_invalid_code_as_unreachable; + mk_no_flambda2_treat_invalid_code_as_unreachable + F.no_flambda2_treat_invalid_code_as_unreachable; + + mk_drawfexpr F.drawfexpr; + mk_dfexpr F.dfexpr; + mk_dflexpect F.dflexpect; + mk_dclosure_offsets F.dclosure_offsets; + mk_dfreshen F.dfreshen; + ] +end + +module Flambda_backend_options_impl = struct + let set r () = r := true + let clear r () = r := false + + let ocamlcfg = set Flambda_backend_flags.use_ocamlcfg + let no_ocamlcfg = clear Flambda_backend_flags.use_ocamlcfg + + let flambda2_join_points = set Flambda2.join_points + let no_flambda2_join_points = clear Flambda2.join_points + let flambda2_unbox_along_intra_function_control_flow = + set Flambda2.unbox_along_intra_function_control_flow + let no_flambda2_unbox_along_intra_function_control_flow = + clear Flambda2.unbox_along_intra_function_control_flow + let flambda2_backend_cse_at_toplevel = + set Flambda2.backend_cse_at_toplevel + let no_flambda2_backend_cse_at_toplevel = + clear Flambda2.backend_cse_at_toplevel + let flambda2_cse_depth n = Flambda2.cse_depth := n + let flambda2_expert_code_id_and_symbol_scoping_checks = + set Flambda2.Expert.code_id_and_symbol_scoping_checks + let no_flambda2_expert_code_id_and_symbol_scoping_checks = + clear Flambda2.Expert.code_id_and_symbol_scoping_checks + let flambda2_expert_fallback_inlining_heuristic = + set Flambda2.Expert.fallback_inlining_heuristic + let no_flambda2_expert_fallback_inlining_heuristic = + clear Flambda2.Expert.fallback_inlining_heuristic + let flambda2_expert_inline_effects_in_cmm = + set Flambda2.Expert.inline_effects_in_cmm + let no_flambda2_expert_inline_effects_in_cmm = + clear Flambda2.Expert.inline_effects_in_cmm + let flambda2_expert_phantom_lets = + set Flambda2.Expert.phantom_lets + let no_flambda2_expert_phantom_lets = + clear Flambda2.Expert.phantom_lets + let flambda2_expert_max_block_size_for_projections size = + Flambda2.Expert.max_block_size_for_projections := Some size + let flambda2_expert_max_unboxing_depth depth = + Flambda2.Expert.max_unboxing_depth := depth + let flambda2_expert_can_inline_recursive_functions () = + Flambda2.Expert.can_inline_recursive_functions := true + let no_flambda2_expert_can_inline_recursive_functions () = + Flambda2.Expert.can_inline_recursive_functions := false + let flambda2_debug_permute_every_name = + set Flambda2.Debug.permute_every_name + let no_flambda2_debug_permute_every_name = + clear Flambda2.Debug.permute_every_name + let flambda2_debug_concrete_types_only_on_canonicals = + set Flambda2.Debug.concrete_types_only_on_canonicals + let no_flambda2_debug_concrete_types_only_on_canonicals = + clear Flambda2.Debug.concrete_types_only_on_canonicals + + let flambda2_inline_max_depth spec = + Clflags.Int_arg_helper.parse spec + "Syntax: -flambda2-inline-max-depth | =[,...]" + Flambda2.Inlining.max_depth + + let flambda2_inline_max_rec_depth spec = + Clflags.Int_arg_helper.parse spec + "Syntax: -flambda2-inline-max-rec-depth | =[,...]" + Flambda2.Inlining.max_rec_depth + let flambda2_inline_alloc_cost spec = + Clflags.Float_arg_helper.parse spec + "Syntax: -flambda2-inline-alloc-cost | =[,...]" + Flambda2.Inlining.alloc_cost + + let flambda2_inline_branch_cost spec = + Clflags.Float_arg_helper.parse spec + "Syntax: -flambda2-inline-branch-cost | =[,...]" + Flambda2.Inlining.branch_cost + + let flambda2_inline_call_cost spec = + Clflags.Float_arg_helper.parse spec + "Syntax: -flambda2-inline-call-cost | =[,...]" + Flambda2.Inlining.call_cost + + let flambda2_inline_prim_cost spec = + Clflags.Float_arg_helper.parse spec + "Syntax: -flambda2-inline-prim-cost | =[,...]" + Flambda2.Inlining.prim_cost + + let flambda2_inline_indirect_call_cost spec = + Clflags.Float_arg_helper.parse spec + "Syntax: -flambda2-inline-indirect-call-cost | \ + =[,...]" + Flambda2.Inlining.indirect_call_cost + + let flambda2_inline_poly_compare_cost spec = + Clflags.Float_arg_helper.parse spec + "Syntax: -flambda2-inline-poly-compare-cost | \ + =[,...]" + Flambda2.Inlining.poly_compare_cost + + let flambda2_inline_small_function_size spec = + Clflags.Int_arg_helper.parse spec + "Syntax: -flambda2-inline-small-function-size | \ + =[,...]" + Flambda2.Inlining.small_function_size + + let flambda2_inline_large_function_size spec = + Clflags.Int_arg_helper.parse spec + "Syntax: -flambda2-inline-large-function-size | \ + =[,...]" + Flambda2.Inlining.large_function_size + + let flambda2_inline_threshold spec = + Clflags.Float_arg_helper.parse spec + "Syntax: -flambda2-inline-threshold | =[,...]" + Flambda2.Inlining.threshold + + let flambda2_speculative_inlining_only_if_arguments_useful = + set Flambda2.Inlining.speculative_inlining_only_if_arguments_useful + + let no_flambda2_speculative_inlining_only_if_arguments_useful = + clear Flambda2.Inlining.speculative_inlining_only_if_arguments_useful + + let flambda2_inlining_report_bin = set Flambda2.Inlining.report_bin + + let flambda2_unicode = set Flambda2.unicode + + let flambda2_treat_invalid_code_as_unreachable = + set Flambda2.treat_invalid_code_as_unreachable + let no_flambda2_treat_invalid_code_as_unreachable = + clear Flambda2.treat_invalid_code_as_unreachable + + let drawfexpr = set Flambda2.Dump.rawfexpr + let dfexpr = set Flambda2.Dump.fexpr + let dflexpect = set Flambda2.Dump.flexpect + let dclosure_offsets = set Flambda2.Dump.closure_offsets + let dfreshen = set Flambda2.Dump.freshen +end + +module Extra_params = struct + let read_param ppf _position name v = + let set option = + Compenv.setter ppf (fun b -> b) name [ option ] v; true + in + let _clear option = + Compenv.setter ppf (fun b -> not b) name [ option ] v; true + in + let set_int option = + Compenv.int_setter ppf name option v; true + in + match name with + (* override existing params *) + | "Oclassic" -> + if Compenv.check_bool ppf "Oclassic" v then + Flambda_backend_flags.set_oclassic (); true + | "O2" -> + if Compenv.check_bool ppf "O2" v then + Flambda_backend_flags.set_o2 (); true + | "O3" -> + if Compenv.check_bool ppf "O3" v then + Flambda_backend_flags.set_o3 (); true + (* define new params *) + | "ocamlcfg" -> set Flambda_backend_flags.use_ocamlcfg + | "flambda2-join-points" -> set Flambda2.join_points + | "flambda2-unbox-along-intra-function-control-flow" -> + set Flambda2.unbox_along_intra_function_control_flow + | "flambda2-backend-cse-at-toplevel" -> + set Flambda2.backend_cse_at_toplevel + | "flambda2-cse-depth" -> + set_int Flambda2.cse_depth + | "flambda2-expert-inline-effects-in-cmm" -> + set Flambda2.Expert.inline_effects_in_cmm + | "flambda2-expert-phantom-lets" -> + set Flambda2.Expert.phantom_lets + | "flambda2-expert-max-unboxing-depth" -> + set_int Flambda2.Expert.max_unboxing_depth + | "flambda2-expert-can-inline-recursive-functions" -> + set Flambda2.Expert.can_inline_recursive_functions + | "flambda2-inline-max-depth" -> + Clflags.Int_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'flambda2-inline-max-depth'" + Flambda2.Inlining.max_depth; true + | "flambda2-inline-max-rec-depth" -> + Clflags.Int_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'flambda2-inline-max-rec-depth'" + Flambda2.Inlining.max_rec_depth; true + | "flambda2-inline-call-cost" -> + Clflags.Float_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'flambda2-inline-call-cost'" + Flambda2.Inlining.call_cost; true + | "flambda2-inline-alloc-cost" -> + Clflags.Float_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'flambda2-inline-alloc-cost'" + Flambda2.Inlining.alloc_cost; true + | "flambda2-inline-prim-cost" -> + Clflags.Float_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'flambda2-inline-prim-cost'" + Flambda2.Inlining.prim_cost; true + | "flambda2-inline-branch-cost" -> + Clflags.Float_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'flambda2-inline-branch-cost'" + Flambda2.Inlining.branch_cost; true + | "flambda2-inline-indirect-cost" -> + Clflags.Float_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'flambda2-inline-indirect-cost'" + Flambda2.Inlining.indirect_call_cost; true + | "flambda2-inline-poly-compare-cost" -> + Clflags.Float_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'flambda2-inline-poly-compare-cost'" + Flambda2.Inlining.poly_compare_cost; true + | "flambda2-inline-small-function-size" -> + Clflags.Int_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'flambda2-inline-small-function-size'" + Flambda2.Inlining.small_function_size; true + | "flambda2-inline-large-function-size" -> + Clflags.Int_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'flambda2-inline-large-function-size'" + Flambda2.Inlining.large_function_size; true + | "flambda2-inline-threshold" -> + Clflags.Float_arg_helper.parse v + "Bad syntax in OCAMLPARAM for 'flambda2-inline-threshold'" + Flambda2.Inlining.threshold; true + | "flambda2-speculative-inlining-only-if-arguments-useful" -> + set Flambda2.Inlining.speculative_inlining_only_if_arguments_useful + | "flambda2-treat-invalid-code-as-unreachable" -> + set Flambda2.treat_invalid_code_as_unreachable + | "flambda2-inlining-report-bin" -> + set Flambda2.Inlining.report_bin + | "flambda2-expert-code-id-and-symbol-scoping-checks" -> + set Flambda2.Expert.code_id_and_symbol_scoping_checks + | "flambda2-expert-fallback-inlining-heuristic" -> + set Flambda2.Expert.fallback_inlining_heuristic + | "flambda2-debug-permute-every-name" -> + set Flambda2.Debug.permute_every_name + | "flambda2-debug-concrete-types-only-on-canonicals" -> + set Flambda2.Debug.concrete_types_only_on_canonicals + | _ -> false +end + +module type Optcomp_options = sig + include Main_args.Optcomp_options + include Flambda_backend_options +end + +module type Opttop_options = sig + include Main_args.Opttop_options + include Flambda_backend_options +end + +module Make_optcomp_options (F : Optcomp_options) = +struct + include Make_flambda_backend_options(F) (* provides [list2] *) + include Main_args.Make_optcomp_options(F) (* provides [list] *) + (* Overwrite [list] with the combination of the above options. + If the same string input can be recognized by two options, + the flambda-backend implementation will take precedence, + but this should be avoided. To override an option from Main_args, + redefine it in the implementation of this functor's argument. + See the approach below for _o3 in Default. *) + let list = list2 @ list +end + +module Make_opttop_options (F : Opttop_options) = struct + include Make_flambda_backend_options(F) + include Main_args.Make_opttop_options(F) + let list = list2 @ list +end + +module Default = struct + module Optmain = struct + include Main_args.Default.Optmain + include Flambda_backend_options_impl + let _o2 () = Flambda_backend_flags.set_o2 () + let _o3 () = Flambda_backend_flags.set_o3 () + let _classic_inlining () = Flambda_backend_flags.set_oclassic () + end + module Opttopmain = struct + include Main_args.Default.Opttopmain + include Flambda_backend_options_impl + let _o2 () = Flambda_backend_flags.set_o2 () + let _o3 () = Flambda_backend_flags.set_o3 () + let _classic_inlining () = Flambda_backend_flags.set_oclassic () + end +end diff --git a/driver/flambda_backend_args.mli b/driver/flambda_backend_args.mli new file mode 100644 index 00000000000..1d9a2dd3b79 --- /dev/null +++ b/driver/flambda_backend_args.mli @@ -0,0 +1,109 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2021 OCamlPro SAS *) +(* Copyright 2014--2021 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) +(** This module follows the structure of ocaml/driver/main_args.ml{i}. + It provides a way to (a) share argument implementations between + different installable tools and (b) override default implementations + of arguments. *) + +(** Command line arguments required for flambda backend. *) +module type Flambda_backend_options = sig + val ocamlcfg : unit -> unit + val no_ocamlcfg : unit -> unit + val flambda2_join_points : unit -> unit + val no_flambda2_join_points : unit -> unit + val flambda2_unbox_along_intra_function_control_flow : unit -> unit + val no_flambda2_unbox_along_intra_function_control_flow : unit -> unit + val flambda2_backend_cse_at_toplevel : unit -> unit + val no_flambda2_backend_cse_at_toplevel : unit -> unit + val flambda2_cse_depth : int -> unit + val flambda2_expert_code_id_and_symbol_scoping_checks : unit -> unit + val no_flambda2_expert_code_id_and_symbol_scoping_checks : unit -> unit + val flambda2_expert_fallback_inlining_heuristic : unit -> unit + val no_flambda2_expert_fallback_inlining_heuristic : unit -> unit + val flambda2_expert_inline_effects_in_cmm : unit -> unit + val no_flambda2_expert_inline_effects_in_cmm : unit -> unit + val flambda2_expert_phantom_lets : unit -> unit + val no_flambda2_expert_phantom_lets : unit -> unit + val flambda2_expert_max_block_size_for_projections : int -> unit + val flambda2_expert_max_unboxing_depth : int -> unit + val flambda2_expert_can_inline_recursive_functions : unit -> unit + val no_flambda2_expert_can_inline_recursive_functions : unit -> unit + val flambda2_debug_permute_every_name : unit -> unit + val no_flambda2_debug_permute_every_name : unit -> unit + val flambda2_debug_concrete_types_only_on_canonicals : unit -> unit + val no_flambda2_debug_concrete_types_only_on_canonicals : unit -> unit + + val flambda2_inline_max_depth : string -> unit + val flambda2_inline_max_rec_depth : string -> unit + val flambda2_inline_call_cost : string -> unit + val flambda2_inline_alloc_cost : string -> unit + val flambda2_inline_prim_cost : string -> unit + val flambda2_inline_branch_cost : string -> unit + val flambda2_inline_indirect_call_cost : string -> unit + val flambda2_inline_poly_compare_cost : string -> unit + val flambda2_inline_small_function_size : string -> unit + val flambda2_inline_large_function_size : string -> unit + val flambda2_inline_threshold : string -> unit + val flambda2_speculative_inlining_only_if_arguments_useful : unit -> unit + val no_flambda2_speculative_inlining_only_if_arguments_useful : unit -> unit + + val flambda2_inlining_report_bin : unit -> unit + + val flambda2_unicode : unit -> unit + + val flambda2_treat_invalid_code_as_unreachable : unit -> unit + val no_flambda2_treat_invalid_code_as_unreachable : unit -> unit + + val drawfexpr : unit -> unit + val dfexpr : unit -> unit + val dflexpect : unit -> unit + val dclosure_offsets : unit -> unit + val dfreshen : unit -> unit +end + +(** Command line arguments required for ocamlopt. *) +module type Optcomp_options = sig + include Main_args.Optcomp_options + include Flambda_backend_options +end + +(** Command line arguments required for ocamlnat. *) +module type Opttop_options = sig + include Main_args.Opttop_options + include Flambda_backend_options +end + +(** Transform required command-line arguments into actual arguments. + Each tool can define its own argument implementations and + call the right functor to actualize them into [Arg.t] list. *) +module Make_optcomp_options : Optcomp_options -> Main_args.Arg_list;; +module Make_opttop_options : Opttop_options -> Main_args.Arg_list;; + +(** Default implementations of required arguments for each tool. *) +module Default: sig + module Optmain: Optcomp_options + module Opttopmain: Opttop_options +end + +(** Extra_params module provides a way to read flambda-backend + flags from OCAMLPARAM. All command line flags should support it, + with the exception of debug printing, such as -dcfg. +*) +module Extra_params : sig + (** [read_param ppf pos name value] returns whether the param was handled. *) + val read_param : + Format.formatter -> Compenv.readenv_position -> string -> string -> bool +end diff --git a/driver/flambda_backend_flags.ml b/driver/flambda_backend_flags.ml new file mode 100644 index 00000000000..bbaaee60a02 --- /dev/null +++ b/driver/flambda_backend_flags.ml @@ -0,0 +1,252 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2021 OCamlPro SAS *) +(* Copyright 2014--2021 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) +let use_ocamlcfg = ref false (* -ocamlcfg *) + +module Flambda2 = struct + module Default = struct + let classic_mode = false + let join_points = false + let unbox_along_intra_function_control_flow = true + let backend_cse_at_toplevel = false + let cse_depth = 2 + let treat_invalid_code_as_unreachable = false + let unicode = true + end + + let classic_mode = ref Default.classic_mode + let join_points = ref Default.join_points + let unbox_along_intra_function_control_flow = + ref Default.unbox_along_intra_function_control_flow + let backend_cse_at_toplevel = ref Default.backend_cse_at_toplevel + let cse_depth = ref Default.cse_depth + let treat_invalid_code_as_unreachable = + ref Default.treat_invalid_code_as_unreachable + let unicode = ref Default.unicode + + module Dump = struct + let rawfexpr = ref false + let fexpr = ref false + let flexpect = ref false + let closure_offsets = ref false + let freshen = ref false + end + + module Expert = struct + module Default = struct + let code_id_and_symbol_scoping_checks = false + let fallback_inlining_heuristic = false + let inline_effects_in_cmm = false + let phantom_lets = true + let max_block_size_for_projections = None + let max_unboxing_depth = 3 + let can_inline_recursive_functions = false + end + + let code_id_and_symbol_scoping_checks = + ref Default.code_id_and_symbol_scoping_checks + let fallback_inlining_heuristic = ref Default.fallback_inlining_heuristic + let inline_effects_in_cmm = ref Default.inline_effects_in_cmm + let phantom_lets = ref Default.phantom_lets + let max_block_size_for_projections = + ref Default.max_block_size_for_projections + let max_unboxing_depth = ref Default.max_unboxing_depth + let can_inline_recursive_functions = + ref Default.can_inline_recursive_functions + end + + module Debug = struct + module Default = struct + let permute_every_name = false + let concrete_types_only_on_canonicals = false + end + + let permute_every_name = ref Default.permute_every_name + let concrete_types_only_on_canonicals = + ref Default.concrete_types_only_on_canonicals + end + + module I = Clflags.Int_arg_helper + module F = Clflags.Float_arg_helper + + module Inlining = struct + module Default = struct + let cost_divisor = 8. + + let max_depth = 1 + let max_rec_depth = 0 + + let call_cost = 5. /. cost_divisor + let alloc_cost = 7. /. cost_divisor + let prim_cost = 3. /. cost_divisor + let branch_cost = 5. /. cost_divisor + let indirect_call_cost = 4. /. cost_divisor + let poly_compare_cost = 10. /. cost_divisor + + let small_function_size = 10 + let large_function_size = 10 + + let threshold = 10. + + let speculative_inlining_only_if_arguments_useful = true + end + + let max_depth = ref (I.default Default.max_depth) + let max_rec_depth = ref (I.default Default.max_rec_depth) + + let call_cost = ref (F.default Default.call_cost) + let alloc_cost = ref (F.default Default.alloc_cost) + let prim_cost = ref (F.default Default.prim_cost) + let branch_cost = ref (F.default Default.branch_cost) + let indirect_call_cost = ref (F.default Default.indirect_call_cost) + let poly_compare_cost = ref (F.default Default.poly_compare_cost) + + let small_function_size = ref (I.default Default.small_function_size) + let large_function_size = ref (I.default Default.large_function_size) + + let threshold = ref (F.default Default.threshold) + + let speculative_inlining_only_if_arguments_useful = + ref Default.speculative_inlining_only_if_arguments_useful + + let report_bin = ref false + + type inlining_arguments = { + max_depth : int option; + max_rec_depth : int option; + call_cost : float option; + alloc_cost : float option; + prim_cost : float option; + branch_cost : float option; + indirect_call_cost : float option; + poly_compare_cost : float option; + small_function_size : int option; + large_function_size : int option; + threshold : float option; + } + + let use_inlining_arguments_set ?round (arg : inlining_arguments) = + let set_int = Clflags.set_int_arg round in + let set_float = Clflags.set_float_arg round in + set_int max_depth Default.max_depth arg.max_depth; + set_int max_rec_depth Default.max_rec_depth arg.max_rec_depth; + set_float call_cost Default.call_cost arg.call_cost; + set_float alloc_cost Default.alloc_cost arg.alloc_cost; + set_float prim_cost Default.prim_cost arg.prim_cost; + set_float branch_cost Default.branch_cost arg.branch_cost; + set_float indirect_call_cost + Default.indirect_call_cost arg.indirect_call_cost; + set_float poly_compare_cost + Default.poly_compare_cost arg.poly_compare_cost; + set_int small_function_size + Default.small_function_size arg.small_function_size; + set_int large_function_size + Default.large_function_size arg.large_function_size; + set_float threshold Default.threshold arg.threshold + + let oclassic_arguments = { + max_depth = None; + max_rec_depth = None; + call_cost = None; + alloc_cost = None; + prim_cost = None; + branch_cost = None; + indirect_call_cost = None; + poly_compare_cost = None; + (* We set the small and large function sizes to the same value here to + recover "classic mode" semantics (no speculative inlining). *) + small_function_size = Some Default.small_function_size; + large_function_size = Some Default.small_function_size; + (* [threshold] matches the current compiler's default. (The factor of + 8 in that default is accounted for by [cost_divisor], above.) *) + threshold = Some 10.; + } + + let o2_arguments = { + max_depth = Some 2; + max_rec_depth = Some 0; + call_cost = Some (2.0 *. Default.call_cost); + alloc_cost = Some (2.0 *. Default.alloc_cost); + prim_cost = Some (2.0 *. Default.prim_cost); + branch_cost = Some (2.0 *. Default.branch_cost); + indirect_call_cost = Some (2.0 *. Default.indirect_call_cost); + poly_compare_cost = Some (2.0 *. Default.poly_compare_cost); + small_function_size = Some (2 * Default.small_function_size); + large_function_size = Some (4 * Default.large_function_size); + threshold = Some 25.; + } + + let o3_arguments = { + max_depth = Some 3; + max_rec_depth = Some 0; + call_cost = Some (3.0 *. Default.call_cost); + alloc_cost = Some (3.0 *. Default.alloc_cost); + prim_cost = Some (3.0 *. Default.prim_cost); + branch_cost = Some (3.0 *. Default.branch_cost); + indirect_call_cost = Some (3.0 *. Default.indirect_call_cost); + poly_compare_cost = Some (3.0 *. Default.poly_compare_cost); + small_function_size = Some (10 * Default.small_function_size); + large_function_size = Some (50 * Default.large_function_size); + threshold = Some 100.; + } + end + + let oclassic_flags () = + classic_mode := true; + cse_depth := 2; + join_points := false; + unbox_along_intra_function_control_flow := true; + Expert.fallback_inlining_heuristic := true; + backend_cse_at_toplevel := false + + let o2_flags () = + cse_depth := 2; + join_points := false; + unbox_along_intra_function_control_flow := true; + Expert.fallback_inlining_heuristic := false; + backend_cse_at_toplevel := false + + let o3_flags () = + cse_depth := 2; + join_points := true; + unbox_along_intra_function_control_flow := true; + Expert.fallback_inlining_heuristic := false; + backend_cse_at_toplevel := false +end + +let set_oclassic () = + if Clflags.is_flambda2 () then begin + Flambda2.Inlining.use_inlining_arguments_set + Flambda2.Inlining.oclassic_arguments; + Flambda2.oclassic_flags () + end else begin + Clflags.set_oclassic (); + end + +let set_o2 () = + if Clflags.is_flambda2 () then begin + Flambda2.Inlining.use_inlining_arguments_set Flambda2.Inlining.o2_arguments; + Flambda2.o2_flags () + end else begin + Clflags.set_o2 (); + end + +let set_o3 () = + if Clflags.is_flambda2 () then begin + Flambda2.Inlining.use_inlining_arguments_set Flambda2.Inlining.o3_arguments; + Flambda2.o3_flags () + end else begin + Clflags.set_o3 (); + end diff --git a/driver/flambda_backend_flags.mli b/driver/flambda_backend_flags.mli new file mode 100644 index 00000000000..01c039c0acc --- /dev/null +++ b/driver/flambda_backend_flags.mli @@ -0,0 +1,122 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2021 OCamlPro SAS *) +(* Copyright 2014--2021 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) +(** Flambda-backend specific command line flags *) +val use_ocamlcfg : bool ref + +module Flambda2 : sig + module Default : sig + val classic_mode : bool + val join_points : bool + val unbox_along_intra_function_control_flow : bool + val backend_cse_at_toplevel : bool + val cse_depth : int + val treat_invalid_code_as_unreachable : bool + + val unicode : bool + end + + val classic_mode : bool ref + val join_points : bool ref + val unbox_along_intra_function_control_flow : bool ref + val backend_cse_at_toplevel : bool ref + val cse_depth : int ref + val treat_invalid_code_as_unreachable : bool ref + + val unicode : bool ref + + module Dump : sig + val rawfexpr : bool ref + val fexpr : bool ref + val flexpect : bool ref + val closure_offsets : bool ref + val freshen : bool ref + end + + module Expert : sig + module Default : sig + val code_id_and_symbol_scoping_checks : bool + val fallback_inlining_heuristic : bool + val inline_effects_in_cmm : bool + val phantom_lets : bool + val max_block_size_for_projections : int option + val max_unboxing_depth : int + val can_inline_recursive_functions : bool + end + + val code_id_and_symbol_scoping_checks : bool ref + val fallback_inlining_heuristic : bool ref + val inline_effects_in_cmm : bool ref + val phantom_lets : bool ref + val max_block_size_for_projections : int option ref + val max_unboxing_depth : int ref + val can_inline_recursive_functions : bool ref + end + + module Debug : sig + module Default : sig + val permute_every_name : bool + val concrete_types_only_on_canonicals : bool + end + + val permute_every_name : bool ref + val concrete_types_only_on_canonicals : bool ref + end + + module Inlining : sig + module Default : sig + val max_depth : int + val max_rec_depth : int + + val call_cost : float + val alloc_cost : float + val prim_cost : float + val branch_cost : float + val indirect_call_cost : float + val poly_compare_cost : float + + val small_function_size : int + val large_function_size : int + + val threshold : float + + val speculative_inlining_only_if_arguments_useful : bool + end + + val max_depth : Clflags.Int_arg_helper.parsed ref + val max_rec_depth : Clflags.Int_arg_helper.parsed ref + + val call_cost : Clflags.Float_arg_helper.parsed ref + val alloc_cost : Clflags.Float_arg_helper.parsed ref + val prim_cost : Clflags.Float_arg_helper.parsed ref + val branch_cost : Clflags.Float_arg_helper.parsed ref + val indirect_call_cost : Clflags.Float_arg_helper.parsed ref + val poly_compare_cost : Clflags.Float_arg_helper.parsed ref + + val small_function_size : Clflags.Int_arg_helper.parsed ref + val large_function_size : Clflags.Int_arg_helper.parsed ref + + val threshold : Clflags.Float_arg_helper.parsed ref + + val speculative_inlining_only_if_arguments_useful : bool ref + + val report_bin : bool ref + end +end + + +val set_oclassic : unit -> unit +val set_o2 : unit -> unit +val set_o3 : unit -> unit diff --git a/driver/optmaindriver.ml b/driver/optmaindriver.ml index 4eb4c02c498..f3eb2b6e271 100644 --- a/driver/optmaindriver.ml +++ b/driver/optmaindriver.ml @@ -36,7 +36,8 @@ let backend = (module Backend : Backend_intf.S) let usage = "Usage: ocamlopt \nOptions are:" -module Options = Main_args.Make_optcomp_options (Main_args.Default.Optmain) +module Options = Flambda_backend_args.Make_optcomp_options + (Flambda_backend_args.Default.Optmain) let main argv ppf ~flambda2 = native_code := true; @@ -56,6 +57,9 @@ let main argv ppf ~flambda2 = Format.pp_set_margin Format.std_formatter columns; Format.pp_set_margin Format.err_formatter columns); match + Compenv.warnings_for_discarded_params := true; + Compenv.set_extra_params + (Some Flambda_backend_args.Extra_params.read_param); Compenv.readenv ppf Before_args; Clflags.add_arguments __LOC__ (Arch.command_line_options @ Options.list); Clflags.add_arguments __LOC__ diff --git a/dune b/dune index 271f313aba9..8edbaf80d65 100644 --- a/dune +++ b/dune @@ -32,6 +32,10 @@ (copy_files# driver/optmaindriver.ml{,i}) +(copy_files# driver/flambda_backend_args.ml{,i}) + +(copy_files# driver/flambda_backend_flags.ml{,i}) + (copy_files# file_formats/cmx_format.mli) (copy_files# file_formats/linear_format.ml{,i}) @@ -247,7 +251,23 @@ ; The driver should be in here too, but is not at present. This might ; be tricky because it has a different name... ) - (libraries ocamlcommon stdlib flambda2_identifiers flambda2_cmx)) + (libraries ocamlcommon stdlib flambda_backend_common flambda2_identifiers flambda2_cmx)) + +(library + (name flambda_backend_common) + (wrapped false) + (modes byte native) + ; same flags as for ocamlcommon library + (flags ( + -nostdlib -strict-sequence -principal -absname -w +a-4-9-40-41-42-44-45-48-66 + -warn-error A -bin-annot -safe-string -strict-formats + -w -67 + ; remove -w -67 by adding the camlinternalMenhirLib hack like the Makefile + )) + (ocamlopt_flags + (:include %{project_root}/ocamlopt_flags.sexp)) + (libraries stdlib ocamlcommon) + (modules flambda_backend_args flambda_backend_flags)) (executable (name flambda_backend_main) @@ -307,6 +327,7 @@ (run %{dep:tools/merge_dot_a_files.sh} %{targets} + %{dep:flambda_backend_common.a} %{dep:middle_end/flambda2/ui/flambda2_ui.a} %{dep:middle_end/flambda2/algorithms/flambda2_algorithms.a} %{dep:middle_end/flambda2/numbers/flambda2_numbers.a} @@ -332,6 +353,7 @@ (run %{dep:tools/merge_archives.exe} %{targets} + %{dep:flambda_backend_common.cma} %{dep:middle_end/flambda2/ui/flambda2_ui.cma} %{dep:middle_end/flambda2/algorithms/flambda2_algorithms.cma} %{dep:middle_end/flambda2/numbers/flambda2_numbers.cma} @@ -357,6 +379,7 @@ (run %{dep:tools/merge_archives.exe} %{targets} + %{dep:flambda_backend_common.cmxa} %{dep:middle_end/flambda2/ui/flambda2_ui.cmxa} %{dep:middle_end/flambda2/algorithms/flambda2_algorithms.cmxa} %{dep:middle_end/flambda2/numbers/flambda2_numbers.cmxa} @@ -1239,7 +1262,18 @@ (.ocamloptcomp.objs/byte/compiler_hooks.cmt as compiler-libs/compiler_hooks.cmt) (.ocamloptcomp.objs/byte/compiler_hooks.cmti as compiler-libs/compiler_hooks.cmti) (.ocamloptcomp.objs/native/compiler_hooks.cmx as compiler-libs/compiler_hooks.cmx) - + (flambda_backend_args.mli as compiler-libs/flambda_backend_args.mli) + (.flambda_backend_common.objs/native/flambda_backend_args.cmx as compiler-libs/flambda_backend_args.cmx) + (.flambda_backend_common.objs/byte/flambda_backend_args.cmi as compiler-libs/flambda_backend_args.cmi) + (.flambda_backend_common.objs/byte/flambda_backend_args.cmo as compiler-libs/flambda_backend_args.cmo) + (.flambda_backend_common.objs/byte/flambda_backend_args.cmt as compiler-libs/flambda_backend_args.cmt) + (.flambda_backend_common.objs/byte/flambda_backend_args.cmti as compiler-libs/flambda_backend_args.cmti) + (flambda_backend_flags.mli as compiler-libs/flambda_backend_flags.mli) + (.flambda_backend_common.objs/native/flambda_backend_flags.cmx as compiler-libs/flambda_backend_flags.cmx) + (.flambda_backend_common.objs/byte/flambda_backend_flags.cmi as compiler-libs/flambda_backend_flags.cmi) + (.flambda_backend_common.objs/byte/flambda_backend_flags.cmo as compiler-libs/flambda_backend_flags.cmo) + (.flambda_backend_common.objs/byte/flambda_backend_flags.cmt as compiler-libs/flambda_backend_flags.cmt) + (.flambda_backend_common.objs/byte/flambda_backend_flags.cmti as compiler-libs/flambda_backend_flags.cmti) (printast_with_mappings.mli as compiler-libs/printast_with_mappings.mli) (.ocamloptcomp.objs/byte/printast_with_mappings.cmi as compiler-libs/printast_with_mappings.cmi) (.ocamloptcomp.objs/byte/printast_with_mappings.cmo as compiler-libs/printast_with_mappings.cmo) diff --git a/middle_end/flambda2/ui/dune b/middle_end/flambda2/ui/dune index fcab2d24202..80f602bebff 100644 --- a/middle_end/flambda2/ui/dune +++ b/middle_end/flambda2/ui/dune @@ -7,4 +7,4 @@ (:standard -principal -nostdlib)) (ocamlopt_flags (:standard -O3)) - (libraries stdlib ocamlcommon)) + (libraries stdlib ocamlcommon flambda_backend_common)) diff --git a/middle_end/flambda2/ui/flambda_features.ml b/middle_end/flambda2/ui/flambda_features.ml index a84a56bf168..6020d0d41c3 100644 --- a/middle_end/flambda2/ui/flambda_features.ml +++ b/middle_end/flambda2/ui/flambda_features.ml @@ -16,16 +16,17 @@ let flambda2_is_enabled () = Clflags.is_flambda2 () -let classic_mode () = !Clflags.Flambda2.classic_mode +let classic_mode () = !Flambda_backend_flags.Flambda2.classic_mode -let join_points () = !Clflags.Flambda2.join_points +let join_points () = !Flambda_backend_flags.Flambda2.join_points let unbox_along_intra_function_control_flow () = - !Clflags.Flambda2.unbox_along_intra_function_control_flow + !Flambda_backend_flags.Flambda2.unbox_along_intra_function_control_flow -let backend_cse_at_toplevel () = !Clflags.Flambda2.backend_cse_at_toplevel +let backend_cse_at_toplevel () = + !Flambda_backend_flags.Flambda2.backend_cse_at_toplevel -let cse_depth () = !Clflags.Flambda2.cse_depth +let cse_depth () = !Flambda_backend_flags.Flambda2.cse_depth let safe_string () = Config.safe_string @@ -38,17 +39,17 @@ let opaque () = !Clflags.opaque let float_const_prop () = !Clflags.float_const_prop let treat_invalid_code_as_unreachable () = - !Clflags.Flambda2.treat_invalid_code_as_unreachable + !Flambda_backend_flags.Flambda2.treat_invalid_code_as_unreachable let optimize_for_speed () = !Clflags.optimize_for_speed let inlining_report () = !Clflags.inlining_report -let inlining_report_bin () = !Clflags.Flambda2.Inlining.report_bin +let inlining_report_bin () = !Flambda_backend_flags.Flambda2.Inlining.report_bin let colour () = !Clflags.color -let unicode () = !Clflags.Flambda2.unicode +let unicode () = !Flambda_backend_flags.Flambda2.unicode let check_invariants () = !Clflags.flambda_invariant_checks @@ -56,19 +57,20 @@ let dump_rawflambda () = !Clflags.dump_rawflambda let dump_flambda () = !Clflags.dump_flambda -let dump_rawfexpr () = !Clflags.Flambda2.Dump.rawfexpr +let dump_rawfexpr () = !Flambda_backend_flags.Flambda2.Dump.rawfexpr -let dump_fexpr () = !Clflags.Flambda2.Dump.fexpr +let dump_fexpr () = !Flambda_backend_flags.Flambda2.Dump.fexpr -let dump_flexpect () = !Clflags.Flambda2.Dump.flexpect +let dump_flexpect () = !Flambda_backend_flags.Flambda2.Dump.flexpect -let dump_closure_offsets () = !Clflags.Flambda2.Dump.closure_offsets +let dump_closure_offsets () = + !Flambda_backend_flags.Flambda2.Dump.closure_offsets -let freshen_when_printing () = !Clflags.Flambda2.Dump.freshen +let freshen_when_printing () = !Flambda_backend_flags.Flambda2.Dump.freshen module Inlining = struct - module D = Clflags.Flambda2.Inlining.Default - module I = Clflags.Flambda2.Inlining + module D = Flambda_backend_flags.Flambda2.Inlining.Default + module I = Flambda_backend_flags.Flambda2.Inlining module IH = Clflags.Int_arg_helper module FH = Clflags.Float_arg_helper @@ -83,7 +85,8 @@ module Inlining = struct let max_rec_depth round_or_default = match round_or_default with - | Round round -> IH.get ~key:round !Clflags.Flambda2.Inlining.max_rec_depth + | Round round -> + IH.get ~key:round !Flambda_backend_flags.Flambda2.Inlining.max_rec_depth | Default -> D.max_rec_depth let call_cost round_or_default = @@ -132,32 +135,36 @@ module Inlining = struct | Default -> D.threshold let speculative_inlining_only_if_arguments_useful () = - !Clflags.Flambda2.Inlining.speculative_inlining_only_if_arguments_useful + !Flambda_backend_flags.Flambda2.Inlining + .speculative_inlining_only_if_arguments_useful end module Debug = struct - let permute_every_name () = !Clflags.Flambda2.Debug.permute_every_name + let permute_every_name () = + !Flambda_backend_flags.Flambda2.Debug.permute_every_name let concrete_types_only_on_canonicals () = - !Clflags.Flambda2.Debug.concrete_types_only_on_canonicals + !Flambda_backend_flags.Flambda2.Debug.concrete_types_only_on_canonicals end module Expert = struct let code_id_and_symbol_scoping_checks () = - !Clflags.Flambda2.Expert.code_id_and_symbol_scoping_checks + !Flambda_backend_flags.Flambda2.Expert.code_id_and_symbol_scoping_checks let fallback_inlining_heuristic () = - !Clflags.Flambda2.Expert.fallback_inlining_heuristic + !Flambda_backend_flags.Flambda2.Expert.fallback_inlining_heuristic - let inline_effects_in_cmm () = !Clflags.Flambda2.Expert.inline_effects_in_cmm + let inline_effects_in_cmm () = + !Flambda_backend_flags.Flambda2.Expert.inline_effects_in_cmm let max_block_size_for_projections () = - !Clflags.Flambda2.Expert.max_block_size_for_projections + !Flambda_backend_flags.Flambda2.Expert.max_block_size_for_projections - let phantom_lets () = !Clflags.Flambda2.Expert.phantom_lets + let phantom_lets () = !Flambda_backend_flags.Flambda2.Expert.phantom_lets - let max_unboxing_depth () = !Clflags.Flambda2.Expert.max_unboxing_depth + let max_unboxing_depth () = + !Flambda_backend_flags.Flambda2.Expert.max_unboxing_depth let can_inline_recursive_functions () = - !Clflags.Flambda2.Expert.can_inline_recursive_functions + !Flambda_backend_flags.Flambda2.Expert.can_inline_recursive_functions end diff --git a/native_toplevel/dune b/native_toplevel/dune index ad9a828f71f..7becfbf0849 100644 --- a/native_toplevel/dune +++ b/native_toplevel/dune @@ -21,6 +21,7 @@ (flags (:standard -principal -nostdlib -w -9)) (ocamlopt_flags (:include %{project_root}/ocamlopt_flags.sexp)) (libraries stdlib ocamlcommon ocamlbytecomp ocamloptcomp + flambda_backend_common flambda2_ui flambda2 dynlink_internal) (modules genprintval_native opttoploop opttopdirs opttopmain)) diff --git a/native_toplevel/opttopmain.ml b/native_toplevel/opttopmain.ml index 182e52fda47..12b04aff784 100644 --- a/native_toplevel/opttopmain.ml +++ b/native_toplevel/opttopmain.ml @@ -84,8 +84,8 @@ let wrap_expand f s = expand_position start (Array.length arr); arr -module Options = Main_args.Make_opttop_options (struct - include Main_args.Default.Opttopmain +module Options = Flambda_backend_args.Make_opttop_options (struct + include Flambda_backend_args.Default.Opttopmain let _stdin () = file_argument "" let _args = wrap_expand Arg.read_arg let _args0 = wrap_expand Arg.read_arg0 diff --git a/ocaml/boot/ocamlc b/ocaml/boot/ocamlc index cdb357901bc..36bf9c9d210 100755 Binary files a/ocaml/boot/ocamlc and b/ocaml/boot/ocamlc differ diff --git a/ocaml/driver/compenv.ml b/ocaml/driver/compenv.ml index e0cad3b2d06..7156ce46c5e 100644 --- a/ocaml/driver/compenv.ml +++ b/ocaml/driver/compenv.ml @@ -220,10 +220,20 @@ let set_compiler_pass ppf ~name v flag ~filter = (* 'can-discard=' specifies which arguments can be discarded without warning because they are not understood by some versions of OCaml. *) let can_discard = ref [] +let warnings_for_discarded_params = ref false + +let extra_params = ref None +let set_extra_params params = extra_params := params let read_one_param ppf position name v = let set name options s = setter ppf (fun b -> b) name options s in let clear name options s = setter ppf (fun b -> not b) name options s in + let handled = + match !extra_params with + | Some h -> h ppf position name v + | None -> false + in + if not handled then match name with | "g" -> set "g" [ Clflags.debug ] v | "bin-annot" -> set "bin-annot" [ Clflags.binary_annotations ] v @@ -359,112 +369,9 @@ let read_one_param ppf position name v = set "cmm-invariants" [ cmm_invariants ] v | "linscan" -> set "linscan" [ use_linscan ] v - | "ocamlcfg" -> - set "ocamlcfg" [ use_ocamlcfg ] v | "insn-sched" -> set "insn-sched" [ insn_sched ] v | "no-insn-sched" -> clear "insn-sched" [ insn_sched ] v - | "flambda2-join-points" -> - set "flambda2-join-points" - [Flambda2.join_points] v - | "no-flambda2-join-points" -> - clear "flambda2-join-points" - [Flambda2.join_points] v - | "flambda2-unbox-along-intra-function-control-flow" -> - set "flambda2-unbox-along-intra-function-control-flow" - [Flambda2.unbox_along_intra_function_control_flow] v - | "no-flambda2-unbox-along-intra-function-control-flow" -> - clear "flambda2-unbox-along-intra-function-control-flow" - [Flambda2.unbox_along_intra_function_control_flow] v - | "flambda2-backend-cse-at-toplevel" -> - set "flambda2-backend-cse-at-toplevel" - [Flambda2.backend_cse_at_toplevel] v - | "no-flambda2-backend-cse-at-toplevel" -> - clear "flambda2-backend-cse-at-toplevel" - [Flambda2.backend_cse_at_toplevel] v - | "flambda2-cse-depth" -> - int_setter ppf "flambda2-cse-depth" Flambda2.cse_depth v - | "flambda2-expert-inline-effects-in-cmm" -> - set "flambda2-expert-inline-effects-in-cmm" - [Flambda2.Expert.inline_effects_in_cmm] v - | "no-flambda2-expert-inline-effects-in-cmm" -> - clear "flambda2-expert-inline-effects-in-cmm" - [Flambda2.Expert.inline_effects_in_cmm] v - | "flambda2-expert-phantom-lets" -> - set "flambda2-expert-phantom-lets" - [Flambda2.Expert.phantom_lets] v - | "no-flambda2-expert-phantom-lets" -> - clear "flambda2-expert-phantom-lets" - [Flambda2.Expert.phantom_lets] v - | "flambda2-expert-max-unboxing-depth" -> - int_setter ppf "flambda2-expert-max-unboxing-depth" - Flambda2.Expert.max_unboxing_depth v - | "flambda2-expert-can-inline-recursive-functions" -> - set "flambda2-expert-can-inline-recursive-functions" - [Flambda2.Expert.can_inline_recursive_functions] v - | "no-flambda2-expert-can-inline-recursive-functions" -> - clear "flambda2-expert-can-inline-recursive-functions" - [Flambda2.Expert.can_inline_recursive_functions] v - | "flambda2-inline-max-depth" -> - Int_arg_helper.parse v - "Bad syntax in OCAMLPARAM for 'flambda2-inline-max-depth'" - Flambda2.Inlining.max_depth - | "flambda2-inline-max-rec-depth" -> - Int_arg_helper.parse v - "Bad syntax in OCAMLPARAM for 'flambda2-inline-max-rec-depth'" - Flambda2.Inlining.max_rec_depth - | "flambda2-inline-call-cost" -> - Float_arg_helper.parse v - "Bad syntax in OCAMLPARAM for 'flambda2-inline-call-cost'" - Flambda2.Inlining.call_cost - | "flambda2-inline-alloc-cost" -> - Float_arg_helper.parse v - "Bad syntax in OCAMLPARAM for 'flambda2-inline-alloc-cost'" - Flambda2.Inlining.alloc_cost - | "flambda2-inline-prim-cost" -> - Float_arg_helper.parse v - "Bad syntax in OCAMLPARAM for 'flambda2-inline-prim-cost'" - Flambda2.Inlining.prim_cost - | "flambda2-inline-branch-cost" -> - Float_arg_helper.parse v - "Bad syntax in OCAMLPARAM for 'flambda2-inline-branch-cost'" - Flambda2.Inlining.branch_cost - | "flambda2-inline-indirect-cost" -> - Float_arg_helper.parse v - "Bad syntax in OCAMLPARAM for 'flambda2-inline-indirect-cost'" - Flambda2.Inlining.indirect_call_cost - | "flambda2-inline-poly-compare-cost" -> - Float_arg_helper.parse v - "Bad syntax in OCAMLPARAM for 'flambda2-inline-poly-compare-cost'" - Flambda2.Inlining.poly_compare_cost - | "flambda2-inline-small-function-size" -> - Int_arg_helper.parse v - "Bad syntax in OCAMLPARAM for 'flambda2-inline-small-function-size'" - Flambda2.Inlining.small_function_size - | "flambda2-inline-large-function-size" -> - Int_arg_helper.parse v - "Bad syntax in OCAMLPARAM for 'flambda2-inline-large-function-size'" - Flambda2.Inlining.large_function_size - | "flambda2-inline-threshold" -> - Float_arg_helper.parse v - "Bad syntax in OCAMLPARAM for 'flambda2-inline-threshold'" - Flambda2.Inlining.threshold - | "flambda2-speculative-inlining-only-if-arguments-useful" -> - set "flambda2-speculative-inlining-only-if-arguments-useful" - [Flambda2.Inlining.speculative_inlining_only_if_arguments_useful] v - | "flambda2-treat-invalid-code-as-unreachable" -> - set "flambda2-treat-invalid-code-as-unreachable" - [Flambda2.treat_invalid_code_as_unreachable] v - | "no-flambda2-treat-invalid-code-as-unreachable" -> - clear "flambda2-treat-invalid-code-as-unreachable" - [Flambda2.treat_invalid_code_as_unreachable] v - | "flambda2-inlining-report-bin" -> - set "flambda2-inlining-report-bin" - [Flambda2.Inlining.report_bin] v - | "no-flambda2-inlining-report-bin" -> - clear "flambda2-inlining-report-bin" - [Flambda2.Inlining.report_bin] v - (* color output *) | "color" -> begin match color_reader.parse v with @@ -563,7 +470,8 @@ let read_one_param ppf position name v = end | _ -> - if not (List.mem name !can_discard) then begin + if !warnings_for_discarded_params && + not (List.mem name !can_discard) then begin can_discard := name :: !can_discard; Printf.ksprintf (print_error ppf) "Warning: discarding value of variable %S in OCAMLPARAM\n%!" diff --git a/ocaml/driver/compenv.mli b/ocaml/driver/compenv.mli index 93a585dc78a..845b3a88b9d 100644 --- a/ocaml/driver/compenv.mli +++ b/ocaml/driver/compenv.mli @@ -44,6 +44,16 @@ type readenv_position = Before_args | Before_compile of filename | Before_link val readenv : Format.formatter -> readenv_position -> unit +val set_extra_params : + (Format.formatter -> readenv_position -> string -> string -> bool) option -> + unit +(* Enable/disable warning about discarding any unknown arguments. *) +val warnings_for_discarded_params : bool ref + +val setter : + Format.formatter -> (bool -> 'a) -> string -> 'a ref list -> string -> unit +val int_setter : Format.formatter -> string -> int ref -> string -> unit +val check_bool : Format.formatter -> string -> string -> bool (* [is_unit_name name] returns true only if [name] can be used as a correct module name *) diff --git a/ocaml/driver/main_args.ml b/ocaml/driver/main_args.ml index 0dcb53fc199..8aa010aa6ba 100644 --- a/ocaml/driver/main_args.ml +++ b/ocaml/driver/main_args.ml @@ -328,10 +328,6 @@ let mk_linscan f = "-linscan", Arg.Unit f, " Use the linear scan register allocator" ;; -let mk_ocamlcfg f = - "-ocamlcfg", Arg.Unit f, " Use ocamlcfg" -;; - let mk_make_runtime f = "-make-runtime", Arg.Unit f, " Build a runtime system with given C objects and libraries" @@ -935,331 +931,6 @@ let mk__ f = " Treat as a file name (even if it starts with `-')" ;; -let format_default flag = if flag then " (default)" else "" -let format_not_default flag = if flag then "" else " (default)" - -module Flambda2 = Clflags.Flambda2 - -let mk_flambda2_join_points f = - "-flambda2-join-points", Arg.Unit f, - Printf.sprintf "Propagate information from all incoming edges to a join\n\ - \ point%s (Flambda 2 only)" - (format_default Flambda2.Default.join_points) -;; - -let mk_no_flambda2_join_points f = - "-no-flambda2-join-points", Arg.Unit f, - Printf.sprintf " Propagate information to a join point only if there are\n\ - \ zero or one incoming edge(s)%s (Flambda 2 only)" - (format_not_default Flambda2.Default.join_points) -;; - -let mk_flambda2_unbox_along_intra_function_control_flow f = - "-flambda2-unbox-along-intra-function-control-flow", Arg.Unit f, - Printf.sprintf " Pass values within\n\ - \ a function as unboxed where possible%s (Flambda 2 only)" - (format_default Flambda2.Default.unbox_along_intra_function_control_flow) -;; - -let mk_no_flambda2_unbox_along_intra_function_control_flow f = - "-no-flambda2-unbox-along-intra-function-control-flow", Arg.Unit f, - Printf.sprintf " Pass values within\n\ - \ a function in their normal representation%s (Flambda 2 only)" - (format_not_default - Flambda2.Default.unbox_along_intra_function_control_flow) -;; - -let mk_flambda2_backend_cse_at_toplevel f = - "-flambda2-backend-cse-at-toplevel", Arg.Unit f, - Printf.sprintf " Apply the backend CSE pass to module\n\ - \ initializers%s (Flambda 2 only)" - (format_default Flambda2.Default.backend_cse_at_toplevel) -;; - -let mk_no_flambda2_backend_cse_at_toplevel f = - "-no-flambda2-backend-cse-at-toplevel", Arg.Unit f, - Printf.sprintf " Do not apply the backend CSE pass to\n\ - \ module initializers%s (Flambda 2 only)" - (format_not_default Flambda2.Default.backend_cse_at_toplevel) -;; - -let mk_flambda2_cse_depth f = - "-flambda2-cse-depth", Arg.Int f, - Printf.sprintf " Depth threshold for eager tracking of CSE equations\n\ - \ (default %d) (Flambda 2 only)" - Flambda2.Default.cse_depth -;; - -let mk_flambda2_expert_code_id_and_symbol_scoping_checks f = - "-flambda2-expert-code-id-and-symbol-scoping-checks", Arg.Unit f, - Printf.sprintf " Perform checks on static\n\ - \ scopes of code IDs and symbols during To_cmm%s\n\ - \ (Flambda 2 only)" - (format_default Flambda2.Expert.Default.code_id_and_symbol_scoping_checks) -;; - -let mk_no_flambda2_expert_code_id_and_symbol_scoping_checks f = - "-no-flambda2-expert-code-id-and-symbol-scoping-checks", Arg.Unit f, - Printf.sprintf " Do not perform checks\n\ - \ on static scopes of code IDs and symbols during To_cmm%s\n\ - \ (Flambda 2 only)" - (format_not_default - Flambda2.Expert.Default.code_id_and_symbol_scoping_checks) -;; - -let mk_flambda2_expert_fallback_inlining_heuristic f = - "-flambda2-expert-fallback-inlining-heuristic", Arg.Unit f, - Printf.sprintf " Prevent inlining of functions\n\ - \ whose bodies contain closures%s (Flambda 2 only)" - (format_default Flambda2.Expert.Default.fallback_inlining_heuristic) -;; - -let mk_no_flambda2_expert_fallback_inlining_heuristic f = - "-no-flambda2-expert-fallback-inlining-heuristic", Arg.Unit f, - Printf.sprintf " Allow inlining of functions\n\ - \ whose bodies contain closures%s (Flambda 2 only)" - (format_not_default Flambda2.Expert.Default.fallback_inlining_heuristic) -;; - -let mk_flambda2_expert_inline_effects_in_cmm f = - "-flambda2-expert-inline-effects-in-cmm", Arg.Unit f, - Printf.sprintf " Allow inlining of effectful\n\ - \ expressions in the produced Cmm code%s (Flambda 2 only)" - (format_default Flambda2.Expert.Default.inline_effects_in_cmm) -;; - -let mk_no_flambda2_expert_inline_effects_in_cmm f = - "-no-flambda2-expert-inline-effects-in-cmm", Arg.Unit f, - Printf.sprintf " Prevent inlining of effectful\n\ - \ expressions in the produced Cmm code%s (Flambda 2 only)" - (format_not_default Flambda2.Expert.Default.inline_effects_in_cmm) -;; - -let mk_flambda2_expert_phantom_lets f = - "-flambda2-expert-phantom-lets", Arg.Unit f, - Printf.sprintf " Generate phantom lets when -g\n\ - \ is specified%s (Flambda 2 only)" - (format_default Flambda2.Expert.Default.phantom_lets) -;; - -let mk_no_flambda2_expert_phantom_lets f = - "-no-flambda2-expert-phantom-lets", Arg.Unit f, - Printf.sprintf " Do not generate phantom lets even when -g\n\ - \ is specified%s (Flambda 2 only)" - (format_not_default Flambda2.Expert.Default.phantom_lets) -;; - -let mk_flambda2_expert_max_block_size_for_projections f = - "-flambda2-expert-max-block-size-for-projections", Arg.Int f, - Printf.sprintf " Do not simplify projections\n\ - \ from blocks if the block size exceeds this value (default %s)\n\ - \ (Flambda 2 only)" - (match Flambda2.Expert.Default.max_block_size_for_projections with - | None -> "not set" - | Some max -> string_of_int max) -;; - -let mk_flambda2_expert_max_unboxing_depth f = - "-flambda2-expert-max-unboxing-depth", Arg.Int f, - Printf.sprintf " Do not unbox (nested) values deeper\n\ - \ than this many levels (default %d) (Flambda 2 only)" - Flambda2.Expert.Default.max_unboxing_depth -;; - -let mk_flambda2_expert_can_inline_recursive_functions f = - "-flambda2-expert-can-inline-recursive-functions", Arg.Unit f, - Printf.sprintf " Consider inlining\n\ - \ recursive functions (default %s) (Flambda 2 only)" - (format_default Flambda2.Expert.Default.can_inline_recursive_functions) -;; - -let mk_no_flambda2_expert_can_inline_recursive_functions f = - "-no-flambda2-expert-can-inline-recursive-functions", Arg.Unit f, - Printf.sprintf " Only inline recursive\n\ - \ functions if forced to so do by an attribute\n\ - \ (default %s) (Flambda 2 only)" - (format_not_default Flambda2.Expert.Default.can_inline_recursive_functions) -;; - -let mk_flambda2_debug_permute_every_name f = - "-flambda2-debug-permute-every-name", Arg.Unit f, - Printf.sprintf " Permute every name to test name\n\ - \ permutation code%s (Flambda 2 only)" - (format_default Flambda2.Debug.Default.permute_every_name) -;; - -let mk_no_flambda2_debug_permute_every_name f = - "-no-flambda2-debug-permute-every-name", Arg.Unit f, - Printf.sprintf " Do not permute every name to test\n\ - \ name permutation code%s (Flambda 2 only)" - (format_not_default Flambda2.Debug.Default.permute_every_name) -;; - -let mk_flambda2_debug_concrete_types_only_on_canonicals f = - "-flambda2-debug-concrete-types-only-on-canonicals", Arg.Unit f, - Printf.sprintf " Check that concrete\n\ - \ types are only assigned to canonical\n\ - \ names%s (Flambda 2 only)" - (format_default Flambda2.Debug.Default.concrete_types_only_on_canonicals) -;; - -let mk_no_flambda2_debug_concrete_types_only_on_canonicals f = - "-no-flambda2-debug-concrete-types-only-on-canonicals", Arg.Unit f, - Printf.sprintf " Do not check that\n\ - \ concrete types are only assigned to canonical\n\ - \ names%s (Flambda 2 only)" - (format_not_default - Flambda2.Debug.Default.concrete_types_only_on_canonicals) -;; - -let mk_flambda2_inline_max_depth f = - "-flambda2-inline-max-depth", Arg.String f, - Printf.sprintf "|=[,...]\n\ - \ Maximum depth of search for inlining opportunities inside\n\ - \ inlined functions (default %d) (Flambda 2 only)" - Clflags.Flambda2.Inlining.Default.max_depth -;; - -let mk_flambda2_inline_max_rec_depth f = - "-flambda2-inline-max-rec-depth", Arg.String f, - Printf.sprintf "|=[,...]\n\ - \ Maximum depth of search for inlining opportunities inside\n\ - \ inlined recursive functions (default %d) (Flambda 2 only)" - Clflags.Flambda2.Inlining.Default.max_rec_depth -;; - -let mk_flambda2_inline_cost arg descr ~default f = - Printf.sprintf "-flambda2-inline-%s-cost" arg, - Arg.String f, - Printf.sprintf "|=[,...]\n\ - \ The cost of not removing %s during inlining\n\ - \ (default %.03f, higher = more costly) (Flambda 2 only)" - descr - default -;; - -let mk_flambda2_inline_call_cost = - mk_flambda2_inline_cost "call" "a call" - ~default:Clflags.Flambda2.Inlining.Default.call_cost - -let mk_flambda2_inline_alloc_cost = - mk_flambda2_inline_cost "alloc" "an allocation" - ~default:Clflags.Flambda2.Inlining.Default.alloc_cost - -let mk_flambda2_inline_prim_cost = - mk_flambda2_inline_cost "prim" "a primitive" - ~default:Clflags.Flambda2.Inlining.Default.prim_cost - -let mk_flambda2_inline_branch_cost = - mk_flambda2_inline_cost "branch" "a conditional" - ~default:Clflags.Flambda2.Inlining.Default.branch_cost - -let mk_flambda2_inline_indirect_call_cost = - mk_flambda2_inline_cost "indirect" "an indirect call" - ~default:Clflags.Flambda2.Inlining.Default.indirect_call_cost - -let mk_flambda2_inline_poly_compare_cost = - mk_flambda2_inline_cost "poly-compare" "a polymorphic comparison" - ~default:Clflags.Flambda2.Inlining.Default.poly_compare_cost - -(* CR-someday mshinwell: We should have a check that the parameters provided by - the user are sensible, e.g. small_function_size <= large_function_size. *) - -let mk_flambda2_inline_small_function_size f = - "-flambda2-inline-small-function-size", Arg.String f, - Printf.sprintf "|=[,...]\n\ - \ Functions with a cost less than this will always be inlined\n\ - \ unless an attribute instructs otherwise (default %d)\n\ - \ (Flambda 2 only)" - Clflags.Flambda2.Inlining.Default.small_function_size -;; - -let mk_flambda2_inline_large_function_size f = - "-flambda2-inline-large-function-size", Arg.String f, - Printf.sprintf "|=[,...]\n\ - \ Functions with a cost greater than this will never be inlined\n\ - \ unless an attribute instructs otherwise (default %d); speculative\n\ - \ inlining will be disabled if equal to the small function size\n\ - \ (Flambda 2 only)" - Clflags.Flambda2.Inlining.Default.large_function_size -;; - -let mk_flambda2_inline_threshold f = - "-flambda2-inline-threshold", Arg.String f, - Printf.sprintf "|=[,...]\n\ - \ Aggressiveness of inlining (default %.02f, higher numbers mean\n\ - \ more aggressive) (Flambda 2 only)" - Clflags.Flambda2.Inlining.Default.threshold - -let mk_flambda2_speculative_inlining_only_if_arguments_useful f = - "-flambda2-speculative-inlining-only-if-arguments-useful", Arg.Unit f, - Printf.sprintf " Only\n\ - \ perform speculative inlining if the Flambda type system has\n\ - \ useful information about the argument(s) at the call site%s\n\ - \ (Flambda 2 only)" - (format_default - Flambda2.Inlining.Default.speculative_inlining_only_if_arguments_useful) - -let mk_no_flambda2_speculative_inlining_only_if_arguments_useful f = - "-no-flambda2-speculative-inlining-only-if-arguments-useful", Arg.Unit f, - Printf.sprintf " Ignore\n\ - \ whether the Flambda type system has useful information\n\ - \ about the argument(s) at the call site when performing\n\ - \ speculative inlining%s (Flambda 2 only)" - (format_not_default - Flambda2.Inlining.Default.speculative_inlining_only_if_arguments_useful) - -let mk_flambda2_treat_invalid_code_as_unreachable f = - "-flambda2-treat-invalid-code-as-unreachable", Arg.Unit f, - Printf.sprintf " Treat code deemed as\n\ - \ invalid by the Flambda 2 type system as unreachable, thus causing\n\ - \ it (and potentially calling code) to be deleted%s\n\ - \ (Flambda 2 only)" - (format_default Flambda2.Default.treat_invalid_code_as_unreachable) -;; - -let mk_no_flambda2_treat_invalid_code_as_unreachable f = - "-no-flambda2-treat-invalid-code-as-unreachable", Arg.Unit f, - Printf.sprintf " Do not treat code deemed as\n\ - \ invalid by the Flambda 2 type system as unreachable, instead\n\ - \ replacing it by a trap (which currently causes a segfault)%s\n\ - \ (Flambda 2 only)" - (format_not_default Flambda2.Default.treat_invalid_code_as_unreachable) -;; - -let mk_flambda2_inlining_report_bin f = - "-flambda2-inlining-report-bin", Arg.Unit f, " Write inlining report\n\ - \ in binary format (Flambda 2 only)" -;; - -let mk_flambda2_unicode f = - "-flambda2-unicode", Arg.Unit f, " Use Unicode output when printing\n\ - \ Flambda 2 code" -;; - -let mk_drawfexpr f = - "-drawfexpr", Arg.Unit f, " Like -drawflambda but outputs fexpr language\n\ - \ (Flambda 2 only)" -;; - -let mk_dfexpr f = - "-dfexpr", Arg.Unit f, " Like -dflambda but outputs fexpr language\n\ - \ (Flambda 2 only)" -;; - -let mk_dflexpect f = - "-dflexpect", Arg.Unit f, " Like -dflambda but outputs a .flt file\n\ - \ whose basename matches that of the input .ml file (Flambda 2 only)" -;; - -let mk_dclosure_offsets f = - "-dclosure-offsets", Arg.Unit f, " Dump closure offsets (Flambda 2 only)" -;; - -let mk_dfreshen f = - "-dfreshen", Arg.Unit f, " Freshen bound names when printing (Flambda 2 only)" -;; - module type Common_options = sig val _absname : unit -> unit val _alert : string -> unit @@ -1439,7 +1110,6 @@ module type Optcommon_options = sig val _insn_sched : unit -> unit val _no_insn_sched : unit -> unit val _linscan : unit -> unit - val _ocamlcfg : unit -> unit val _no_float_const_prop : unit -> unit val _clambda_checks : unit -> unit @@ -1470,57 +1140,6 @@ module type Optcommon_options = sig val _dlinear : unit -> unit val _dinterval : unit -> unit val _dstartup : unit -> unit - - val _flambda2_join_points : unit -> unit - val _no_flambda2_join_points : unit -> unit - val _flambda2_unbox_along_intra_function_control_flow : unit -> unit - val _no_flambda2_unbox_along_intra_function_control_flow : unit -> unit - val _flambda2_backend_cse_at_toplevel : unit -> unit - val _no_flambda2_backend_cse_at_toplevel : unit -> unit - val _flambda2_cse_depth : int -> unit - val _flambda2_expert_code_id_and_symbol_scoping_checks : unit -> unit - val _no_flambda2_expert_code_id_and_symbol_scoping_checks : unit -> unit - val _flambda2_expert_fallback_inlining_heuristic : unit -> unit - val _no_flambda2_expert_fallback_inlining_heuristic : unit -> unit - val _flambda2_expert_inline_effects_in_cmm : unit -> unit - val _no_flambda2_expert_inline_effects_in_cmm : unit -> unit - val _flambda2_expert_phantom_lets : unit -> unit - val _no_flambda2_expert_phantom_lets : unit -> unit - val _flambda2_expert_max_block_size_for_projections : int -> unit - val _flambda2_expert_max_unboxing_depth : int -> unit - val _flambda2_expert_can_inline_recursive_functions : unit -> unit - val _no_flambda2_expert_can_inline_recursive_functions : unit -> unit - val _flambda2_debug_permute_every_name : unit -> unit - val _no_flambda2_debug_permute_every_name : unit -> unit - val _flambda2_debug_concrete_types_only_on_canonicals : unit -> unit - val _no_flambda2_debug_concrete_types_only_on_canonicals : unit -> unit - - val _flambda2_inline_max_depth : string -> unit - val _flambda2_inline_max_rec_depth : string -> unit - val _flambda2_inline_call_cost : string -> unit - val _flambda2_inline_alloc_cost : string -> unit - val _flambda2_inline_prim_cost : string -> unit - val _flambda2_inline_branch_cost : string -> unit - val _flambda2_inline_indirect_call_cost : string -> unit - val _flambda2_inline_poly_compare_cost : string -> unit - val _flambda2_inline_small_function_size : string -> unit - val _flambda2_inline_large_function_size : string -> unit - val _flambda2_inline_threshold : string -> unit - val _flambda2_speculative_inlining_only_if_arguments_useful : unit -> unit - val _no_flambda2_speculative_inlining_only_if_arguments_useful : unit -> unit - - val _flambda2_inlining_report_bin : unit -> unit - - val _flambda2_unicode : unit -> unit - - val _flambda2_treat_invalid_code_as_unreachable : unit -> unit - val _no_flambda2_treat_invalid_code_as_unreachable : unit -> unit - - val _drawfexpr : unit -> unit - val _dfexpr : unit -> unit - val _dflexpect : unit -> unit - val _dclosure_offsets : unit -> unit - val _dfreshen : unit -> unit end;; module type Optcomp_options = sig @@ -1797,7 +1416,6 @@ struct mk_alias_deps F._alias_deps; mk_no_alias_deps F._no_alias_deps; mk_linscan F._linscan; - mk_ocamlcfg F._ocamlcfg; mk_app_funct F._app_funct; mk_no_app_funct F._no_app_funct; mk_no_float_const_prop F._no_float_const_prop; @@ -1858,76 +1476,6 @@ struct mk_where F._where; mk__ F.anonymous; - mk_flambda2_join_points F._flambda2_join_points; - mk_no_flambda2_join_points F._no_flambda2_join_points; - mk_flambda2_unbox_along_intra_function_control_flow - F._flambda2_unbox_along_intra_function_control_flow; - mk_no_flambda2_unbox_along_intra_function_control_flow - F._no_flambda2_unbox_along_intra_function_control_flow; - mk_flambda2_backend_cse_at_toplevel F._flambda2_backend_cse_at_toplevel; - mk_no_flambda2_backend_cse_at_toplevel - F._no_flambda2_backend_cse_at_toplevel; - mk_flambda2_cse_depth F._flambda2_cse_depth; - mk_flambda2_expert_code_id_and_symbol_scoping_checks - F._flambda2_expert_code_id_and_symbol_scoping_checks; - mk_no_flambda2_expert_code_id_and_symbol_scoping_checks - F._no_flambda2_expert_code_id_and_symbol_scoping_checks; - mk_flambda2_expert_fallback_inlining_heuristic - F._flambda2_expert_fallback_inlining_heuristic; - mk_no_flambda2_expert_fallback_inlining_heuristic - F._no_flambda2_expert_fallback_inlining_heuristic; - mk_flambda2_expert_inline_effects_in_cmm - F._flambda2_expert_inline_effects_in_cmm; - mk_no_flambda2_expert_inline_effects_in_cmm - F._no_flambda2_expert_inline_effects_in_cmm; - mk_flambda2_expert_phantom_lets - F._flambda2_expert_phantom_lets; - mk_no_flambda2_expert_phantom_lets - F._no_flambda2_expert_phantom_lets; - mk_flambda2_expert_max_block_size_for_projections - F._flambda2_expert_max_block_size_for_projections; - mk_flambda2_expert_max_unboxing_depth - F._flambda2_expert_max_unboxing_depth; - mk_flambda2_expert_can_inline_recursive_functions - F._flambda2_expert_can_inline_recursive_functions; - mk_no_flambda2_expert_can_inline_recursive_functions - F._no_flambda2_expert_can_inline_recursive_functions; - mk_flambda2_debug_permute_every_name - F._flambda2_debug_permute_every_name; - mk_no_flambda2_debug_permute_every_name - F._no_flambda2_debug_permute_every_name; - mk_flambda2_debug_concrete_types_only_on_canonicals - F._flambda2_debug_concrete_types_only_on_canonicals; - mk_no_flambda2_debug_concrete_types_only_on_canonicals - F._no_flambda2_debug_concrete_types_only_on_canonicals; - - mk_flambda2_inline_max_depth F._flambda2_inline_max_depth; - mk_flambda2_inline_max_rec_depth F._flambda2_inline_max_rec_depth; - mk_flambda2_inline_alloc_cost F._flambda2_inline_alloc_cost; - mk_flambda2_inline_branch_cost F._flambda2_inline_branch_cost; - mk_flambda2_inline_call_cost F._flambda2_inline_call_cost; - mk_flambda2_inline_prim_cost F._flambda2_inline_prim_cost; - mk_flambda2_inline_indirect_call_cost F._flambda2_inline_indirect_call_cost; - mk_flambda2_inline_poly_compare_cost F._flambda2_inline_poly_compare_cost; - mk_flambda2_inline_small_function_size - F._flambda2_inline_small_function_size; - mk_flambda2_inline_large_function_size - F._flambda2_inline_large_function_size; - mk_flambda2_inline_threshold F._flambda2_inline_threshold; - mk_flambda2_speculative_inlining_only_if_arguments_useful - F._flambda2_speculative_inlining_only_if_arguments_useful; - mk_no_flambda2_speculative_inlining_only_if_arguments_useful - F._no_flambda2_speculative_inlining_only_if_arguments_useful; - - mk_flambda2_inlining_report_bin F._flambda2_inlining_report_bin; - - mk_flambda2_unicode F._flambda2_unicode; - - mk_flambda2_treat_invalid_code_as_unreachable - F._flambda2_treat_invalid_code_as_unreachable; - mk_no_flambda2_treat_invalid_code_as_unreachable - F._no_flambda2_treat_invalid_code_as_unreachable; - mk_match_context_rows F._match_context_rows; mk_dno_unique_ids F._dno_unique_ids; mk_dunique_ids F._dunique_ids; @@ -1947,11 +1495,7 @@ struct mk_dflambda_no_invariants F._dflambda_no_invariants; mk_dflambda_let F._dflambda_let; mk_dflambda_verbose F._dflambda_verbose; - mk_drawfexpr F._drawfexpr; - mk_dfexpr F._dfexpr; - mk_dflexpect F._dflexpect; - mk_dclosure_offsets F._dclosure_offsets; - mk_dfreshen F._dfreshen; + mk_dcfg F._dcfg; mk_dcmm F._dcmm; mk_dsel F._dsel; @@ -2006,7 +1550,6 @@ module Make_opttop_options (F : Opttop_options) = struct mk_alias_deps F._alias_deps; mk_no_alias_deps F._no_alias_deps; mk_linscan F._linscan; - mk_ocamlcfg F._ocamlcfg; mk_app_funct F._app_funct; mk_no_app_funct F._no_app_funct; mk_no_float_const_prop F._no_float_const_prop; @@ -2054,82 +1597,6 @@ module Make_opttop_options (F : Opttop_options) = struct mk_color F._color; mk_error_style F._error_style; - mk_flambda2_join_points F._flambda2_join_points; - mk_no_flambda2_join_points F._no_flambda2_join_points; - mk_flambda2_unbox_along_intra_function_control_flow - F._flambda2_unbox_along_intra_function_control_flow; - mk_no_flambda2_unbox_along_intra_function_control_flow - F._no_flambda2_unbox_along_intra_function_control_flow; - mk_flambda2_backend_cse_at_toplevel F._flambda2_backend_cse_at_toplevel; - mk_no_flambda2_backend_cse_at_toplevel - F._no_flambda2_backend_cse_at_toplevel; - mk_flambda2_cse_depth F._flambda2_cse_depth; - mk_flambda2_expert_code_id_and_symbol_scoping_checks - F._flambda2_expert_code_id_and_symbol_scoping_checks; - mk_no_flambda2_expert_code_id_and_symbol_scoping_checks - F._no_flambda2_expert_code_id_and_symbol_scoping_checks; - mk_flambda2_expert_fallback_inlining_heuristic - F._flambda2_expert_fallback_inlining_heuristic; - mk_no_flambda2_expert_fallback_inlining_heuristic - F._no_flambda2_expert_fallback_inlining_heuristic; - mk_flambda2_expert_inline_effects_in_cmm - F._flambda2_expert_inline_effects_in_cmm; - mk_no_flambda2_expert_inline_effects_in_cmm - F._no_flambda2_expert_inline_effects_in_cmm; - mk_flambda2_expert_phantom_lets - F._flambda2_expert_phantom_lets; - mk_no_flambda2_expert_phantom_lets - F._no_flambda2_expert_phantom_lets; - mk_flambda2_expert_max_block_size_for_projections - F._flambda2_expert_max_block_size_for_projections; - mk_flambda2_expert_max_unboxing_depth - F._flambda2_expert_max_unboxing_depth; - mk_flambda2_expert_can_inline_recursive_functions - F._flambda2_expert_can_inline_recursive_functions; - mk_no_flambda2_expert_can_inline_recursive_functions - F._no_flambda2_expert_can_inline_recursive_functions; - mk_flambda2_debug_permute_every_name - F._flambda2_debug_permute_every_name; - mk_no_flambda2_debug_permute_every_name - F._no_flambda2_debug_permute_every_name; - mk_flambda2_debug_concrete_types_only_on_canonicals - F._flambda2_debug_concrete_types_only_on_canonicals; - mk_no_flambda2_debug_concrete_types_only_on_canonicals - F._no_flambda2_debug_concrete_types_only_on_canonicals; - - mk_flambda2_inline_max_depth F._flambda2_inline_max_depth; - mk_flambda2_inline_max_rec_depth F._flambda2_inline_max_rec_depth; - mk_flambda2_inline_alloc_cost F._flambda2_inline_alloc_cost; - mk_flambda2_inline_branch_cost F._flambda2_inline_branch_cost; - mk_flambda2_inline_call_cost F._flambda2_inline_call_cost; - mk_flambda2_inline_prim_cost F._flambda2_inline_prim_cost; - mk_flambda2_inline_indirect_call_cost F._flambda2_inline_indirect_call_cost; - mk_flambda2_inline_poly_compare_cost F._flambda2_inline_poly_compare_cost; - mk_flambda2_inline_small_function_size - F._flambda2_inline_small_function_size; - mk_flambda2_inline_large_function_size - F._flambda2_inline_large_function_size; - mk_flambda2_inline_threshold F._flambda2_inline_threshold; - mk_flambda2_speculative_inlining_only_if_arguments_useful - F._flambda2_speculative_inlining_only_if_arguments_useful; - mk_no_flambda2_speculative_inlining_only_if_arguments_useful - F._no_flambda2_speculative_inlining_only_if_arguments_useful; - - mk_flambda2_inlining_report_bin F._flambda2_inlining_report_bin; - - mk_flambda2_unicode F._flambda2_unicode; - - mk_flambda2_treat_invalid_code_as_unreachable - F._flambda2_treat_invalid_code_as_unreachable; - mk_no_flambda2_treat_invalid_code_as_unreachable - F._no_flambda2_treat_invalid_code_as_unreachable; - - mk_drawfexpr F._drawfexpr; - mk_dfexpr F._dfexpr; - mk_dflexpect F._dflexpect; - mk_dclosure_offsets F._dclosure_offsets; - mk_dfreshen F._dfreshen; - mk_dsource F._dsource; mk_dparsetree F._dparsetree; mk_dtypedtree F._dtypedtree; @@ -2390,7 +1857,6 @@ module Default = struct let _insn_sched = set insn_sched let _no_insn_sched = clear insn_sched let _linscan = set use_linscan - let _ocamlcfg = set use_ocamlcfg let _no_float_const_prop = clear float_const_prop let _no_unbox_free_vars_of_closures = clear unbox_free_vars_of_closures let _no_unbox_specialised_args = clear unbox_specialised_args @@ -2410,129 +1876,6 @@ module Default = struct let _unbox_closures = set unbox_closures let _unbox_closures_factor f = unbox_closures_factor := f let _verbose = set verbose - - let _flambda2_join_points = set Flambda2.join_points - let _no_flambda2_join_points = clear Flambda2.join_points - let _flambda2_unbox_along_intra_function_control_flow = - set Flambda2.unbox_along_intra_function_control_flow - let _no_flambda2_unbox_along_intra_function_control_flow = - clear Flambda2.unbox_along_intra_function_control_flow - let _flambda2_backend_cse_at_toplevel = - set Flambda2.backend_cse_at_toplevel - let _no_flambda2_backend_cse_at_toplevel = - clear Flambda2.backend_cse_at_toplevel - let _flambda2_cse_depth n = Flambda2.cse_depth := n - let _flambda2_expert_code_id_and_symbol_scoping_checks = - set Flambda2.Expert.code_id_and_symbol_scoping_checks - let _no_flambda2_expert_code_id_and_symbol_scoping_checks = - clear Flambda2.Expert.code_id_and_symbol_scoping_checks - let _flambda2_expert_fallback_inlining_heuristic = - set Flambda2.Expert.fallback_inlining_heuristic - let _no_flambda2_expert_fallback_inlining_heuristic = - clear Flambda2.Expert.fallback_inlining_heuristic - let _flambda2_expert_inline_effects_in_cmm = - set Flambda2.Expert.inline_effects_in_cmm - let _no_flambda2_expert_inline_effects_in_cmm = - clear Flambda2.Expert.inline_effects_in_cmm - let _flambda2_expert_phantom_lets = - set Flambda2.Expert.phantom_lets - let _no_flambda2_expert_phantom_lets = - clear Flambda2.Expert.phantom_lets - let _flambda2_expert_max_block_size_for_projections size = - Flambda2.Expert.max_block_size_for_projections := Some size - let _flambda2_expert_max_unboxing_depth depth = - Flambda2.Expert.max_unboxing_depth := depth - let _flambda2_expert_can_inline_recursive_functions () = - Flambda2.Expert.can_inline_recursive_functions := true - let _no_flambda2_expert_can_inline_recursive_functions () = - Flambda2.Expert.can_inline_recursive_functions := false - let _flambda2_debug_permute_every_name = - set Flambda2.Debug.permute_every_name - let _no_flambda2_debug_permute_every_name = - clear Flambda2.Debug.permute_every_name - let _flambda2_debug_concrete_types_only_on_canonicals = - set Flambda2.Debug.concrete_types_only_on_canonicals - let _no_flambda2_debug_concrete_types_only_on_canonicals = - clear Flambda2.Debug.concrete_types_only_on_canonicals - - let _flambda2_inline_max_depth spec = - Int_arg_helper.parse spec - "Syntax: -flambda2-inline-max-depth | =[,...]" - Flambda2.Inlining.max_depth - - let _flambda2_inline_max_rec_depth spec = - Int_arg_helper.parse spec - "Syntax: -flambda2-inline-max-rec-depth | =[,...]" - Flambda2.Inlining.max_rec_depth - let _flambda2_inline_alloc_cost spec = - Float_arg_helper.parse spec - "Syntax: -flambda2-inline-alloc-cost | =[,...]" - Flambda2.Inlining.alloc_cost - - let _flambda2_inline_branch_cost spec = - Float_arg_helper.parse spec - "Syntax: -flambda2-inline-branch-cost | =[,...]" - Flambda2.Inlining.branch_cost - - let _flambda2_inline_call_cost spec = - Float_arg_helper.parse spec - "Syntax: -flambda2-inline-call-cost | =[,...]" - Flambda2.Inlining.call_cost - - let _flambda2_inline_prim_cost spec = - Float_arg_helper.parse spec - "Syntax: -flambda2-inline-prim-cost | =[,...]" - Flambda2.Inlining.prim_cost - - let _flambda2_inline_indirect_call_cost spec = - Float_arg_helper.parse spec - "Syntax: -flambda2-inline-indirect-call-cost | \ - =[,...]" - Flambda2.Inlining.indirect_call_cost - - let _flambda2_inline_poly_compare_cost spec = - Float_arg_helper.parse spec - "Syntax: -flambda2-inline-poly-compare-cost | \ - =[,...]" - Flambda2.Inlining.poly_compare_cost - - let _flambda2_inline_small_function_size spec = - Int_arg_helper.parse spec - "Syntax: -flambda2-inline-small-function-size | \ - =[,...]" - Flambda2.Inlining.small_function_size - - let _flambda2_inline_large_function_size spec = - Int_arg_helper.parse spec - "Syntax: -flambda2-inline-large-function-size | \ - =[,...]" - Flambda2.Inlining.large_function_size - - let _flambda2_inline_threshold spec = - Float_arg_helper.parse spec - "Syntax: -flambda2-inline-threshold | =[,...]" - Flambda2.Inlining.threshold - - let _flambda2_speculative_inlining_only_if_arguments_useful = - set Flambda2.Inlining.speculative_inlining_only_if_arguments_useful - - let _no_flambda2_speculative_inlining_only_if_arguments_useful = - clear Flambda2.Inlining.speculative_inlining_only_if_arguments_useful - - let _flambda2_inlining_report_bin = set Flambda2.Inlining.report_bin - - let _flambda2_unicode = set Flambda2.unicode - - let _flambda2_treat_invalid_code_as_unreachable = - set Flambda2.treat_invalid_code_as_unreachable - let _no_flambda2_treat_invalid_code_as_unreachable = - clear Flambda2.treat_invalid_code_as_unreachable - - let _drawfexpr = set Flambda2.Dump.rawfexpr - let _dfexpr = set Flambda2.Dump.fexpr - let _dflexpect = set Flambda2.Dump.flexpect - let _dclosure_offsets = set Flambda2.Dump.closure_offsets - let _dfreshen = set Flambda2.Dump.freshen end module Compiler = struct diff --git a/ocaml/driver/main_args.mli b/ocaml/driver/main_args.mli index a0bb17d1185..a9382de39a0 100644 --- a/ocaml/driver/main_args.mli +++ b/ocaml/driver/main_args.mli @@ -194,7 +194,6 @@ module type Optcommon_options = sig val _insn_sched : unit -> unit val _no_insn_sched : unit -> unit val _linscan : unit -> unit - val _ocamlcfg : unit -> unit val _no_float_const_prop : unit -> unit val _clambda_checks : unit -> unit @@ -225,58 +224,6 @@ module type Optcommon_options = sig val _dlinear : unit -> unit val _dinterval : unit -> unit val _dstartup : unit -> unit - - val _flambda2_join_points : unit -> unit - val _no_flambda2_join_points : unit -> unit - val _flambda2_unbox_along_intra_function_control_flow : unit -> unit - val _no_flambda2_unbox_along_intra_function_control_flow : unit -> unit - val _flambda2_backend_cse_at_toplevel : unit -> unit - val _no_flambda2_backend_cse_at_toplevel : unit -> unit - val _flambda2_cse_depth : int -> unit - val _flambda2_expert_code_id_and_symbol_scoping_checks : unit -> unit - val _no_flambda2_expert_code_id_and_symbol_scoping_checks : unit -> unit - val _flambda2_expert_fallback_inlining_heuristic : unit -> unit - val _no_flambda2_expert_fallback_inlining_heuristic : unit -> unit - val _flambda2_expert_inline_effects_in_cmm : unit -> unit - val _no_flambda2_expert_inline_effects_in_cmm : unit -> unit - val _flambda2_expert_phantom_lets : unit -> unit - val _no_flambda2_expert_phantom_lets : unit -> unit - val _flambda2_expert_max_block_size_for_projections : int -> unit - val _flambda2_expert_max_unboxing_depth : int -> unit - val _flambda2_expert_can_inline_recursive_functions : unit -> unit - val _no_flambda2_expert_can_inline_recursive_functions : unit -> unit - val _flambda2_debug_permute_every_name : unit -> unit - val _no_flambda2_debug_permute_every_name : unit -> unit - val _flambda2_debug_concrete_types_only_on_canonicals : unit -> unit - val _no_flambda2_debug_concrete_types_only_on_canonicals : unit -> unit - - val _flambda2_inline_max_depth : string -> unit - val _flambda2_inline_max_rec_depth : string -> unit - val _flambda2_inline_call_cost : string -> unit - val _flambda2_inline_alloc_cost : string -> unit - val _flambda2_inline_prim_cost : string -> unit - val _flambda2_inline_branch_cost : string -> unit - val _flambda2_inline_indirect_call_cost : string -> unit - val _flambda2_inline_poly_compare_cost : string -> unit - val _flambda2_inline_small_function_size : string -> unit - val _flambda2_inline_large_function_size : string -> unit - val _flambda2_inline_threshold : string -> unit - - val _flambda2_speculative_inlining_only_if_arguments_useful : unit -> unit - val _no_flambda2_speculative_inlining_only_if_arguments_useful : unit -> unit - - val _flambda2_inlining_report_bin : unit -> unit - - val _flambda2_unicode : unit -> unit - - val _flambda2_treat_invalid_code_as_unreachable : unit -> unit - val _no_flambda2_treat_invalid_code_as_unreachable : unit -> unit - - val _drawfexpr : unit -> unit - val _dfexpr : unit -> unit - val _dflexpect : unit -> unit - val _dclosure_offsets : unit -> unit - val _dfreshen : unit -> unit end;; module type Optcomp_options = sig diff --git a/ocaml/utils/clflags.ml b/ocaml/utils/clflags.ml index 628ffc6837f..3460c4330fa 100644 --- a/ocaml/utils/clflags.ml +++ b/ocaml/utils/clflags.ml @@ -52,7 +52,6 @@ and debug = ref false (* -g *) and debug_full = ref false (* For full DWARF support *) and unsafe = ref false (* -unsafe *) and use_linscan = ref false (* -linscan *) -and use_ocamlcfg = ref false (* -ocamlcfg *) and link_everything = ref false (* -linkall *) and custom_runtime = ref false (* -custom *) and no_check_prims = ref false (* -no-check-prims *) @@ -477,253 +476,26 @@ module Compiler_ir = struct end end -module Flambda2 = struct - module Default = struct - let classic_mode = false - let join_points = false - let unbox_along_intra_function_control_flow = true - let backend_cse_at_toplevel = false - let cse_depth = 2 - let treat_invalid_code_as_unreachable = false - let unicode = true - end - - let classic_mode = ref Default.classic_mode - let join_points = ref Default.join_points - let unbox_along_intra_function_control_flow = - ref Default.unbox_along_intra_function_control_flow - let backend_cse_at_toplevel = ref Default.backend_cse_at_toplevel - let cse_depth = ref Default.cse_depth - let treat_invalid_code_as_unreachable = - ref Default.treat_invalid_code_as_unreachable - let unicode = ref Default.unicode - - module Dump = struct - let rawfexpr = ref false - let fexpr = ref false - let flexpect = ref false - let closure_offsets = ref false - let freshen = ref false - end - - module Expert = struct - module Default = struct - let code_id_and_symbol_scoping_checks = false - let fallback_inlining_heuristic = false - let inline_effects_in_cmm = false - let phantom_lets = true - let max_block_size_for_projections = None - let max_unboxing_depth = 3 - let can_inline_recursive_functions = false - end - - let code_id_and_symbol_scoping_checks = - ref Default.code_id_and_symbol_scoping_checks - let fallback_inlining_heuristic = ref Default.fallback_inlining_heuristic - let inline_effects_in_cmm = ref Default.inline_effects_in_cmm - let phantom_lets = ref Default.phantom_lets - let max_block_size_for_projections = - ref Default.max_block_size_for_projections - let max_unboxing_depth = ref Default.max_unboxing_depth - let can_inline_recursive_functions = - ref Default.can_inline_recursive_functions - end - - module Debug = struct - module Default = struct - let permute_every_name = false - let concrete_types_only_on_canonicals = false - end - - let permute_every_name = ref Default.permute_every_name - let concrete_types_only_on_canonicals = - ref Default.concrete_types_only_on_canonicals - end - - module Inlining = struct - module Default = struct - let cost_divisor = 8. - - let max_depth = 1 - let max_rec_depth = 0 - - let call_cost = 5. /. cost_divisor - let alloc_cost = 7. /. cost_divisor - let prim_cost = 3. /. cost_divisor - let branch_cost = 5. /. cost_divisor - let indirect_call_cost = 4. /. cost_divisor - let poly_compare_cost = 10. /. cost_divisor - - let small_function_size = 10 - let large_function_size = 10 - - let threshold = 10. - - let speculative_inlining_only_if_arguments_useful = true - end - - module F = Float_arg_helper - module I = Int_arg_helper - - let max_depth = ref (I.default Default.max_depth) - let max_rec_depth = ref (I.default Default.max_rec_depth) - - let call_cost = ref (F.default Default.call_cost) - let alloc_cost = ref (F.default Default.alloc_cost) - let prim_cost = ref (F.default Default.prim_cost) - let branch_cost = ref (F.default Default.branch_cost) - let indirect_call_cost = ref (F.default Default.indirect_call_cost) - let poly_compare_cost = ref (F.default Default.poly_compare_cost) - - let small_function_size = ref (I.default Default.small_function_size) - let large_function_size = ref (I.default Default.large_function_size) - - let threshold = ref (F.default Default.threshold) - - let speculative_inlining_only_if_arguments_useful = - ref Default.speculative_inlining_only_if_arguments_useful - - let report_bin = ref false - - type inlining_arguments = { - max_depth : int option; - max_rec_depth : int option; - call_cost : float option; - alloc_cost : float option; - prim_cost : float option; - branch_cost : float option; - indirect_call_cost : float option; - poly_compare_cost : float option; - small_function_size : int option; - large_function_size : int option; - threshold : float option; - } - - let use_inlining_arguments_set ?round (arg : inlining_arguments) = - let set_int = set_int_arg round in - let set_float = set_float_arg round in - set_int max_depth Default.max_depth arg.max_depth; - set_int max_rec_depth Default.max_rec_depth arg.max_rec_depth; - set_float call_cost Default.call_cost arg.call_cost; - set_float alloc_cost Default.alloc_cost arg.alloc_cost; - set_float prim_cost Default.prim_cost arg.prim_cost; - set_float branch_cost Default.branch_cost arg.branch_cost; - set_float indirect_call_cost - Default.indirect_call_cost arg.indirect_call_cost; - set_float poly_compare_cost - Default.poly_compare_cost arg.poly_compare_cost; - set_int small_function_size - Default.small_function_size arg.small_function_size; - set_int large_function_size - Default.large_function_size arg.large_function_size; - set_float threshold Default.threshold arg.threshold - - let oclassic_arguments = { - max_depth = None; - max_rec_depth = None; - call_cost = None; - alloc_cost = None; - prim_cost = None; - branch_cost = None; - indirect_call_cost = None; - poly_compare_cost = None; - (* We set the small and large function sizes to the same value here to - recover "classic mode" semantics (no speculative inlining). *) - small_function_size = Some Default.small_function_size; - large_function_size = Some Default.small_function_size; - (* [threshold] matches the current compiler's default. (The factor of - 8 in that default is accounted for by [cost_divisor], above.) *) - threshold = Some 10.; - } - - let o2_arguments = { - max_depth = Some 2; - max_rec_depth = Some 0; - call_cost = Some (2.0 *. Default.call_cost); - alloc_cost = Some (2.0 *. Default.alloc_cost); - prim_cost = Some (2.0 *. Default.prim_cost); - branch_cost = Some (2.0 *. Default.branch_cost); - indirect_call_cost = Some (2.0 *. Default.indirect_call_cost); - poly_compare_cost = Some (2.0 *. Default.poly_compare_cost); - small_function_size = Some (2 * Default.small_function_size); - large_function_size = Some (4 * Default.large_function_size); - threshold = Some 25.; - } - - let o3_arguments = { - max_depth = Some 3; - max_rec_depth = Some 0; - call_cost = Some (3.0 *. Default.call_cost); - alloc_cost = Some (3.0 *. Default.alloc_cost); - prim_cost = Some (3.0 *. Default.prim_cost); - branch_cost = Some (3.0 *. Default.branch_cost); - indirect_call_cost = Some (3.0 *. Default.indirect_call_cost); - poly_compare_cost = Some (3.0 *. Default.poly_compare_cost); - small_function_size = Some (10 * Default.small_function_size); - large_function_size = Some (50 * Default.large_function_size); - threshold = Some 100.; - } - end - - let oclassic_flags () = - classic_mode := true; - cse_depth := 2; - join_points := false; - unbox_along_intra_function_control_flow := true; - Expert.fallback_inlining_heuristic := true; - backend_cse_at_toplevel := false - - let o2_flags () = - cse_depth := 2; - join_points := false; - unbox_along_intra_function_control_flow := true; - Expert.fallback_inlining_heuristic := false; - backend_cse_at_toplevel := false - - let o3_flags () = - cse_depth := 2; - join_points := true; - unbox_along_intra_function_control_flow := true; - Expert.fallback_inlining_heuristic := false; - backend_cse_at_toplevel := false -end - let is_flambda2 () = Config.flambda2 && !native_code let set_oclassic () = - if is_flambda2 () then begin - Flambda2.Inlining.use_inlining_arguments_set - Flambda2.Inlining.oclassic_arguments; - Flambda2.oclassic_flags () - end else begin - classic_inlining := true; - default_simplify_rounds := 1; - use_inlining_arguments_set classic_arguments; - unbox_free_vars_of_closures := false; - unbox_specialised_args := false - end + classic_inlining := true; + default_simplify_rounds := 1; + use_inlining_arguments_set classic_arguments; + unbox_free_vars_of_closures := false; + unbox_specialised_args := false let set_o2 () = - if is_flambda2 () then begin - Flambda2.Inlining.use_inlining_arguments_set Flambda2.Inlining.o2_arguments; - Flambda2.o2_flags () - end else begin - default_simplify_rounds := 2; - use_inlining_arguments_set o2_arguments; - use_inlining_arguments_set ~round:0 o1_arguments - end + default_simplify_rounds := 2; + use_inlining_arguments_set o2_arguments; + use_inlining_arguments_set ~round:0 o1_arguments let set_o3 () = - if is_flambda2 () then begin - Flambda2.Inlining.use_inlining_arguments_set Flambda2.Inlining.o3_arguments; - Flambda2.o3_flags () - end else begin - 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 - end + 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 (* This is used by the -stop-after option. *) module Compiler_pass = struct diff --git a/ocaml/utils/clflags.mli b/ocaml/utils/clflags.mli index e4faad42553..ceefd047f5d 100644 --- a/ocaml/utils/clflags.mli +++ b/ocaml/utils/clflags.mli @@ -27,6 +27,7 @@ module Int_arg_helper : sig val parse_no_error : string -> parsed ref -> parse_result val get : key:int -> parsed -> int + val default : int -> parsed end (** Optimization parameters represented as floats indexed by round number. *) @@ -41,7 +42,12 @@ module Float_arg_helper : sig val parse_no_error : string -> parsed ref -> parse_result val get : key:int -> parsed -> float + val default : float -> parsed end +val set_int_arg : + int option -> Int_arg_helper.parsed ref -> int -> int option -> unit +val set_float_arg : + int option -> Float_arg_helper.parsed ref -> float -> float option -> unit val objfiles : string list ref val ccobjs : string list ref @@ -56,7 +62,6 @@ val debug : bool ref val debug_full : bool ref val unsafe : bool ref val use_linscan : bool ref -val use_ocamlcfg : bool ref val link_everything : bool ref val custom_runtime : bool ref val no_check_prims : bool ref @@ -223,106 +228,6 @@ val unboxed_types : bool ref val insn_sched : bool ref val insn_sched_default : bool -module Flambda2 : sig - module Default : sig - val classic_mode : bool - val join_points : bool - val unbox_along_intra_function_control_flow : bool - val backend_cse_at_toplevel : bool - val cse_depth : int - val treat_invalid_code_as_unreachable : bool - - val unicode : bool - end - - val classic_mode : bool ref - val join_points : bool ref - val unbox_along_intra_function_control_flow : bool ref - val backend_cse_at_toplevel : bool ref - val cse_depth : int ref - val treat_invalid_code_as_unreachable : bool ref - - val unicode : bool ref - - module Dump : sig - val rawfexpr : bool ref - val fexpr : bool ref - val flexpect : bool ref - val closure_offsets : bool ref - val freshen : bool ref - end - - module Expert : sig - module Default : sig - val code_id_and_symbol_scoping_checks : bool - val fallback_inlining_heuristic : bool - val inline_effects_in_cmm : bool - val phantom_lets : bool - val max_block_size_for_projections : int option - val max_unboxing_depth : int - val can_inline_recursive_functions : bool - end - - val code_id_and_symbol_scoping_checks : bool ref - val fallback_inlining_heuristic : bool ref - val inline_effects_in_cmm : bool ref - val phantom_lets : bool ref - val max_block_size_for_projections : int option ref - val max_unboxing_depth : int ref - val can_inline_recursive_functions : bool ref - end - - module Debug : sig - module Default : sig - val permute_every_name : bool - val concrete_types_only_on_canonicals : bool - end - - val permute_every_name : bool ref - val concrete_types_only_on_canonicals : bool ref - end - - module Inlining : sig - module Default : sig - val max_depth : int - val max_rec_depth : int - - val call_cost : float - val alloc_cost : float - val prim_cost : float - val branch_cost : float - val indirect_call_cost : float - val poly_compare_cost : float - - val small_function_size : int - val large_function_size : int - - val threshold : float - - val speculative_inlining_only_if_arguments_useful : bool - end - - val max_depth : Int_arg_helper.parsed ref - val max_rec_depth : Int_arg_helper.parsed ref - - val call_cost : Float_arg_helper.parsed ref - val alloc_cost : Float_arg_helper.parsed ref - val prim_cost : Float_arg_helper.parsed ref - val branch_cost : Float_arg_helper.parsed ref - val indirect_call_cost : Float_arg_helper.parsed ref - val poly_compare_cost : Float_arg_helper.parsed ref - - val small_function_size : Int_arg_helper.parsed ref - val large_function_size : Int_arg_helper.parsed ref - - val threshold : Float_arg_helper.parsed ref - - val speculative_inlining_only_if_arguments_useful : bool ref - - val report_bin : bool ref - end -end - val set_oclassic : unit -> unit val set_o2 : unit -> unit val set_o3 : unit -> unit