flambda-backend: zero alloc: warning 198 about assume (#1409)

* Add warning 198

* Report warning 198 when "assume" is used unsafely on a function

"assume" is safe only on functions that are annotated with [@inline
never] and [@specialise never]

* Fix existing tests

* Add tests for warning 198 and warning 199 while we are at it

Author: gretay-js

lambda/translattribute.ml

@@ -297,24 +297,45 @@ let get_local_attribute l =
   let attr = find_attribute is_local_attribute l in
   parse_local_attribute attr
 
-let get_property_attribute l p =
+let get_property_attribute l p ~fun_attr =
   let attr = find_attribute (is_property_attribute p) l in
   let res = parse_property_attribute attr p in
   (match attr, res with
    | None, Default_check -> ()
    | _, Default_check -> ()
    | None, (Check _ | Ignore_assert_all _ ) -> assert false
    | Some _, Ignore_assert_all _ -> ()
-   | Some attr, Check _ ->
+   | Some attr, Check { assume; _ } ->
      if !Clflags.zero_alloc_check && !Clflags.native_code then
        (* The warning for unchecked functions will not trigger if the check is requested
           through the [@@@zero_alloc all] top-level annotation rather than through the
           function annotation [@zero_alloc]. *)
-       Builtin_attributes.register_property attr.attr_name);
+       if assume then begin
+         (* [attr.inline] and [attr.specialise] must be set before the
+            check for [Warnings.Misplaced_assume_attribute].
+            For attributes from the same list, it's fine because
+            [add_check_attribute] is called after
+            [add_inline_attribute] and [add_specialise_attribute].
+            The warning will spuriously fire in the following case:
+            let[@inline never][@specialise never] f =
+              fun[@zero_alloc assume] x -> ..
+         *)
+         let never_specialise =
+           if Config.flambda then
+              fun_attr.specialise = Never_specialise
+           else
+              (* closure drops [@specialise never] and never specialises *)
+              (* flambda2 does not have specialisation support yet *)
+              true
+         in
+         if not ((fun_attr.inline = Never_inline) && never_specialise) then
+          Location.prerr_warning attr.attr_name.loc
+            (Warnings.Misplaced_assume_attribute attr.attr_name.txt)
+       end
+       else
+         Builtin_attributes.register_property attr.attr_name);
    res
 
-let get_check_attribute l = get_property_attribute l Zero_alloc
-
 let get_poll_attribute l =
   let attr = find_attribute is_poll_attribute l in
   parse_poll_attribute attr
@@ -425,7 +446,7 @@ let add_check_attribute expr loc attributes =
   in
   match expr with
   | Lfunction({ attr = { stub = false } as attr; } as funct) ->
-    begin match get_check_attribute attributes with
+    begin match get_property_attribute attributes Zero_alloc ~fun_attr:attr with
     | Default_check -> expr
     | (Ignore_assert_all p | Check { property = p; _ }) as check ->
       begin match attr.check with

utils/warnings.ml

@@ -108,6 +108,7 @@ type t =
   | Unused_tmc_attribute                    (* 71 *)
   | Tmc_breaks_tailcall                     (* 72 *)
   | Probe_name_too_long of string           (* 190 *)
+  | Misplaced_assume_attribute of string    (* 198 *)
   | Unchecked_property_attribute of string  (* 199 *)
 ;;
 
@@ -192,6 +193,7 @@ let number = function
   | Unused_tmc_attribute -> 71
   | Tmc_breaks_tailcall -> 72
   | Probe_name_too_long _ -> 190
+  | Misplaced_assume_attribute _  -> 198
   | Unchecked_property_attribute _ -> 199
 ;;
 
@@ -453,6 +455,10 @@ let descriptions = [
   { number = 190;
     names = ["probe-name-too-long"];
     description = "Probe name must be at most 100 characters long." };
+  { number = 198;
+    names = ["misplaced-assume-attribute"];
+    description = "Assume of a property is ignored \
+                   if the function is inlined or specialised." };
   { number = 199;
     names = ["unchecked-property-attribute"];
     description = "A property of a function that was \
@@ -1060,6 +1066,12 @@ let message = function
       Printf.sprintf
         "This probe name is too long: `%s'. \
          Probe names must be at most 100 characters long." name
+  | Misplaced_assume_attribute property ->
+      Printf.sprintf
+        "the \"%s assume\" attribute will be ignored by the check \
+         when the function is inlined or specialised.\n\
+         Mark this function as [@inline never][@specialise never]."
+      property
   | Unchecked_property_attribute property ->
       Printf.sprintf "the %S attribute cannot be checked.\n\
       The function it is attached to was optimized away. \n\

utils/warnings.mli

@@ -111,6 +111,7 @@ type t =
   | Tmc_breaks_tailcall                     (* 72 *)
 (* Flambda_backend specific warnings: numbers should go down from 199 *)
   | Probe_name_too_long of string           (* 190 *)
+  | Misplaced_assume_attribute of string    (* 198 *)
   | Unchecked_property_attribute of string  (* 199 *)
 ;;