Remove OCaml attribute aliases and the features only OCaml used

analysis/reanalyze/src/annotation.ml

@@ -83,10 +83,7 @@ let has_attribute check_text (attributes : Typedtree.attributes) =
   get_attribute_payload check_text attributes <> None
 
 let is_ocaml_suppress_dead_warning attributes =
-  match
-    attributes
-    |> get_attribute_payload (fun x -> x = "ocaml.warning" || x = "warning")
-  with
+  match attributes |> get_attribute_payload (fun x -> x = "warning") with
   | Some (StringPayload s) ->
     let numeric =
       match Str.search_forward (Str.regexp (Str.quote "-32")) s 0 with

analysis/reanalyze/src/arnold.ml

@@ -1033,12 +1033,8 @@ module Compile = struct
     | Texp_pack _ ->
       not_implemented "Texp_pack";
       assert false
-    | Texp_extension_constructor _ when true ->
-      not_implemented "Texp_extension_constructor";
-      assert false
-    | _ ->
-      (* ocaml 4.08: Texp_letop(_) | Texp_open(_) *)
-      not_implemented "Texp_letop(_) | Texp_open(_)";
+    | Texp_break | Texp_continue ->
+      not_implemented "Texp_break | Texp_continue";
       assert false
 
   and expression_opt ~ctx e_opt =

analysis/reanalyze/src/side_effects.ml

@@ -78,8 +78,6 @@ let rec expr_no_side_effects (expr : Typedtree.expression) =
   | Texp_object_set _ -> false
   | Texp_letexception (_ec, e) -> e |> expr_no_side_effects
   | Texp_pack _ -> false
-  | Texp_extension_constructor _ when true -> true
-  | _ -> (* on ocaml 4.08: Texp_letop | Texp_open *) true
 
 and expr_opt_no_side_effects eo =
   match eo with

analysis/src/process_attributes.ml

@@ -4,8 +4,7 @@ open Shared_types
 let rec find_doc_attribute attributes =
   match attributes with
   | [] -> None
-  | ({Asttypes.txt = "ocaml.doc" | "ocaml.text" | "ns.doc" | "res.doc"}, payload)
-    :: rest -> (
+  | ({Asttypes.txt = "ocaml.doc" | "ns.doc" | "res.doc"}, payload) :: rest -> (
     match Ast_payload.semantic_string_of_payload payload with
     | Some doc -> Some doc
     | None -> find_doc_attribute rest)

changes/remove-ocaml-attribute-aliases.breaking.md

@@ -0,0 +1 @@
+- Remove the OCaml attribute spellings `@ocaml.deprecated`, `@ocaml.unboxed`, `@ocaml.immediate`, `@ocaml.warnerror`, `@ocaml.warning`, `@ocaml.ppwarning`, `@ocaml.boxed`, `@ocaml.deprecated_mutable`, `@ocaml.text` and `%ocaml.error`, and the `%extension_constructor` extension. `@boxed` and `@deprecated_mutable` are no longer interpreted and are ignored. PPX output keeps working: the PPX bridge renames `ocaml.warning`, `ocaml.ppwarning` and `ocaml.error` to the bare names.

compiler/core/cmd_ppx_apply.ml

@@ -108,6 +108,7 @@ let apply_rewriters_str ~tool_name ast =
       Ml_binary.ast0_roundtrip Ml_binary.Ml ast
     else ast
   | ppxs ->
+    Bs_ast_invariant.check_removed_ocaml_spellings_on_structure ast;
     ast
     |> Ast_mapper.add_ppx_context_str ~tool_name
     |> rewrite Ml ppxs |> Ml_binary.ast0_to_structure
@@ -120,6 +121,7 @@ let apply_rewriters_sig ~tool_name ast =
       Ml_binary.ast0_roundtrip Ml_binary.Mli ast
     else ast
   | ppxs ->
+    Bs_ast_invariant.check_removed_ocaml_spellings_on_signature ast;
     ast
     |> Ast_mapper.add_ppx_context_sig ~tool_name
     |> rewrite Mli ppxs |> Ml_binary.ast0_to_signature

compiler/ext/config.ml

@@ -1,4 +1,4 @@
-let cmi_magic_number = "Caml1999I038"
+let cmi_magic_number = "Caml1999I039"
 
 (* Magic numbers for marshaled values of the *current* parsetree, whose layout
    changes across compiler versions. *)
@@ -13,7 +13,7 @@ and ast0_impl_magic_number = "Caml1999M022"
 
 and ast0_intf_magic_number = "Caml1999N022"
 
-and cmt_magic_number = "Caml1999T046"
+and cmt_magic_number = "Caml1999T047"
 
 let get_load_path () = (Compiler_request_state.current ()).load_path
 let set_load_path path = (Compiler_request_state.current ()).load_path <- path

compiler/frontend/bs_ast_invariant.ml

@@ -33,7 +33,34 @@ let is_checked_attribute txt =
     true
   | _ -> false
 
-let warn_unused_attribute ((({txt; loc} as sloc), _) : Parsetree.attribute) =
+(* OCaml spellings of builtin attributes the compiler used to accept. *)
+let removed_ocaml_attribute txt =
+  match txt with
+  | "ocaml.deprecated" -> Some "use `@deprecated` instead."
+  | "ocaml.unboxed" -> Some "use `@unboxed` instead."
+  | "ocaml.immediate" -> Some "use `@immediate` instead."
+  | "ocaml.warnerror" -> Some "use `@warnerror` instead."
+  | "ocaml.boxed" -> Some "remove it: types are boxed unless marked `@unboxed`."
+  | "ocaml.deprecated_mutable" -> Some "remove it."
+  | "ocaml.text" -> Some "use a doc comment instead."
+  | "ocaml.warning" -> Some "use `@warning` instead."
+  | "ocaml.ppwarning" -> Some "use `@ppwarning` instead."
+  | _ -> None
+
+let check_removed_ocaml_attribute (({txt; loc}, _) : Parsetree.attribute) =
+  match removed_ocaml_attribute txt with
+  | Some hint ->
+    Location.raise_errorf ~loc "`@%s` is no longer supported, %s" txt hint
+  | None -> ()
+
+let check_removed_ocaml_extension (({txt; loc}, _) : Parsetree.extension) =
+  if txt = "ocaml.error" then
+    Location.raise_errorf ~loc
+      "`%%ocaml.error` is no longer supported, use `%%error` instead."
+
+let warn_unused_attribute
+    ((({txt; loc} as sloc), _) as attr : Parsetree.attribute) =
+  check_removed_ocaml_attribute attr;
   if
     is_checked_attribute txt && (not loc.loc_ghost)
     && not (Used_attributes.is_used_attribute sloc)
@@ -71,6 +98,10 @@ let emit_external_warnings : iterator =
             "built-in type `%s` can not be redefined " txt;
         super.type_declaration self ptyp);
     attribute = (fun _ attr -> warn_unused_attribute attr);
