Wire in the Flambda 2 inlining flags

middle_end/flambda2/compilenv_deps/flambda_features.ml

@@ -58,34 +58,34 @@ module Inlining = struct
   module F = Clflags.Float_arg_helper
 
   let max_depth ~round =
-    I.get ~key:round !Clflags.inline_max_depth
+    I.get ~key:round !Clflags.Flambda2.Inlining.max_depth
 
-  let call_cost ~round:_ = 1.0
-(*    F.get ~key:round !Clflags.inline_call_cost *)
+  let call_cost ~round =
+    F.get ~key:round !Clflags.Flambda2.Inlining.call_cost
 
-  let alloc_cost ~round:_ = 1.0
-(*     F.get ~key:round !Clflags.inline_alloc_cost *)
+  let alloc_cost ~round =
+    F.get ~key:round !Clflags.Flambda2.Inlining.alloc_cost
 
-  let prim_cost ~round:_ = 1.0
-(*    F.get ~key:round !Clflags.inline_prim_cost *)
+  let prim_cost ~round =
+    F.get ~key:round !Clflags.Flambda2.Inlining.prim_cost
 
-  let branch_cost ~round:_ = 1.0
-(*    F.get ~key:round !Clflags.inline_branch_cost *)
+  let branch_cost ~round =
+    F.get ~key:round !Clflags.Flambda2.Inlining.branch_cost
 
-  let indirect_call_cost ~round:_ = 1.0
-(*    F.get ~key:round !Clflags.inline_indirect_call_cost *)
+  let indirect_call_cost ~round =
+    F.get ~key:round !Clflags.Flambda2.Inlining.indirect_call_cost
 
-  let poly_compare_cost ~round:_ = 1.0
-(*    F.get ~key:round !Clflags.inline_poly_compare_cost *)
+  let poly_compare_cost ~round =
+    F.get ~key:round !Clflags.Flambda2.Inlining.poly_compare_cost
 
-  let small_function_size ~round:_ = 1
-(*    I.get ~key:round !Clflags.inline_small_function_size *)
+  let small_function_size ~round =
+    I.get ~key:round !Clflags.Flambda2.Inlining.small_function_size
 
-  let large_function_size ~round:_ = 10
-(*    I.get ~key:round !Clflags.inline_large_function_size *)
+  let large_function_size ~round =
+    I.get ~key:round !Clflags.Flambda2.Inlining.large_function_size
 
   let threshold ~round =
-    F.get ~key:round !Clflags.inline_threshold
+    F.get ~key:round !Clflags.Flambda2.Inlining.threshold
 end
 
 module Debug = struct

ocaml/driver/main_args.ml

@@ -1081,6 +1081,78 @@ let mk_no_flambda2_debug_concrete_types_only_on_canonicals f =
       Flambda2.Debug.Default.concrete_types_only_on_canonicals)
 ;;
 
+let mk_flambda2_inline_max_depth f =
+  "-flambda2-inline-max-depth", Arg.String f,
+  Printf.sprintf "<int>|<round>=<int>[,...]\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_cost arg descr ~default f =
+  Printf.sprintf "-flambda2-inline-%s-cost" arg,
+  Arg.String f,
+  Printf.sprintf "<float>|<round>=<float>[,...]\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 "<int>|<round>=<int>[,...]\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 "<int>|<round>=<int>[,...]\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 "<float>|<round>=<float>[,...]\n\
+        \     Aggressiveness of inlining (default %.02f, higher numbers mean\n\
+        \     more aggressive) (Flambda 2 only)"
+      Clflags.Flambda2.Inlining.Default.threshold
+;;
+
 module type Common_options = sig
   val _absname : unit -> unit
   val _alert : string -> unit
@@ -1309,6 +1381,17 @@ module type Optcommon_options = sig
   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_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
 end;;
 
 module type Optcomp_options = sig
