Add [@inline ready] attribute and remove [@inline hint] (not [@inlined hint]) (#351)

Author: mshinwell

middle_end/closure/closure.ml

@@ -785,8 +785,8 @@ let bind_params { backend; mutable_vars; _ } loc fdesc params args funct body =
 (* Check if a lambda term is ``pure'',
    that is without side-effects *and* not containing function definitions *)
 
-let warning_if_forced_inline ~loc ~attribute warning =
-  if attribute = Always_inline then
+let warning_if_forced_inlined ~loc ~attribute warning =
+  if attribute = Always_inlined then
     Location.prerr_warning (Debuginfo.Scoped_location.to_location loc)
       (Warnings.Inlining_impossible warning)
 
@@ -800,17 +800,17 @@ let fail_if_probe ~probe msg =
 
 let direct_apply env fundesc ufunct uargs ~probe ~loc ~attribute =
   match fundesc.fun_inline, attribute with
-  | _, Never_inline
+  | _, Never_inlined
   | None, _ ->
      let dbg = Debuginfo.from_location loc in
-     warning_if_forced_inline ~loc ~attribute
+     warning_if_forced_inlined ~loc ~attribute
        "Function information unavailable";
      if not fundesc.fun_closed then begin
        fail_if_probe ~probe "Not closed"
      end;
      begin match probe, attribute with
      | None, _ -> ()
-     | Some _, Never_inline -> ()
+     | Some _, Never_inlined -> ()
      | Some _, _ ->
        fail_if_probe ~probe "Erroneously marked to be inlined"
      end;
@@ -993,7 +993,7 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
                  ap_func=(Lvar funct_var);
                  ap_args=internal_args;
                  ap_tailcall=Default_tailcall;
-                 ap_inlined=Default_inline;
+                 ap_inlined=Default_inlined;
                  ap_specialised=Default_specialise;
                  ap_probe=None;
                };
@@ -1004,7 +1004,7 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
           iter first_args
             (Ulet (Immutable, Pgenval, VP.create funct_var, ufunct, new_fun))
         in
-        warning_if_forced_inline ~loc ~attribute "Partial application";
+        warning_if_forced_inlined ~loc ~attribute "Partial application";
         fail_if_probe ~probe "Partial application";
         (new_fun, approx)
 
@@ -1015,7 +1015,7 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
           let first_args = List.map (fun (id, _) -> Uvar id) first_args in
           let rem_args = List.map (fun (id, _) -> Uvar id) rem_args in
           let dbg = Debuginfo.from_location loc in
-          warning_if_forced_inline ~loc ~attribute "Over-application";
+          warning_if_forced_inlined ~loc ~attribute "Over-application";
           fail_if_probe ~probe "Over-application";
           let body =
             Ugeneric_apply(direct_apply env ~loc ~attribute
@@ -1031,7 +1031,7 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
           result, Value_unknown
       | ((ufunct, _), uargs) ->
           let dbg = Debuginfo.from_location loc in
-          warning_if_forced_inline ~loc ~attribute "Unknown function";
+          warning_if_forced_inlined ~loc ~attribute "Unknown function";
           fail_if_probe ~probe "Unknown function";
           (Ugeneric_apply(ufunct, uargs, dbg), Value_unknown)
       end
@@ -1126,7 +1126,7 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
            ap_func=funct;
            ap_args=[arg];
            ap_tailcall=Default_tailcall;
-           ap_inlined=Default_inline;
+           ap_inlined=Default_inlined;
            ap_specialised=Default_specialise;
            ap_probe=None;
          })
@@ -1374,7 +1374,7 @@ and close_functions { backend; fenv; cenv; mutable_vars } fun_defs =
           in
           let magic_scale_constant = 8. in
           int_of_float (inline_threshold *. magic_scale_constant) + n
-      | Always_inline | Hint_inline -> max_int
+      | Always_inline | Available_inline -> max_int
       | Never_inline -> min_int
       | Unroll _ -> assert false
     in

middle_end/flambda/augment_specialised_args.ml

@@ -468,7 +468,7 @@ module Make (T : S) = struct
             spec_args_bound_in_the_wrapper;
           kind = Direct (Closure_id.wrap new_fun_var);
           dbg = Debuginfo.none;
-          inline = Default_inline;
+          inlined = Default_inlined;
           specialise = Default_specialise;
           probe = None;
         }

middle_end/flambda/closure_conversion.ml

@@ -85,7 +85,7 @@ let tupled_function_call_stub original_params unboxed_version ~closure_bound_var
            redundancy here (func is also unboxed_version) *)
         kind = Direct (Closure_id.wrap unboxed_version);
         dbg = Debuginfo.none;
-        inline = Default_inline;
+        inlined = Default_inlined;
         specialise = Default_specialise;
         probe = None;
       })