+    extension =
+      (fun self ext ->
+        check_removed_ocaml_extension ext;
+        super.extension self ext);
     structure_item =
       (fun self str_item ->
         match str_item.pstr_desc with
@@ -85,7 +116,9 @@ let emit_external_warnings : iterator =
     expr =
       (fun self ({pexp_loc = loc} as a) ->
         match a.pexp_desc with
-        | Pexp_constant const -> check_constant loc const
+        | Pexp_constant const ->
+          check_constant loc const;
+          self.attributes self a.pexp_attributes
         | _ -> super.expr self a);
     label_declaration =
       (fun self lbl ->
@@ -136,7 +169,9 @@ let emit_external_warnings : iterator =
     pat =
       (fun self (pat : Parsetree.pattern) ->
         match pat.ppat_desc with
-        | Ppat_constant constant -> check_constant pat.ppat_loc constant
+        | Ppat_constant constant ->
+          check_constant pat.ppat_loc constant;
+          self.attributes self pat.ppat_attributes
         | _ -> super.pat self pat);
   }
 
@@ -165,3 +200,25 @@ let emit_external_warnings_on_structure (stru : Parsetree.structure) =
 
 let emit_external_warnings_on_signature (sigi : Parsetree.signature) =
   emit_external_warnings.signature emit_external_warnings sigi
+
+(* The PPX bridge renames the [ocaml.]-prefixed builtins a PPX emits to their
+   bare names, so source written with them is checked before it reaches the
+   bridge. *)
+let removed_ocaml_spellings : iterator =
+  {
+    super with
+    attribute =
+      (fun self attr ->
+        check_removed_ocaml_attribute attr;
+        super.attribute self attr);
+    extension =
+      (fun self ext ->
+        check_removed_ocaml_extension ext;
+        super.extension self ext);
+  }
+
+let check_removed_ocaml_spellings_on_structure (stru : Parsetree.structure) =
+  removed_ocaml_spellings.structure removed_ocaml_spellings stru
+
+let check_removed_ocaml_spellings_on_signature (sigi : Parsetree.signature) =
+  removed_ocaml_spellings.signature removed_ocaml_spellings sigi

compiler/frontend/bs_ast_invariant.mli

@@ -37,3 +37,9 @@ val iter_warnings_on_sigi : Parsetree.signature -> unit
 val emit_external_warnings_on_structure : Parsetree.structure -> unit
 
 val emit_external_warnings_on_signature : Parsetree.signature -> unit
+
+val check_removed_ocaml_spellings_on_structure : Parsetree.structure -> unit
+(** Reject the [ocaml.]-prefixed builtin attributes and extensions that are no
+    longer supported. Run on source before external PPXs see it. *)
+
+val check_removed_ocaml_spellings_on_signature : Parsetree.signature -> unit

compiler/ml/ast_mapper.ml

@@ -640,7 +640,7 @@ let default_mapper =
   }
 
 let rec extension_of_error {loc; msg; if_highlight; sub} =
