review: rename [@TRMC] into [@tailrec_mod_constr], uppercase TRMC

lambda/translattribute.ml

@@ -39,7 +39,7 @@ let is_local_attribute = function
   | _ -> false
 
 let is_trmc_attribute = function
-  | {txt=("trmc"|"ocaml.trmc")} -> true
+  | {txt=("tailrec_mod_constr"|"ocaml.tailrec_mod_constr")} -> true
   | _ -> false
 
 let find_attribute p attributes =
@@ -255,12 +255,12 @@ let add_trmc_attribute expr loc attributes =
     | Lfunction funct ->
         if funct.attr.trmc_candidate then
             Location.prerr_warning loc
-              (Warnings.Duplicated_attribute "trmc");
+              (Warnings.Duplicated_attribute "tailrec_mod_constr");
         let attr = { funct.attr with trmc_candidate = true } in
         Lfunction { funct with attr }
     | expr ->
         Location.prerr_warning loc
-          (Warnings.Misplaced_attribute "trmc");
+          (Warnings.Misplaced_attribute "tailrec_mod_constr");
         expr
   else
     expr

lambda/trmc.ml

@@ -62,7 +62,7 @@ exception Error of Location.t * error
     Note: in this implementation, the scope of the TRMC transformation
     is a single set of mutually-recursive-declarations; TRMC applies
     to declarations of the form
-      [let[@trmc] rec f1 = t1 and .. and fn = tn in u]
+      [let[@tailrec_mod_constr] rec f1 = t1 and .. and fn = tn in u]
     and only the callsites of [f1..fn] within [t1..tn] will get
     considered for destination-passing-style transformations; callsites in [u]
     are not analyzed, and will always call the direct version (which may
@@ -578,7 +578,7 @@ let rec choice ctx t =
     end
 
   and choice_apply ctx ~tail apply =
-    let exception No_trmc in
+    let exception No_TRMC in
     try
       match apply.ap_func with
       | Lvar f ->
@@ -587,18 +587,18 @@ let rec choice ctx t =
             | Should_be_tailcall -> true
             | Default_tailcall -> false
             | Should_not_be_tailcall ->
-                (* [@tailcall false] disables trmc optimization
+                (* [@tailcall false] disables TRMC optimization
                    on this tailcall *)
-                raise No_trmc
+                raise No_TRMC
           in
           let specialized =
             try Ident.Map.find f ctx.specialized
             with Not_found ->
               if tail then
                 Location.prerr_warning
                   (Debuginfo.Scoped_location.to_location apply.ap_loc)
-                  Warnings.Trmc_breaks_tailcall;
-              raise No_trmc
+                  Warnings.TRMC_breaks_tailcall;
+              raise No_TRMC
           in
           Choice.Set {
             benefits_from_dps = true;
@@ -613,8 +613,8 @@ let rec choice ctx t =
                      });
             direct = (fun () -> Lapply apply);
           }
-      | _nontail -> raise No_trmc
-    with No_trmc -> Choice.Return (Lapply apply)
+      | _nontail -> raise No_TRMC
+    with No_TRMC -> Choice.Return (Lapply apply)
 
   and choice_makeblock ctx ~tail:_ (tag, flag, shape) blockargs loc =
     let k new_flag new_block_args =
@@ -816,7 +816,7 @@ and traverse_binding ctx (var, def) =
   | Choice.Return _ ->
       Location.prerr_warning
         (Debuginfo.Scoped_location.to_location lfun.loc)
-        Warnings.Unused_trmc_attribute;
+        Warnings.Unused_TRMC_attribute;
   end;
   let direct =
     Lfunction { lfun with body = Choice.direct cand_choice } in
@@ -844,11 +844,11 @@ let report_error ppf = function
   | Ambiguous_constructor_arguments subterms ->
       ignore subterms; (* TODO: find locations for each subterm *)
       Format.pp_print_text ppf