@@ -240,7 +240,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
               args;
               kind = Indirect;
               dbg = Debuginfo.from_location ap_loc;
-              inline = ap_inlined;
+              inlined = ap_inlined;
               specialise = ap_specialised;
               probe = ap_probe;
             })))
@@ -425,7 +425,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
            application attributes to functions applied with the application
            operators. *)
         ap_tailcall = Default_tailcall;
-        ap_inlined = Default_inline;
+        ap_inlined = Default_inlined;
         ap_specialised = Default_specialise;
         ap_probe = None;
       }

middle_end/flambda/flambda.ml

@@ -30,7 +30,7 @@ type apply = {
   args : Variable.t list;
   kind : call_kind;
   dbg : Debuginfo.t;
-  inline : Lambda.inline_attribute;
+  inlined : Lambda.inlined_attribute;
   specialise : Lambda.specialise_attribute;
   probe : Lambda.probe;
 }
@@ -192,26 +192,26 @@ let rec lam ppf (flam : t) =
   match flam with
   | Var (id) ->
       Variable.print ppf id
-  | Apply({func; args; kind; inline; probe; dbg}) ->
+  | Apply({func; args; kind; inlined; probe; dbg}) ->
     let direct ppf () =
       match kind with
       | Indirect -> ()
       | Direct closure_id -> fprintf ppf "*[%a]" Closure_id.print closure_id
     in
-    let inline ppf () =
-      match inline with
-      | Always_inline -> fprintf ppf "<always>"
-      | Never_inline -> fprintf ppf "<never>"
-      | Hint_inline -> fprintf ppf "<hint>"
+    let inlined ppf () =
+      match inlined with
+      | Always_inlined -> fprintf ppf "<always>"
+      | Never_inlined -> fprintf ppf "<never>"
+      | Hint_inlined -> fprintf ppf "<hint>"
       | Unroll i -> fprintf ppf "<unroll %i>" i
-      | Default_inline -> ()
+      | Default_inlined -> ()
     in
     let probe ppf () =
       match probe with
       | None -> ()
       | Some {name} -> fprintf ppf "<probe %s>" name
     in
-    fprintf ppf "@[<2>(apply%a%a%a<%s>@ %a%a)@]" direct () inline () probe ()
+    fprintf ppf "@[<2>(apply%a%a%a<%s>@ %a%a)@]" direct () inlined () probe ()
       (Debuginfo.to_string dbg)
       Variable.print func Variable.print_list args
   | Assign { being_assigned; new_value; } ->
@@ -381,7 +381,8 @@ and print_function_declaration ppf var (f : function_declaration) =
   in
   let inline =
     match f.inline with
-    | Always_inline | Hint_inline -> " *inline*"
+    | Always_inline -> " *inline*"
+    | Available_inline -> " *inline_available*"
     | Never_inline -> " *never_inline*"
     | Unroll _ -> " *unroll*"
     | Default_inline -> ""
@@ -1030,11 +1031,11 @@ let create_function_declaration ~params ~body ~stub ~dbg
   begin match stub, inline with
   | true, (Never_inline | Default_inline)
   | false, (Never_inline | Default_inline
-           | Always_inline | Hint_inline | Unroll _) -> ()
-  | true, (Always_inline | Hint_inline | Unroll _) ->
+           | Always_inline | Available_inline | Unroll _) -> ()
+  | true, (Always_inline | Available_inline | Unroll _) ->
     Misc.fatal_errorf
       "Stubs may not be annotated as [Always_inline], \
-       [Hint_inline] or [Unroll]: %a"
+       [Available_inline] or [Unroll]: %a"
       print body
   end;
   begin match stub, specialise with

middle_end/flambda/flambda.mli