-  ( {loc; txt = "ocaml.error"},
+  ( {loc; txt = "error"},
     PStr
       ([
          Str.eval (Exp.constant (Const.string msg));

compiler/ml/ast_mapper.mli

@@ -99,7 +99,7 @@ val default_mapper : mapper
 (** {1 Convenience functions to write mappers} *)
 
 val extension_of_error : Location.error -> extension
-(** Encode an error into an 'ocaml.error' extension node which can be
+(** Encode an error into an 'error' extension node which can be
     inserted in a generated Parsetree.  The compiler will be
     responsible for reporting the error. *)
 

compiler/ml/ast_mapper_from0.ml

@@ -226,6 +226,16 @@ let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt}
 let record_rest_attr_name = "_res.record_rest"
 let constructor_args_attr_name = "_res.constructor_args"
 
+(* PPXs built on OCaml tooling spell builtin attributes and extensions with an
+   [ocaml.] prefix: ppxlib reports errors as [%ocaml.error] and lint warnings
+   as [@@@ocaml.ppwarning]. The compiler reads only the bare names. *)
+let bare_builtin_name (name : string Location.loc) =
+  match name.txt with
+  | "ocaml.error" -> {name with txt = "error"}
+  | "ocaml.warning" -> {name with txt = "warning"}
+  | "ocaml.ppwarning" -> {name with txt = "ppwarning"}
+  | _ -> name
+
 let has_explicit_arity_attr (attrs : Pt.attributes) =
   List.exists
     (function
@@ -1669,8 +1679,10 @@ let default_mapper =
             | None -> this.payload this payload
           else this.payload this payload
         in
-        (map_loc this s, payload));
-    attribute = (fun this (s, e) -> (map_loc this s, this.payload this e));
+        (map_loc this (bare_builtin_name s), payload));
+    attribute =
+      (fun this (s, e) ->
+        (map_loc this (bare_builtin_name s), this.payload this e));
     attributes = (fun this l -> List.map (this.attribute this) l);
     payload =
       (fun this -> function

compiler/ml/builtin_attributes.ml

@@ -25,7 +25,7 @@ let string_of_opt_payload p =
 
 let rec error_of_extension ext =
   match ext with
-  | {txt = ("ocaml.error" | "error") as txt; loc}, p -> (
+  | {txt = "error" as txt; loc}, p -> (
     let rec sub_from inner =
       match inner with
       | {pstr_desc = Pstr_extension (ext, _)} :: rest ->
@@ -59,8 +59,7 @@ let cat s1 s2 =
 
 let rec deprecated_of_attrs = function
   | [] -> None
-  | ({txt = "ocaml.deprecated" | "deprecated"; _}, p) :: _ ->
-    Some (string_of_opt_payload p)
+  | ({txt = "deprecated"; _}, p) :: _ -> Some (string_of_opt_payload p)
   | _ :: tl -> deprecated_of_attrs tl
 
 let rec deprecated_of_attrs_with_migrate = function
@@ -102,8 +101,6 @@ let rec deprecated_of_attrs_with_migrate = function
         Some (reason, migration_template, migration_in_pipe_chain_template)
       | None -> None)
     | _ -> Some (string_of_opt_payload payload, None, None))
-  | ({txt = "ocaml.deprecated"; _}, p) :: _ ->
-    Some (string_of_opt_payload p, None, None)
   | _ :: tl -> deprecated_of_attrs_with_migrate tl
 
 let check_deprecated ?deprecated_context loc attrs s =
@@ -124,27 +121,6 @@ let check_deprecated_inclusion ~def ~use loc attrs1 attrs2 s =
   | None, _ | Some _, Some _ -> ()
   | Some txt, None -> Location.deprecated ~def ~use loc (cat s txt)
 
-let rec deprecated_mutable_of_attrs = function
-  | [] -> None
-  | ({txt = "ocaml.deprecated_mutable" | "deprecated_mutable"; _}, p) :: _ ->
-    Some (string_of_opt_payload p)
-  | _ :: tl -> deprecated_mutable_of_attrs tl
-
-let check_deprecated_mutable loc attrs s =
-  match deprecated_mutable_of_attrs attrs with
-  | None -> ()
-  | Some txt ->
-    Location.deprecated loc (Printf.sprintf "mutating field %s" (cat s txt))
-
-let check_deprecated_mutable_inclusion ~def ~use loc attrs1 attrs2 s =
-  match
-    (deprecated_mutable_of_attrs attrs1, deprecated_mutable_of_attrs attrs2)
-  with
-  | None, _ | Some _, Some _ -> ()
-  | Some txt, None ->
-    Location.deprecated ~def ~use loc
-      (Printf.sprintf "mutating field %s" (cat s txt))
-
 let rec deprecated_of_sig = function
   | {psig_desc = Psig_attribute a} :: tl -> (
     match deprecated_of_attrs [a] with
@@ -172,12 +148,9 @@ let warning_attribute ?(ppwarning = true) =
         (Warnings.Attribute_payload (txt, "A single string literal is expected"))
   in
   function
-  | {txt = ("ocaml.warning" | "warning") as txt; loc}, payload ->
-    process loc txt false payload
-  | {txt = ("ocaml.warnerror" | "warnerror") as txt; loc}, payload ->
-    process loc txt true payload
-  | {txt = "ocaml.ppwarning" | "ppwarning"}, (PStr [{pstr_loc; _}] as payload)
-    when ppwarning -> (
+  | {txt = "warning" as txt; loc}, payload -> process loc txt false payload
+  | {txt = "warnerror" as txt; loc}, payload -> process loc txt true payload
+  | {txt = "ppwarning"}, (PStr [{pstr_loc; _}] as payload) when ppwarning -> (
     match string_of_payload payload with
     | Some s -> Location.prerr_warning pstr_loc (Warnings.Preprocessor s)
     | None -> ())
@@ -196,25 +169,15 @@ let warning_scope ?ppwarning attrs f =
 
 let warn_on_literal_pattern =
   List.exists (function
-    | {txt = "ocaml.warn_on_literal_pattern" | "warn_on_literal_pattern"; _}, _
-      ->
-      true
+    | {txt = "warn_on_literal_pattern"; _}, _ -> true
     | _ -> false)
 
 let immediate =
   List.exists (function
-    | {txt = "ocaml.immediate" | "immediate"; _}, _ -> true
+    | {txt = "immediate"; _}, _ -> true
     | _ -> false)
 
-(* The "ocaml.boxed (default)" and "ocaml.unboxed (default)"
-   attributes cannot be input by the user, they are added by the
-   compiler when applying the default setting. This is done to record
-   in the .cmi the default used by the compiler when compiling the
-   source file because the default can change between compiler
-   invocations. *)
-
-let check l (x, _) = List.mem x.txt l
-
-let has_unboxed attr = List.exists (check ["ocaml.unboxed"; "unboxed"]) attr
-
-let has_boxed attr = List.exists (check ["ocaml.boxed"; "boxed"]) attr
+let has_unboxed =
+  List.exists (function
+    | {txt = "unboxed"; _}, _ -> true
+    | _ -> false)

compiler/ml/builtin_attributes.mli

@@ -15,15 +15,14 @@
 
 (* Support for some of the builtin attributes:
 
-   ocaml.deprecated
-   ocaml.error
-   ocaml.ppwarning
-   ocaml.warning
-   ocaml.warnerror
-   ocaml.warn_on_literal_pattern
-   ocaml.deprecated_mutable
-   ocaml.immediate
-   ocaml.boxed / ocaml.unboxed
+   deprecated
+   error
+   ppwarning
+   warning
+   warnerror
+   warn_on_literal_pattern
+   immediate
+   unboxed
 *)
 
 val check_deprecated :
@@ -44,26 +43,14 @@ val deprecated_of_attrs : Parsetree.attributes -> string option
 val deprecated_of_sig : Parsetree.signature -> string option
 val deprecated_of_str : Parsetree.structure -> string option
 
-val check_deprecated_mutable :
-  Location.t -> Parsetree.attributes -> string -> unit
-val check_deprecated_mutable_inclusion :
-  def:Location.t ->
-  use:Location.t ->
-  Location.t ->
-  Parsetree.attributes ->
-  Parsetree.attributes ->
-  string ->
-  unit
-
 val error_of_extension : Parsetree.extension -> Location.error
 
 val warning_attribute : ?ppwarning:bool -> Parsetree.attribute -> unit
 (** Apply warning settings from the specified attribute.
-      "ocaml.warning"/"ocaml.warnerror" (and variants without the prefix)
-      are processed and other attributes are ignored.
+      "warning" and "warnerror" are processed and other attributes are
+      ignored.
 
-      Also implement ocaml.ppwarning (unless ~ppwarning:false is
-      passed).
+      Also implement ppwarning (unless ~ppwarning:false is passed).
   *)
 
 val warning_scope :
@@ -83,4 +70,3 @@ val warn_on_literal_pattern : Parsetree.attributes -> bool
 val immediate : Parsetree.attributes -> bool
 
 val has_unboxed : Parsetree.attributes -> bool
-val has_boxed : Parsetree.attributes -> bool