Represent JSX component annotations with a parsetree node

analysis/src/dump_ast.ml

@@ -367,7 +367,7 @@ let print_value_binding value ~pos ~indentation =
       ^ ". "
       ^ print_core_type pvc_type ~pos
   in
-  print_attributes value.Parsetree.pvb_attributes
+  print_attributes (Ast_helper.Vb.binding_attributes value)
   ^ "value" ^ ":\n"
   ^ add_indentation (indentation + 1)
   ^ (value.pvb_pat |> print_pattern ~pos ~indentation:(indentation + 1))

analysis/src/utils.ml

@@ -161,10 +161,9 @@ let rec unwrap_if_option (t : Types.type_expr) =
   | _ -> t
 
 let is_jsx_component (vb : Parsetree.value_binding) =
-  vb.pvb_attributes
-  |> List.exists (function
-    | {Location.txt = "react.component" | "jsx.component"}, _payload -> true
-    | _ -> false)
+  match vb.pvb_jsx_component with
+  | Some {pjc_kind = Pjc_labelled _} -> true
+  | Some {pjc_kind = Pjc_with_props} | None -> false
 
 let check_name name ~prefix ~exact =
   if exact then name = prefix else starts_with name prefix

changes/jsx-component-node.internal.md

@@ -0,0 +1 @@
+- Represent `@react.component`, `@jsx.component` and their `componentWithProps` forms with a dedicated parsetree node. https://github.com/rescript-lang/rescript/pull/8884

changes/jsx-component-payload-error.polish.md

@@ -0,0 +1 @@
+- Report a JSX component annotation with an unsupported payload, such as `@react.component("x")`, or a second one on the same definition, instead of ignoring it. https://github.com/rescript-lang/rescript/pull/8884

compiler/ext/config.ml

@@ -1,10 +1,10 @@
-let cmi_magic_number = "Caml1999I037"
+let cmi_magic_number = "Caml1999I038"
 
 (* Magic numbers for marshaled values of the *current* parsetree, whose layout
    changes across compiler versions. *)
-and ast_impl_magic_number = "ResImpl01316"
+and ast_impl_magic_number = "ResImpl01317"
 
-and ast_intf_magic_number = "ResIntf01316"
+and ast_intf_magic_number = "ResIntf01317"
 
 (* Magic numbers of the frozen Parsetree0 (OCaml 4.06) layout used on the
    external-PPX wire. They must never be written in front of a
@@ -13,7 +13,7 @@ and ast0_impl_magic_number = "Caml1999M022"
 
 and ast0_intf_magic_number = "Caml1999N022"
 
-and cmt_magic_number = "Caml1999T044"
+and cmt_magic_number = "Caml1999T045"
 
 let get_load_path () = (Compiler_request_state.current ()).load_path
 let set_load_path path = (Compiler_request_state.current ()).load_path <- path

compiler/frontend/ast_external_mk.ml

@@ -36,6 +36,7 @@ let local_external_apply loc ?(pval_attributes = [])
               pval_type;
               pval_loc = loc;
               pval_prim = Some pval_prim;
+              pval_jsx_component = None;
               pval_attributes;
             };
         ],

compiler/frontend/ast_tuple_pattern_flatten.ml

@@ -60,10 +60,18 @@ let flattern_tuple_pattern_vb (self : Ast_mapper.mapper)
   in
   let pvb_expr = self.expr self vb.pvb_expr in
   let pvb_attributes = self.attributes self vb.pvb_attributes in
+  let pvb_jsx_component = vb.pvb_jsx_component in
   let pvb_expr_desc = (Ast_payload.unwrap_braces pvb_expr).pexp_desc in
   match (pvb_constraint, pvb_pat.ppat_desc, pvb_expr_desc) with
   | Some _, _, _ ->
-    {pvb_pat; pvb_expr; pvb_constraint; pvb_loc = vb.pvb_loc; pvb_attributes}
+    {
+      pvb_pat;
+      pvb_expr;
+      pvb_constraint;
+      pvb_jsx_component;
+      pvb_loc = vb.pvb_loc;
+      pvb_attributes;
+    }
     :: acc
   | None, Ppat_tuple xs, _ when List.for_all is_simple_pattern xs -> (
     match Ast_open_cxt.destruct_open_tuple pvb_expr [] with
@@ -77,12 +85,20 @@ let flattern_tuple_pattern_vb (self : Ast_mapper.mapper)
             pvb_pat = pat;
             pvb_expr = Ast_open_cxt.restore_exp exp wholes;
             pvb_constraint = None;
+            pvb_jsx_component;
             pvb_attributes;
             pvb_loc = vb.pvb_loc;
           }
           :: acc)
     | _ ->
-      {pvb_pat; pvb_expr; pvb_constraint; pvb_loc = vb.pvb_loc; pvb_attributes}
+      {
+        pvb_pat;
+        pvb_expr;
+        pvb_constraint;
+        pvb_jsx_component;
+        pvb_loc = vb.pvb_loc;
+        pvb_attributes;
+      }
       :: acc)
   | None, Ppat_record (_, _, Some rest), Pexp_pack {pmod_desc = Pmod_ident _} ->
     Location.raise_errorf ~loc:rest.rest_loc
