zero_alloc: refactor Translattribute.assume_zero_alloc slightly (#2148)

Refactor: explict [with_warnigns] for Translattribute.assume_zero_alloc

Author: gretay-js

ocaml/lambda/translattribute.ml

@@ -468,12 +468,15 @@ let assume_zero_alloc attributes =
   | Assume { property = Zero_alloc; _ } -> true
   | Check { property = Zero_alloc; _ } -> false
 
-let assume_zero_alloc attributes =
-  (* This function is used for "look-ahead" to find attributes
+let get_assume_zero_alloc ~with_warnings attributes =
+  if with_warnings then
+    assume_zero_alloc attributes
+  else
+    (* This function is used for "look-ahead" to find attributes
      that affect [Scoped_location] settings before translation
      of expressions in that scope.
      Warnings will be produced by [add_check_attribute]. *)
-  Warnings.without_warnings (fun () -> assume_zero_alloc attributes)
+    Warnings.without_warnings (fun () -> assume_zero_alloc attributes)
 
 let add_check_attribute expr loc attributes =
   let to_string = function

ocaml/lambda/translattribute.mli

@@ -65,4 +65,4 @@ val add_function_attributes
   -> Parsetree.attributes
   -> Lambda.lambda
 
-val assume_zero_alloc : Parsetree.attributes -> bool
+val get_assume_zero_alloc : with_warnings:bool ->  Parsetree.attributes -> bool

ocaml/lambda/translcore.ml

@@ -1363,7 +1363,9 @@ and transl_function ~in_new_scope ~scopes e alloc_mode param arg_mode arg_sort r
          | (Texp_constraint _ | Texp_coerce _ | Texp_poly _) -> attrs)
       e.exp_attributes e.exp_extra
   in
-  let assume_zero_alloc = Translattribute.assume_zero_alloc attrs in
+  let assume_zero_alloc =
+    Translattribute.get_assume_zero_alloc ~with_warnings:false attrs
+  in
   let scopes =
     if in_new_scope then begin
       if assume_zero_alloc then set_assume_zero_alloc ~scopes
@@ -1407,7 +1409,9 @@ and transl_bound_exp ~scopes ~in_structure pat sort expr loc attrs =
   let lam =
     match pat_bound_idents pat with
     | (id :: _) when should_introduce_scope ->
-      let assume_zero_alloc = Translattribute.assume_zero_alloc attrs in
+      let assume_zero_alloc =
+        Translattribute.get_assume_zero_alloc ~with_warnings:false attrs
+      in
       let scopes = enter_value_definition ~scopes ~assume_zero_alloc id in
       transl_scoped_exp ~scopes sort expr
     | _ -> transl_exp ~scopes sort expr