-        "[@trmc]: this constructor application may be trmc-transformed \
-         in several different ways. Please disambiguate by adding \
-         an explicit [@tailcall] attribute to the call that should \
-         be made tail-recursive, or a [@tailcall false] attribute \
-         on calls that should not be transformed."
+        "[@tailrec_mod_constr]: this constructor application may be \
+         TRMC-transformed in several different ways. Please \
+         disambiguate by adding an explicit [@tailcall] attribute to \
+         the call that should be made tail-recursive, or a [@tailcall \
+         false] attribute on calls that should not be transformed."
 let () =
   Location.register_error_of_exn
     (function

testsuite/tests/trmc/ambiguities.ml

@@ -8,7 +8,7 @@ type 'a tree = Leaf of 'a | Node of 'a tree * 'a tree
 |}]
 
 module Ambiguous = struct
-  let[@trmc] rec map f = function
+  let[@tailrec_mod_constr] rec map f = function
   | Leaf v -> Leaf (f v)
   | Node (left, right) ->
     Node (map f left, map f right)
@@ -17,15 +17,15 @@ end
 Line 5, characters 4-34:
 5 |     Node (map f left, map f right)
         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: [@trmc]: this constructor application may be trmc-transformed in
+Error: [@tailrec_mod_constr]: this constructor application may be trmc-transformed in
        several different ways. Please disambiguate by adding an explicit
        [@tailcall] attribute to the call that should be made tail-recursive,
        or a [@tailcall false] attribute on calls that should not be
        transformed.
 |}]
 
 module Positive_disambiguation = struct
-  let[@trmc] rec map f = function
+  let[@tailrec_mod_constr] rec map f = function
   | Leaf v -> Leaf (f v)
   | Node (left, right) ->
     Node (map f left, (map [@tailcall]) f right)
@@ -36,7 +36,7 @@ module Positive_disambiguation :
 |}]
 
 module Negative_disambiguation = struct
-  let[@trmc] rec map f = function
+  let[@tailrec_mod_constr] rec map f = function
   | Leaf v -> Leaf (f v)
   | Node (left, right) ->
     Node ((map [@tailcall false]) f left, map f right)

testsuite/tests/trmc/stack_space.ml

@@ -7,13 +7,13 @@
 let large = 1000
 
 let init n f =
-  let[@trmc] rec init_aux i n f =
+  let[@tailrec_mod_constr] rec init_aux i n f =
     if i = n then []
     else f i :: init_aux (i + 1) n f
   in init_aux 0 n f
 
 module ListMap = struct
-  let[@trmc] rec map f = function
+  let[@tailrec_mod_constr] rec map f = function
     | [] -> []
     | x :: xs ->
         (* Note: trmc guarantees that 'map f xs' is evaluated last *)
@@ -29,7 +29,7 @@ module TreeMap = struct
     | Leaf of 'a
     | Node of 'a tree * 'a tree
 
-  let[@trmc] rec map f = function
+  let[@tailrec_mod_constr] rec map f = function
     | Leaf v -> Leaf (f v)
     | Node (left, right) ->
         Node (map f left, (map [@tailcall]) f right)

testsuite/tests/trmc/usage_warnings.ml

@@ -2,7 +2,7 @@
    * expect *)
 
 (* build-up *)
-let[@trmc] rec append xs ys =
+let[@tailrec_mod_constr] rec append xs ys =
   match xs with
   | [] -> ys
   | x :: xs -> x :: append xs ys
@@ -11,32 +11,33 @@ val append : 'a list -> 'a list -> 'a list = <fun>
 |}]
 
 (* incorrect version: this cannot work *)
-let[@trmc] rec flatten = function
+let[@tailrec_mod_constr] rec flatten = function
   | [] -> []
   | xs :: xss -> append xs (flatten xss)
 [%%expect {|
 Line 3, characters 17-40:
 3 |   | xs :: xss -> append xs (flatten xss)
                      ^^^^^^^^^^^^^^^^^^^^^^^
-Warning 70: This call is in tail-position in a trmc function,
-but the function called is not itself specialized for TRMC,
-so the call will not be in tail position in the transformed version.
-Please either mark the called function with the [@trmc] attribute,
-or mark this call with the [@tailcall false] attribute to make its
-non-tailness explicit.
-Lines 1-3, characters 25-40:
-1 | .........................function
+Warning 70: This call is in tail-position in a TRMC function, but
+the function called is not itself specialized for TRMC,
+so the call will not be in tail position in the transformed
+version.
+Please either mark the called function with the
+[@tailrec_mod_constr] attribute, or mark this call with the
+[@tailcall false] attribute to make its non-tailness explicit.
+Lines 1-3, characters 39-40:
+1 | .......................................function
 2 |   | [] -> []
 3 |   | xs :: xss -> append xs (flatten xss)
-Warning 69: This function is marked for TRMC but is never applied in TRMC position.
+Warning 69: This function is marked [@tailrec_mod_constr] but is never applied in TRMC position.
 val flatten : 'a list list -> 'a list = <fun>
 |}]
 
 (* correct version *)