@@ -99,14 +115,22 @@ let flattern_tuple_pattern_vb (self : Ast_mapper.mapper)
               Ast_helper.Exp.ident ~loc:lid.loc
                 {lid with txt = Ldot (id.txt, s)};
             pvb_constraint = None;
+            pvb_jsx_component = None;
             pvb_attributes = [];
             pvb_loc = pat.ppat_loc;
           }
         | _ ->
           Location.raise_errorf ~loc:lid.loc
             "Not supported pattern match on modules")
   | _ ->
-    {pvb_pat; pvb_expr; pvb_constraint; pvb_loc = vb.pvb_loc; pvb_attributes}
+    {
+      pvb_pat;
+      pvb_expr;
+      pvb_constraint;
+      pvb_jsx_component;
+      pvb_loc = vb.pvb_loc;
+      pvb_attributes;
+    }
     :: acc
 
 let value_bindings_mapper (self : Ast_mapper.mapper)

compiler/frontend/bs_builtin_ppx.ml

@@ -493,6 +493,7 @@ let signature_item_mapper (self : mapper) (sigi : Parsetree.signature_item) :
                 {
                   value_desc with
                   pval_prim = Some (Ast_external_mk.inline_string semantic);
+                  pval_jsx_component = None;
                   pval_attributes = [];
                 };
           }
@@ -506,6 +507,7 @@ let signature_item_mapper (self : mapper) (sigi : Parsetree.signature_item) :
                 {
                   value_desc with
                   pval_prim = Some (Ast_external_mk.inline_int s);
+                  pval_jsx_component = None;
                   pval_attributes = [];
                 };
           }
@@ -518,6 +520,7 @@ let signature_item_mapper (self : mapper) (sigi : Parsetree.signature_item) :
                 {
                   value_desc with
                   pval_prim = Some (Ast_external_mk.inline_bigint s);
+                  pval_jsx_component = None;
                   pval_attributes = [];
                 };
           }
@@ -530,6 +533,7 @@ let signature_item_mapper (self : mapper) (sigi : Parsetree.signature_item) :
                 {
                   value_desc with
                   pval_prim = Some (Ast_external_mk.inline_float s);
+                  pval_jsx_component = None;
                   pval_attributes = [];
                 };
           }
@@ -543,6 +547,7 @@ let signature_item_mapper (self : mapper) (sigi : Parsetree.signature_item) :
                 {
                   value_desc with
                   pval_prim = Some (Ast_external_mk.inline_bool (txt = "true"));
+                  pval_jsx_component = None;
                   pval_attributes = [];
                 };
           }
@@ -586,6 +591,7 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) :
             pvb_pat = {ppat_desc = Ppat_var pval_name} as pvb_pat;
             pvb_expr;
             pvb_constraint = None;
+            pvb_jsx_component;
             pvb_attributes;
             pvb_loc;
           };
@@ -615,6 +621,7 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) :
               pval_name;
               pval_type = Ast_literal.type_string ();
               pval_loc = pvb_loc;
+              pval_jsx_component = None;
               pval_attributes = [];
               pval_prim = Some (Ast_external_mk.inline_string semantic);
             };
@@ -630,6 +637,7 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) :
               pval_name;
               pval_type = Ast_literal.type_int ();
               pval_loc = pvb_loc;
+              pval_jsx_component = None;
               pval_attributes = [];
               pval_prim = Some (Ast_external_mk.inline_int s);
             };
@@ -644,6 +652,7 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) :
               pval_name;
               pval_type = Ast_literal.type_float;
               pval_loc = pvb_loc;
+              pval_jsx_component = None;
               pval_attributes = [];
               pval_prim = Some (Ast_external_mk.inline_float s);
             };
@@ -660,6 +669,7 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) :
               pval_name;
               pval_type = Ast_literal.type_bool ();
               pval_loc = pvb_loc;
+              pval_jsx_component = None;
               pval_attributes = [];
               pval_prim = Some (Ast_external_mk.inline_bool (txt = "true"));
             };
@@ -675,6 +685,7 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) :
                   pvb_pat;
                   pvb_expr;
                   pvb_constraint = None;
+                  pvb_jsx_component;
                   pvb_attributes;
                   pvb_loc;
                 };

compiler/ml/ast_helper.ml

@@ -321,15 +321,96 @@ module Str = struct
   let attribute ?loc a = mk ?loc (Pstr_attribute a)
 end
 
