Sync latest syntax

CHANGELOG.md

@@ -12,6 +12,10 @@
 
 # 10.1.1
 
+#### :boom: Breaking Change
+
+- Parse the attributes of labelled argument to the pattern attributes of argument instead of function. https://github.com/rescript-lang/syntax/pull/722
+
 #### :rocket: New Feature
 
 - Add support for empty inlined record literal `{}` for inlined records where all fields are optional https://github.com/rescript-lang/rescript-compiler/pull/5900
@@ -22,6 +26,7 @@
 - Revert to ubuntu-18.04 in CI to support Linux versions with older glibc https://github.com/rescript-lang/rescript-compiler/issues/5868
 - Fix build error where aliasing arguments to `_` in the make function with JSX V4. https://github.com/rescript-lang/syntax/pull/720
 - Fix parsing of spread props as an expression in JSX V4 https://github.com/rescript-lang/syntax/pull/721
+- Fix dropping attributes from props in make function in JSX V4 https://github.com/rescript-lang/syntax/pull/723
 
 # 10.1.0
 

jscomp/napkin/CHANGELOG.md

@@ -13,6 +13,7 @@
 #### :boom: Breaking Change
 
 - Emit an error when a `@string` or `@int` attribute is used in a V4 component https://github.com/rescript-lang/rescript-compiler/issues/5724
+- Parse the attributes of labelled argument to the pattern attributes of argument instead of function. https://github.com/rescript-lang/syntax/pull/722
 
 #### :rocket: New Feature
 
@@ -53,6 +54,7 @@
 - Treat await as almost-unary operator weaker than pipe so `await foo->bar` means `await (foo->bar)` https://github.com/rescript-lang/syntax/pull/711
 - Fix build error where aliasing arguments to `_` in the make function with JSX V4. https://github.com/rescript-lang/syntax/pull/720
 - Fix parsing of spread props as an expression in JSX V4 https://github.com/rescript-lang/syntax/pull/721
+- Fix dropping attributes from props in make function in JSX V4 https://github.com/rescript-lang/syntax/pull/723
 
 #### :eyeglasses: Spec Compliance
 

lib/4.06.1/unstable/js_compiler.ml

@@ -49712,7 +49712,7 @@ let funExpr expr =
       collectNewTypes (stringLoc :: acc) returnExpr
     | returnExpr -> (List.rev acc, returnExpr)
   in
-  let rec collect n attrsBefore acc expr =
+  let rec collect attrsBefore acc expr =
     match expr with
     | {
      pexp_desc =
@@ -49723,48 +49723,28 @@ let funExpr expr =
            {pexp_desc = Pexp_apply _} );
     } ->
       (attrsBefore, List.rev acc, rewriteUnderscoreApply expr)
-    | {
-     pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr);
-     pexp_attributes = [];
-    } ->
-      let parameter = Parameter {attrs = []; lbl; defaultExpr; pat = pattern} in
-      collect (n + 1) attrsBefore (parameter :: acc) returnExpr
     | {pexp_desc = Pexp_newtype (stringLoc, rest); pexp_attributes = attrs} ->
       let stringLocs, returnExpr = collectNewTypes [stringLoc] rest in
       let param = NewTypes {attrs; locs = stringLocs} in
-      collect (n + 1) attrsBefore (param :: acc) returnExpr
-    | {pexp_desc = Pexp_fun _; pexp_attributes}
-      when pexp_attributes
-           |> List.exists (fun ({Location.txt}, _) ->
-                  txt = "bs" || txt = "res.async")
-           && n > 0 ->
-      (* stop here, the uncurried or async attribute always indicates the beginning of an arrow function
-       * e.g. `(. a) => (. b)` instead of `(. a, . b)` *)
-      (attrsBefore, List.rev acc, expr)
+      collect attrsBefore (param :: acc) returnExpr
     | {
-     pexp_desc =
-       Pexp_fun
-         (((Labelled _ | Optional _) as lbl), defaultExpr, pattern, returnExpr);
-     pexp_attributes = attrs;
+     pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr);
+     pexp_attributes = [];
     } ->