@@ -38,7 +38,7 @@ type apply = {
   args : Variable.t list;
   kind : call_kind;
   dbg : Debuginfo.t;
-  inline : Lambda.inline_attribute;
+  inlined : Lambda.inlined_attribute;
   (** Instructions from the source code as to whether the callee should
       be inlined. *)
   specialise : Lambda.specialise_attribute;

middle_end/flambda/flambda_invariants.ml

@@ -49,7 +49,7 @@ let ignore_set_of_closures_origin (_ : Set_of_closures_origin.t) = ()
 let ignore_closure_id (_ : Closure_id.t) = ()
 let ignore_var_within_closure (_ : Var_within_closure.t) = ()
 let ignore_tag (_ : Tag.t) = ()
-let ignore_inline_attribute (_ : Lambda.inline_attribute) = ()
+let ignore_inlined_attribute (_ : Lambda.inlined_attribute) = ()
 let ignore_specialise_attribute (_ : Lambda.specialise_attribute) = ()
 let ignore_probe (_ : Lambda.probe) = ()
 let ignore_value_kind (_ : Lambda.value_kind) = ()
@@ -186,12 +186,12 @@ let variable_and_symbol_invariants (program : Flambda.program) =
       loop (add_binding_occurrence env var) handler
     (* Everything else: *)
     | Var var -> check_variable_is_bound env var
-    | Apply { func; args; kind; dbg; inline; specialise; probe } ->
+    | Apply { func; args; kind; dbg; inlined; specialise; probe } ->
       check_variable_is_bound env func;
       check_variables_are_bound env args;
       ignore_call_kind kind;
       ignore_debuginfo dbg;
-      ignore_inline_attribute inline;
+      ignore_inlined_attribute inlined;
       ignore_specialise_attribute specialise;
       ignore_probe probe
     | Assign { being_assigned; new_value; } ->

middle_end/flambda/flambda_middle_end.ml

@@ -167,11 +167,11 @@ let lambda_to_flambda ~ppf_dump ~prefixname ~backend ~size ~filename
                loop flam
            in
            let flam = back_end flam in
-           (* Check that there aren't any unused "always inline" attributes. *)
+           (* Check that there aren't any unused "always inlined" attributes. *)
            Flambda_iterators.iter_apply_on_program flam ~f:(fun apply ->
-             match apply.inline with
-             | Default_inline | Never_inline | Hint_inline -> ()
-             | Always_inline ->
+             match apply.inlined with
+             | Default_inlined | Never_inlined | Hint_inlined -> ()
+             | Always_inlined ->
                (* CR-someday mshinwell: consider a different error message if
                   this triggers as a result of the propagation of a user's
                   attribute into the second part of an over application

middle_end/flambda/flambda_utils.ml

@@ -249,10 +249,10 @@ let toplevel_substitution sb tree =
     | Assign { being_assigned; new_value; } ->
       let new_value = sb new_value in
       Assign { being_assigned; new_value; }
-    | Apply { func; args; kind; dbg; inline; specialise; probe; } ->
+    | Apply { func; args; kind; dbg; inlined; specialise; probe; } ->
       let func = sb func in
       let args = List.map sb args in
-      Apply { func; args; kind; dbg; inline; specialise; probe; }
+      Apply { func; args; kind; dbg; inlined; specialise; probe; }
     | If_then_else (cond, e1, e2) ->
       let cond = sb cond in
       If_then_else (cond, e1, e2)
@@ -696,14 +696,14 @@ let substitute_read_symbol_field_for_variables
       bind_from_value @@
       bind_to_value @@
       Flambda.For { bound_var; from_value; to_value; direction; body }
-    | Apply { func; args; kind; dbg; inline; specialise; probe } ->
+    | Apply { func; args; kind; dbg; inlined; specialise; probe } ->
       let func, bind_func = make_var_subst func in
       let args, bind_args =
         List.split (List.map make_var_subst args)
       in
       bind_func @@
       List.fold_right (fun f expr -> f expr) bind_args @@
-      Flambda.Apply { func; args; kind; dbg; inline; specialise; probe }
+      Flambda.Apply { func; args; kind; dbg; inlined; specialise; probe }
     | Send { kind; meth; obj; args; dbg } ->
       let meth, bind_meth = make_var_subst meth in
       let obj, bind_obj = make_var_subst obj in

middle_end/flambda/inline_and_simplify.ml

@@ -673,7 +673,7 @@ and simplify_set_of_closures original_env r
 and simplify_apply env r ~(apply : Flambda.apply) : Flambda.t * R.t =
   let {
     Flambda. func = lhs_of_application; args; kind = _; dbg;
-    inline = inline_requested; specialise = specialise_requested;
+    inlined = inlined_requested; specialise = specialise_requested;
     probe = probe_requested;
   } = apply in
   let dbg = E.add_inlined_debuginfo env ~dbg in
@@ -760,16 +760,16 @@ and simplify_apply env r ~(apply : Flambda.apply) : Flambda.t * R.t =
               simplify_full_application env r ~function_decls
                 ~lhs_of_application ~closure_id_being_applied ~function_decl
                 ~value_set_of_closures ~args ~args_approxs ~dbg
-                ~inline_requested ~specialise_requested ~probe_requested
+                ~inlined_requested ~specialise_requested ~probe_requested
             else if nargs > arity then
               simplify_over_application env r ~args ~args_approxs
                 ~function_decls ~lhs_of_application ~closure_id_being_applied
-                ~function_decl ~value_set_of_closures ~dbg ~inline_requested
+                ~function_decl ~value_set_of_closures ~dbg ~inlined_requested
                 ~specialise_requested
             else if nargs > 0 && nargs < arity then
               simplify_partial_application env r ~lhs_of_application
                 ~closure_id_being_applied ~function_decl ~args ~dbg
-                ~inline_requested ~specialise_requested
+                ~inlined_requested ~specialise_requested
             else
               Misc.fatal_errorf "Function with arity %d when simplifying \
                   application expression: %a"
@@ -778,24 +778,25 @@ and simplify_apply env r ~(apply : Flambda.apply) : Flambda.t * R.t =
           wrap result, r
         | Wrong ->  (* Insufficient approximation information to simplify. *)
           Apply ({ func = lhs_of_application; args; kind = Indirect; dbg;
-                   inline = inline_requested; specialise = specialise_requested;
+                   inlined = inlined_requested;
+                   specialise = specialise_requested;
                    probe = probe_requested;
                  }),
             ret r (A.value_unknown Other)))
 
 and simplify_full_application env r ~function_decls ~lhs_of_application
       ~closure_id_being_applied ~function_decl ~value_set_of_closures ~args
-      ~args_approxs ~dbg ~inline_requested ~specialise_requested
+      ~args_approxs ~dbg ~inlined_requested ~specialise_requested
       ~probe_requested
   =
   Inlining_decision.for_call_site ~env ~r ~function_decls
     ~lhs_of_application ~closure_id_being_applied ~function_decl
     ~value_set_of_closures ~args ~args_approxs ~dbg ~simplify
-    ~inline_requested ~specialise_requested ~probe_requested
+    ~inlined_requested ~specialise_requested ~probe_requested
 
 and simplify_partial_application env r ~lhs_of_application
       ~closure_id_being_applied ~function_decl ~args ~dbg
-      ~inline_requested ~specialise_requested
+      ~inlined_requested ~specialise_requested
   =
   let arity = A.function_arity function_decl in
   assert (arity > List.length args);
@@ -805,16 +806,16 @@ and simplify_partial_application env r ~lhs_of_application
   (* CR-someday mshinwell: Pierre noted that we might like a function to be
      inlined when applied to its first set of arguments, e.g. for some kind
      of type class like thing. *)
-  begin match (inline_requested : Lambda.inline_attribute) with
-  | Always_inline | Never_inline ->
+  begin match (inlined_requested : Lambda.inlined_attribute) with
+  | Always_inlined | Never_inlined ->
     Location.prerr_warning (Debuginfo.to_location dbg)
       (Warnings.Inlining_impossible "[@inlined] attributes may not be used \
         on partial applications")
   | Unroll _ ->
     Location.prerr_warning (Debuginfo.to_location dbg)
       (Warnings.Inlining_impossible "[@unrolled] attributes may not be used \
         on partial applications")
-  | Hint_inline | Default_inline -> ()
+  | Hint_inlined | Default_inlined -> ()
   end;
   begin match (specialise_requested : Lambda.specialise_attribute) with
   | Always_specialise | Never_specialise ->
@@ -837,7 +838,7 @@ and simplify_partial_application env r ~lhs_of_application
         args = Parameter.List.vars freshened_params;
         kind = Direct closure_id_being_applied;
         dbg;
-        inline = Default_inline;
+        inlined = Default_inlined;
         specialise = Default_specialise;
         probe = None;
       }
@@ -862,7 +863,7 @@ and simplify_partial_application env r ~lhs_of_application
 
 and simplify_over_application env r ~args ~args_approxs ~function_decls
       ~lhs_of_application ~closure_id_being_applied ~function_decl
-      ~value_set_of_closures ~dbg ~inline_requested ~specialise_requested
+      ~value_set_of_closures ~dbg ~inlined_requested ~specialise_requested
   =
   let arity = A.function_arity function_decl in
   assert (arity < List.length args);
@@ -877,13 +878,13 @@ and simplify_over_application env r ~args ~args_approxs ~function_decls
     simplify_full_application env r ~function_decls ~lhs_of_application
       ~closure_id_being_applied ~function_decl ~value_set_of_closures
       ~args:full_app_args ~args_approxs:full_app_approxs ~dbg
-      ~inline_requested ~specialise_requested ~probe_requested:None
+      ~inlined_requested ~specialise_requested ~probe_requested:None
   in
   let func_var = Variable.create Internal_variable_names.full_apply in
   let expr : Flambda.t =
     Flambda.create_let func_var (Expr expr)
       (Apply { func = func_var; args = remaining_args; kind = Indirect; dbg;
-               inline = inline_requested; specialise = specialise_requested;
+               inlined = inlined_requested; specialise = specialise_requested;
                probe = None})
   in
   let expr = Lift_code.lift_lets_expr expr ~toplevel:true in

middle_end/flambda/inline_and_simplify_aux.ml

@@ -543,7 +543,7 @@ let keep_body_check ~is_classic_mode ~recursive =
         match fun_decl.inline with
         | Default_inline -> can_inline_non_rec_function fun_decl
         | Unroll factor -> factor > 0
-        | Always_inline | Hint_inline -> true
+        | Always_inline | Available_inline -> true
         | Never_inline -> false
       end
     end