-let[@trmc] rec flatten = function
+let[@tailrec_mod_constr] rec flatten = function
   | [] -> []
   | xs :: xss ->
-      let[@trmc] rec append_flatten xs xss =
+      let[@tailrec_mod_constr] rec append_flatten xs xss =
         match xs with
         | [] -> flatten xss
         | x :: xs -> x :: append_flatten xs xss
@@ -46,7 +47,7 @@ val flatten : 'a list list -> 'a list = <fun>
 |}]
 
 (* incorrect version *)
-let[@trmc] rec flatten = function
+let[@tailrec_mod_constr] rec flatten = function
   | [] -> []
   | xs :: xss ->
       let rec append_flatten xs xss =
@@ -60,14 +61,15 @@ let[@trmc] rec flatten = function
 Line 10, characters 9-30:
 10 |       in append_flatten xs xss
               ^^^^^^^^^^^^^^^^^^^^^
-Warning 70: This call is in tail-position in a trmc function,
-but the function called is not itself specialized for TRMC,
-so the call will not be in tail position in the transformed version.
-Please either mark the called function with the [@trmc] attribute,
-or mark this call with the [@tailcall false] attribute to make its
-non-tailness explicit.
-Lines 1-10, characters 25-30:
- 1 | .........................function
+Warning 70: This call is in tail-position in a TRMC function, but
+the function called is not itself specialized for TRMC,
+so the call will not be in tail position in the transformed
+version.
+Please either mark the called function with the
+[@tailrec_mod_constr] attribute, or mark this call with the
+[@tailcall false] attribute to make its non-tailness explicit.
+Lines 1-10, characters 39-30:
+ 1 | .......................................function
  2 |   | [] -> []
  3 |   | xs :: xss ->
  4 |       let rec append_flatten xs xss =
@@ -77,15 +79,15 @@ Lines 1-10, characters 25-30:
  8 |             (* incorrect: this call to append_flatten is not transformed *)
  9 |             x :: append_flatten xs xss
 10 |       in append_flatten xs xss
-Warning 69: This function is marked for TRMC but is never applied in TRMC position.
+Warning 69: This function is marked [@tailrec_mod_constr] but is never applied in TRMC position.
 val flatten : 'a list list -> 'a list = <fun>
 |}]
 
 (* incorrect version: the call to append-flatten is not transformed *)
 let rec flatten = function
   | [] -> []
   | xs :: xss ->
-      let[@trmc] rec append_flatten xs xss =
+      let[@tailrec_mod_constr] rec append_flatten xs xss =
         match xs with
         | [] ->
             (* incorrect: if flatten does not have a TRMC version,
@@ -102,11 +104,12 @@ let rec flatten = function
 Line 13, characters 12-23:
 13 |             flatten xss
                  ^^^^^^^^^^^
-Warning 70: This call is in tail-position in a trmc function,
-but the function called is not itself specialized for TRMC,
-so the call will not be in tail position in the transformed version.
-Please either mark the called function with the [@trmc] attribute,
-or mark this call with the [@tailcall false] attribute to make its
-non-tailness explicit.
+Warning 70: This call is in tail-position in a TRMC function, but
+the function called is not itself specialized for TRMC,
+so the call will not be in tail position in the transformed
+version.
+Please either mark the called function with the
+[@tailrec_mod_constr] attribute, or mark this call with the
+[@tailcall false] attribute to make its non-tailness explicit.
 val flatten : 'a list list -> 'a list = <fun>
 |}]

utils/warnings.ml

@@ -92,9 +92,9 @@ type t =
   | Redefining_unit of string               (* 65 *)
   | Unused_open_bang of string              (* 66 *)
   | Unused_functor_parameter of string      (* 67 *)