-      (* Normally attributes are attached to the labelled argument, e.g. (@foo ~x) => ...
-         In the case of `@res.async`, pass the attribute to the outside *)
-      let attrs_async, attrs_other =
-        attrs |> List.partition (fun ({Location.txt}, _) -> txt = "res.async")
-      in
-      let parameter =
-        Parameter {attrs = attrs_other; lbl; defaultExpr; pat = pattern}
-      in
-      collect (n + 1) (attrs_async @ attrsBefore) (parameter :: acc) returnExpr
+      let parameter = Parameter {attrs = []; lbl; defaultExpr; pat = pattern} in
+      collect attrsBefore (parameter :: acc) returnExpr
+    (* If a fun has an attribute, then it stops here and makes currying.
+       i.e attributes outside of (...), uncurried `(.)` and `async` make currying *)
+    | {pexp_desc = Pexp_fun _} -> (attrsBefore, List.rev acc, expr)
     | expr -> (attrsBefore, List.rev acc, expr)
   in
   match expr with
   | {
-      pexp_desc = Pexp_fun (Nolabel, _defaultExpr, _pattern, _returnExpr);
+      pexp_desc = Pexp_fun (_, _defaultExpr, _pattern, _returnExpr);
       pexp_attributes = attrs;
     } as expr ->
-    collect 0 attrs [] {expr with pexp_attributes = []}
-  | expr -> collect 0 [] [] expr
+    collect attrs [] {expr with pexp_attributes = []}
+  | expr -> collect [] [] expr
 
 let processBracesAttr expr =
   match expr.pexp_attributes with
@@ -57955,13 +57935,23 @@ and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried
        attrs = [];
        lbl = Asttypes.Nolabel;
        defaultExpr = None;
-       pat = {Parsetree.ppat_desc = Ppat_var stringLoc};
+       pat =
+         {
+           Parsetree.ppat_desc = Ppat_var stringLoc;
+           Parsetree.ppat_attributes = attrs;
+         };
      };
   ]
     when not uncurried ->
     let txtDoc =
       let var = printIdentLike stringLoc.txt in
-      let var = if hasConstraint then addParens var else var in
+      let var =
+        match attrs with
+        | [] -> if hasConstraint then addParens var else var
+        | attrs ->
+          let attrs = printAttributes ~customLayout attrs cmtTbl in
+          addParens (Doc.concat [attrs; var])
+      in
       if async then addAsync var else var
     in
     printComments txtDoc cmtTbl stringLoc.loc
@@ -58052,22 +58042,25 @@ and printExpFunParameter ~customLayout parameter cmtTbl =
       match (lbl, pattern) with
       | Asttypes.Nolabel, pattern -> printPattern ~customLayout pattern cmtTbl
       | ( (Asttypes.Labelled lbl | Optional lbl),
-          {
-            ppat_desc = Ppat_var stringLoc;
-            ppat_attributes = [] | [({Location.txt = "ns.namedArgLoc"}, _)];
-          } )
+          {ppat_desc = Ppat_var stringLoc; ppat_attributes} )
         when lbl = stringLoc.txt ->
         (* ~d *)
