Skip to content

Commit

Permalink
flambda-backend: Revert "Move flambda-backend specific flags out of o…
Browse files Browse the repository at this point in the history 
…caml/ subdirectory (#382)" (#395)

This reverts commit b3375d3.
  • Loading branch information
@gretay-js
gretay-js authored Nov 18, 2021
1 parent d0cda93 commit d29b133
Show file tree
Hide file tree
Showing 7 changed files with 1,156 additions and 41 deletions.
Binary file modified boot/ocamlc
View file
Binary file not shown.
116 changes: 104 additions & 12 deletions driver/compenv.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -220,20 +220,10 @@ 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
Expand Down Expand Up @@ -369,9 +359,112 @@ 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
Expand Down Expand Up @@ -470,8 +563,7 @@ let read_one_param ppf position name v =
end

| _ ->
if !warnings_for_discarded_params &&
not (List.mem name !can_discard) then begin
if 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%!"
Expand Down
10 changes: 0 additions & 10 deletions driver/compenv.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,16 +44,6 @@ 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 *)
Expand Down
Loading

0 comments on commit d29b133

Please sign in to comment.