+(* [@react.component] and its variants are taken out of the attributes when a
+   value binding or value description is built, so every producer - the
+   parser, a ppx, the frozen AST bridge - agrees on what is a component. *)
+module Jsx_component = struct
+  let of_attribute (({txt; loc}, payload) : attribute) =
+    let component pjc_kind pjc_namespace =
+      Some {pjc_kind; pjc_namespace; pjc_loc = loc}
+    in
+    match (txt, payload) with
+    | "react.component", PStr [] -> component (Pjc_labelled None) Pjc_react
+    | "react.component", PTyp typ ->
+      component (Pjc_labelled (Some typ)) Pjc_react
+    | "jsx.component", PStr [] -> component (Pjc_labelled None) Pjc_jsx
+    | "jsx.component", PTyp typ -> component (Pjc_labelled (Some typ)) Pjc_jsx
+    | "react.componentWithProps", PStr [] -> component Pjc_with_props Pjc_react
+    | "jsx.componentWithProps", PStr [] -> component Pjc_with_props Pjc_jsx
+    | _ -> None
+
+  let to_attribute {pjc_kind; pjc_namespace; pjc_loc} : attribute =
+    let namespace =
+      match pjc_namespace with
+      | Pjc_react -> "react"
+      | Pjc_jsx -> "jsx"
+    in
+    match pjc_kind with
+    | Pjc_labelled None ->
+      ({txt = namespace ^ ".component"; loc = pjc_loc}, PStr [])
+    | Pjc_labelled (Some typ) ->
+      ({txt = namespace ^ ".component"; loc = pjc_loc}, PTyp typ)
+    | Pjc_with_props ->
+      ({txt = namespace ^ ".componentWithProps"; loc = pjc_loc}, PStr [])
+
+  (* The first [@react.component], or failing that the first
+     [@react.componentWithProps]: the JSX transform has always given them
+     this precedence. A later one, or one whose payload is not understood, is
+     left in the attributes for the JSX transform to reject, so that
+     formatting does not drop it. *)
+  let take attrs =
+    let take_first is_kind =
+      let rec go seen = function
+        | [] -> (None, attrs)
+        | attr :: rest -> (
+          match of_attribute attr with
+          | Some component when is_kind component.pjc_kind ->
+            (Some component, List.rev_append seen rest)
+          | _ -> go (attr :: seen) rest)
+      in
+      go [] attrs
+    in
+    match
+      take_first (function
+        | Pjc_labelled _ -> true
+        | Pjc_with_props -> false)
+    with
+    | (Some _, _) as found -> found
+    | None, _ ->
+      take_first (function
+        | Pjc_with_props -> true
+        | Pjc_labelled _ -> false)
+
+  (* Inverse of [take], for printers and the frozen AST bridge. Attributes
+     print in source order, so the annotation goes back where it was written.
+     Ppx output has no source position, so all of it ties on [Location.none];
+     the annotation then goes first among the tied, where it is usually
+     written. *)
+  let put_back component attrs =
+    match component with
+    | None -> attrs
+    | Some component ->
+      let written_earlier (({loc}, _) : attribute) =
+        loc.loc_start.pos_cnum < component.pjc_loc.loc_start.pos_cnum
+      in
+      let earlier, later = List.partition written_earlier attrs in
+      earlier @ (to_attribute component :: later)
+end
+
 module Val = struct
   let mk ?(loc = !default_loc) ?(attrs = []) ?prim name typ =
+    let jsx_component, attrs = Jsx_component.take attrs in
     {
       pval_name = name;
       pval_type = typ;
+      pval_jsx_component = jsx_component;
       pval_attributes = attrs;
       pval_loc = loc;
       pval_prim = prim;
     }
+
+  let description_attributes vd =
+    Jsx_component.put_back vd.pval_jsx_component vd.pval_attributes
 end
 
 module Md = struct
@@ -364,13 +445,18 @@ end
 
 module Vb = struct
   let mk ?(loc = !default_loc) ?(attrs = []) ?constraint_ pat expr =
+    let jsx_component, attrs = Jsx_component.take attrs in
     {
       pvb_pat = pat;
       pvb_expr = expr;
       pvb_constraint = constraint_;
+      pvb_jsx_component = jsx_component;
       pvb_attributes = attrs;
       pvb_loc = loc;
     }
+
+  let binding_attributes vb =
+    Jsx_component.put_back vb.pvb_jsx_component vb.pvb_attributes
 end
 
 module Type = struct

compiler/ml/ast_helper.mli

@@ -276,6 +276,15 @@ module Exp : sig
     Location.t -> expression list -> expression option -> expression
 end
 
+(** JSX component annotations *)
+module Jsx_component : sig
+  val of_attribute : attribute -> jsx_component option
+  (** The component an attribute such as [@react.component] denotes, if its
+      payload is one the JSX transform understands. *)
+
+  val to_attribute : jsx_component -> attribute
+end
+
 (** Value declarations *)
 module Val : sig
   val mk :
@@ -285,6 +294,12 @@ module Val : sig
     str ->
     core_type ->
     value_description
+  (** A [@react.component] annotation in [attrs] is taken out and becomes
+      [pval_jsx_component]. *)
+
+  val description_attributes : value_description -> attrs
+  (** The attributes as written, with the [@react.component] annotation put
+      back. For printers, which must reproduce the source. *)
 end
 
 (** Type declarations *)
@@ -486,4 +501,10 @@ module Vb : sig
     pattern ->
     expression ->
     value_binding
+  (** A [@react.component] annotation in [attrs] is taken out and becomes
+      [pvb_jsx_component]. *)
+
+  val binding_attributes : value_binding -> attrs
+  (** The attributes as written, with the [@react.component] annotation put
+      back. For printers, which must reproduce the source. *)
 end