-  | Invalid_trmc_attribute                  (* 68 *)
-  | Unused_trmc_attribute                   (* 69 *)
-  | Trmc_breaks_tailcall                    (* 70 *)
+  | Invalid_TRMC_attribute                  (* 68 *)
+  | Unused_TRMC_attribute                   (* 69 *)
+  | TRMC_breaks_tailcall                    (* 70 *)
 ;;
 
 (* If you remove a warning, leave a hole in the numbering.  NEVER change
@@ -173,9 +173,9 @@ let number = function
   | Redefining_unit _ -> 65
   | Unused_open_bang _ -> 66
   | Unused_functor_parameter _ -> 67
-  | Invalid_trmc_attribute -> 68
-  | Unused_trmc_attribute -> 69
-  | Trmc_breaks_tailcall -> 70
+  | Invalid_TRMC_attribute -> 68
+  | Unused_TRMC_attribute -> 69
+  | TRMC_breaks_tailcall -> 70
 ;;
 
 let last_warning_number = 70
@@ -390,7 +390,7 @@ let parse_opt errors active errflag s =
     | _ -> error ()
   in
   loop 0;
-  errors.(69) <- false (* Missed potential trmc call is not an error *)
+  errors.(69) <- false (* Missed potential TRMC call is not an error *)
 ;;
 
 let parse_options errflag s =
@@ -639,17 +639,20 @@ let message = function
          which shadows the existing one.\n\
          Hint: Did you mean 'type %s = unit'?" name
   | Unused_functor_parameter s -> "unused functor parameter " ^ s ^ "."
-  | Invalid_trmc_attribute ->
-      "Trmc attribute is only applicable on recursive function bindings."
-  | Unused_trmc_attribute ->
-      "This function is marked for TRMC but is never applied in TRMC position."
-  | Trmc_breaks_tailcall ->
-      "This call is in tail-position in a trmc function,\n\
-       but the function called is not itself specialized for TRMC,\n\
-       so the call will not be in tail position in the transformed version.\n\
-       Please either mark the called function with the [@trmc] attribute,\n\
-       or mark this call with the [@tailcall false] attribute to make its\n\
-       non-tailness explicit."
+  | Invalid_TRMC_attribute ->
+      "[@tailrec_mod_constr] attribute is only applicable on recursive \
+       function bindings."
+  | Unused_TRMC_attribute ->
+      "This function is marked [@tailrec_mod_constr] but is never \
+       applied in TRMC position."
+  | TRMC_breaks_tailcall ->
+      "This call is in tail-position in a TRMC function, but\n\
+       the function called is not itself specialized for TRMC,\n\
+       so the call will not be in tail position in the transformed\n\
+       version.\n\
+       Please either mark the called function with the\n\
+       [@tailrec_mod_constr] attribute, or mark this call with the\n\
+       [@tailcall false] attribute to make its non-tailness explicit."
 ;;
 
 let nerrors = ref 0;;
@@ -795,9 +798,9 @@ let descriptions =
    65, "Type declaration defining a new '()' constructor.";
    66, "Unused open! statement.";
    67, "Unused functor parameter.";
-   68, "Warning on non-recursive functions with @trmc attribute";
-   69, "Unused @trmc attribute";
-   70, "Warning on functions which would benefit from a @trmc attribute";
+   68, "Warning on non-recursive functions with @tailrec_mod_constr attribute";
+   69, "Unused @tailrec_mod_constr attribute";
+   70, "Warning on functions which would benefit from a @tailrec_mod_constr attribute";
   ]
 ;;
 

utils/warnings.mli

@@ -94,9 +94,9 @@ type t =
   | Redefining_unit of string               (* 65 *)
   | Unused_open_bang of string              (* 66 *)
   | Unused_functor_parameter of string      (* 67 *)
-  | Invalid_trmc_attribute                  (* 68 *)
-  | Unused_trmc_attribute                   (* 69 *)
-  | Trmc_breaks_tailcall                    (* 70 *)
+  | Invalid_TRMC_attribute                  (* 68 *)
+  | Unused_TRMC_attribute                   (* 69 *)
+  | TRMC_breaks_tailcall                    (* 70 *)
 ;;
 
 type alert = {kind:string; message:string; def:loc; use:loc}