-        Doc.concat [Doc.text "~"; printIdentLike lbl]
+        Doc.concat
+          [
+            printAttributes ~customLayout ppat_attributes cmtTbl;
+            Doc.text "~";
+            printIdentLike lbl;
+          ]
       | ( (Asttypes.Labelled lbl | Optional lbl),
           {
             ppat_desc = Ppat_constraint ({ppat_desc = Ppat_var {txt}}, typ);
-            ppat_attributes = [] | [({Location.txt = "ns.namedArgLoc"}, _)];
+            ppat_attributes;
           } )
         when lbl = txt ->
         (* ~d: e *)
         Doc.concat
           [
+            printAttributes ~customLayout ppat_attributes cmtTbl;
             Doc.text "~";
             printIdentLike lbl;
             Doc.text ": ";
@@ -274988,14 +274981,15 @@ let makePropsTypeParams ?(stripExplicitOption = false)
 
 let makeLabelDecls ~loc namedTypeList =
   namedTypeList
-  |> List.map (fun (isOptional, label, _, interiorType) ->
+  |> List.map (fun (isOptional, label, attrs, interiorType) ->
          if label = "key" then
-           Type.field ~loc ~attrs:optionalAttrs {txt = label; loc} interiorType
+           Type.field ~loc ~attrs:(optionalAttrs @ attrs) {txt = label; loc}
+             interiorType
          else if isOptional then
-           Type.field ~loc ~attrs:optionalAttrs {txt = label; loc}
+           Type.field ~loc ~attrs:(optionalAttrs @ attrs) {txt = label; loc}
              (Typ.var @@ safeTypeFromValue @@ Labelled label)
          else
-           Type.field ~loc {txt = label; loc}
+           Type.field ~loc ~attrs {txt = label; loc}
              (Typ.var @@ safeTypeFromValue @@ Labelled label))
 
 let makeTypeDecls propsName loc namedTypeList =
@@ -275380,7 +275374,9 @@ let newtypeToVar newtype type_ =
   mapper.typ mapper type_
 
 let argToType ~newtypes ~(typeConstraints : core_type option) types
-    (name, default, _noLabelName, _alias, loc, type_) =
+    ((name, default, {ppat_attributes = attrs}, _alias, loc, type_) :
+      arg_label * expression option * pattern * label * 'loc * core_type option)
+    =
   let rec getType name coreType =
     match coreType with
     | {ptyp_desc = Ptyp_arrow (arg, c1, c2)} ->
@@ -275398,28 +275394,29 @@ let argToType ~newtypes ~(typeConstraints : core_type option) types
   in
   match (type_, name, default) with
   | Some type_, name, _ when isOptional name ->
-    (true, getLabel name, [], {type_ with ptyp_attributes = optionalAttrs})
+    (true, getLabel name, attrs, {type_ with ptyp_attributes = optionalAttrs})
     :: types
-  | Some type_, name, _ -> (false, getLabel name, [], type_) :: types
+  | Some type_, name, _ -> (false, getLabel name, attrs, type_) :: types
   | None, name, _ when isOptional name ->
     ( true,
       getLabel name,
-      [],
+      attrs,
       Typ.var ~loc ~attrs:optionalAttrs (safeTypeFromValue name) )
     :: types
   | None, name, _ when isLabelled name ->
-    (false, getLabel name, [], Typ.var ~loc (safeTypeFromValue name)) :: types
+    (false, getLabel name, attrs, Typ.var ~loc (safeTypeFromValue name))
+    :: types
   | _ -> types
 
 let argWithDefaultValue (name, default, _, _, _, _) =
   match default with
   | Some default when isOptional name -> Some (getLabel name, default)
   | _ -> None
 
-let argToConcreteType types (name, _loc, type_) =
+let argToConcreteType types (name, attrs, _loc, type_) =
   match name with
-  | name when isLabelled name -> (false, getLabel name, [], type_) :: types
-  | name when isOptional name -> (true, getLabel name, [], type_) :: types
+  | name when isLabelled name -> (false, getLabel name, attrs, type_) :: types
+  | name when isOptional name -> (true, getLabel name, attrs, type_) :: types
   | _ -> types
 
 let check_string_int_attribute_iter =
@@ -275456,15 +275453,19 @@ let transformStructureItem ~config mapper item =
           |> Option.map React_jsx_common.typVarsOfCoreType
           |> Option.value ~default:[]
         in
-        let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) =
+        let rec getPropTypes types
+            ({ptyp_loc; ptyp_desc; ptyp_attributes} as fullType) =
           match ptyp_desc with
           | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest))
             when isLabelled name || isOptional name ->
-            getPropTypes ((name, ptyp_loc, type_) :: types) rest
+            getPropTypes
+              ((name, ptyp_attributes, ptyp_loc, type_) :: types)
+              rest
           | Ptyp_arrow (Nolabel, _type, rest) -> getPropTypes types rest
           | Ptyp_arrow (name, type_, returnValue)
             when isLabelled name || isOptional name ->
-            (returnValue, (name, returnValue.ptyp_loc, type_) :: types)
+            ( returnValue,
+              (name, ptyp_attributes, returnValue.ptyp_loc, type_) :: types )
           | _ -> (fullType, types)
         in
         let innerType, propTypes = getPropTypes [] pval_type in
@@ -275936,19 +275937,22 @@ let transformSignatureItem ~config _mapper item =
       in
       let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) =
         match ptyp_desc with
-        | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest))
+        | Ptyp_arrow
+            ( name,
+              ({ptyp_attributes = attrs} as type_),
+              ({ptyp_desc = Ptyp_arrow _} as rest) )
           when isOptional name || isLabelled name ->
-          getPropTypes ((name, ptyp_loc, type_) :: types) rest
+          getPropTypes ((name, attrs, ptyp_loc, type_) :: types) rest
         | Ptyp_arrow
             (Nolabel, {ptyp_desc = Ptyp_constr ({txt = Lident "unit"}, _)}, rest)
           ->
           getPropTypes types rest
         | Ptyp_arrow (Nolabel, _type, rest) ->
           hasForwardRef := true;
           getPropTypes types rest
-        | Ptyp_arrow (name, type_, returnValue)
+        | Ptyp_arrow (name, ({ptyp_attributes = attrs} as type_), returnValue)
           when isOptional name || isLabelled name ->
-          (returnValue, (name, returnValue.ptyp_loc, type_) :: types)
+          (returnValue, (name, attrs, returnValue.ptyp_loc, type_) :: types)
         | _ -> (fullType, types)
       in
       let innerType, propTypes = getPropTypes [] pval_type in