flambda-backend: Disable inlining of recursive functions by default (o…

…caml#372)

Co-authored-by: Mark Shinwell <mshinwell@gmail.com>

driver/compenv.ml

@@ -399,10 +399,20 @@ let read_one_param ppf position name 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'"

driver/main_args.ml

@@ -1058,6 +1058,21 @@ let mk_flambda2_expert_max_unboxing_depth f =
     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\
@@ -1097,6 +1112,14 @@ let mk_flambda2_inline_max_depth f =
     Clflags.Flambda2.Inlining.Default.max_depth
 ;;
 
+let mk_flambda2_inline_max_rec_depth f =
+  "-flambda2-inline-max-rec-depth", Arg.String f,
+  Printf.sprintf "<int>|<round>=<int>[,...]\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,
@@ -1455,12 +1478,15 @@ module type Optcommon_options = sig
   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
@@ -1849,6 +1875,10 @@ struct
       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
@@ -1859,6 +1889,7 @@ struct
       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;
@@ -2038,6 +2069,10 @@ module Make_opttop_options (F : Opttop_options) = struct
       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
@@ -2048,6 +2083,7 @@ module Make_opttop_options (F : Opttop_options) = struct
       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;
@@ -2390,6 +2426,10 @@ module Default = struct
       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 =
@@ -2404,6 +2444,10 @@ module Default = struct
         "Syntax: -flambda2-inline-max-depth <int> | <round>=<int>[,...]"
         Flambda2.Inlining.max_depth
 
+    let _flambda2_inline_max_rec_depth spec =
+      Int_arg_helper.parse spec
+        "Syntax: -flambda2-inline-max-rec-depth <int> | <round>=<int>[,...]"
+        Flambda2.Inlining.max_rec_depth
     let _flambda2_inline_alloc_cost spec =
       Float_arg_helper.parse spec
         "Syntax: -flambda2-inline-alloc-cost <float> | <round>=<float>[,...]"

driver/main_args.mli

@@ -241,12 +241,15 @@ module type Optcommon_options = sig
   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

utils/clflags.ml

@@ -496,6 +496,7 @@ module Flambda2 = struct
       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 =
@@ -506,6 +507,8 @@ module Flambda2 = struct
     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
@@ -524,6 +527,7 @@ module Flambda2 = 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
@@ -544,6 +548,7 @@ module Flambda2 = struct
     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)
@@ -564,6 +569,7 @@ module Flambda2 = struct
 
     type inlining_arguments = {
       max_depth : int option;
+      max_rec_depth : int option;
       call_cost : float option;
       alloc_cost : float option;
       prim_cost : float option;
@@ -579,6 +585,7 @@ module Flambda2 = struct
       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;
@@ -595,6 +602,7 @@ module Flambda2 = struct
 
     let oclassic_arguments = {
       max_depth = None;
+      max_rec_depth = None;
       call_cost = None;
       alloc_cost = None;
       prim_cost = None;
@@ -612,6 +620,7 @@ module Flambda2 = struct
 
     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);
@@ -625,6 +634,7 @@ module Flambda2 = struct
 
     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);

utils/clflags.mli

@@ -253,6 +253,7 @@ module Flambda2 : sig
       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
@@ -261,6 +262,7 @@ module Flambda2 : sig
     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
@@ -276,6 +278,7 @@ module Flambda2 : sig
   module Inlining : sig
     module Default : sig
       val max_depth : int
+      val max_rec_depth : int
 
       val call_cost : float
       val alloc_cost : float
@@ -293,6 +296,7 @@ module Flambda2 : sig
     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