@@ -1682,6 +1765,19 @@ struct
     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_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_match_context_rows F._match_context_rows;
     mk_dno_unique_ids F._dno_unique_ids;
     mk_dunique_ids F._dunique_ids;
@@ -1838,6 +1934,19 @@ module Make_opttop_options (F : Opttop_options) = struct
     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_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_dsource F._dsource;
     mk_dparsetree F._dparsetree;
     mk_dtypedtree F._dtypedtree;
@@ -2160,6 +2269,60 @@ module Default = struct
       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 <int> | <round>=<int>[,...]"
+        Flambda2.Inlining.max_depth
+
+    let _flambda2_inline_alloc_cost spec =
+      Float_arg_helper.parse spec
+        "Syntax: -flambda2-inline-alloc-cost <float> | <round>=<float>[,...]"
+        Flambda2.Inlining.alloc_cost
+
+    let _flambda2_inline_branch_cost spec =
+      Float_arg_helper.parse spec
+        "Syntax: -flambda2-inline-branch-cost <float> | <round>=<float>[,...]"
+        Flambda2.Inlining.branch_cost
+
+    let _flambda2_inline_call_cost spec =
+      Float_arg_helper.parse spec
+        "Syntax: -flambda2-inline-call-cost <float> | <round>=<float>[,...]"
+        Flambda2.Inlining.call_cost
+
+    let _flambda2_inline_prim_cost spec =
+      Float_arg_helper.parse spec
+        "Syntax: -flambda2-inline-prim-cost <float> | <round>=<float>[,...]"
+        Flambda2.Inlining.prim_cost
+
+    let _flambda2_inline_indirect_call_cost spec =
+      Float_arg_helper.parse spec
+        "Syntax: -flambda2-inline-indirect-call-cost <float> | \
+         <round>=<float>[,...]"
+        Flambda2.Inlining.indirect_call_cost
+
+    let _flambda2_inline_poly_compare_cost spec =
+      Float_arg_helper.parse spec
+        "Syntax: -flambda2-inline-poly-compare-cost <float> | \
+         <round>=<float>[,...]"
+        Flambda2.Inlining.poly_compare_cost
+
+    let _flambda2_inline_small_function_size spec =
+      Int_arg_helper.parse spec
+        "Syntax: -flambda2-inline-small-function-size <int> | \
+         <round>=<int>[,...]"
+        Flambda2.Inlining.small_function_size
+
+    let _flambda2_inline_large_function_size spec =
+      Int_arg_helper.parse spec
+        "Syntax: -flambda2-inline-large-function-size <int> | \
+         <round>=<int>[,...]"
+        Flambda2.Inlining.large_function_size
+
+    let _flambda2_inline_threshold spec =
+      Float_arg_helper.parse spec
+        "Syntax: -flambda2-inline-threshold <float> | <round>=<float>[,...]"
+        Flambda2.Inlining.threshold
   end
 
   module Compiler = struct

ocaml/driver/main_args.mli

@@ -243,6 +243,17 @@ module type Optcommon_options = sig
   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_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
 end;;
 
 module type Optcomp_options = sig

ocaml/utils/clflags.ml

@@ -502,6 +502,43 @@ module Flambda2 = struct
       ref Default.concrete_types_only_on_canonicals
   end
 
+  module Inlining = struct
+    module Default = struct
+      let cost_divisor = 8.
+
+      let max_depth = 1
+
+      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.
+    end
+
+    module F = Float_arg_helper
+    module I = Int_arg_helper
+
+    let max_depth = ref (I.default Default.max_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)
+  end
+
   let oclassic_flags () =
     cse_depth := 2;
     join_points := false;

ocaml/utils/clflags.mli

@@ -278,6 +278,38 @@ module Flambda2 : sig
     val concrete_types_only_on_canonicals : bool ref
   end
 
+  module Inlining : sig
+    module Default : sig
+      val max_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
+    end
+
+    val max_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
+  end
+
   val oclassic_flags : unit -> unit
   val o1_flags : unit -> unit
   val o2_flags : unit -> unit