Simplify parsing and printing attributes of function and arguments (#5783)

Author: mununki

CHANGELOG.md

@@ -18,6 +18,7 @@
   - `npm i -g rescript@9`
   - `rescript convert <reason files>`
 - Remove obsolete built-in project templates and the "rescript init" functionality. This will be replaced by the create-rescript-app project that is maintained separately.
+- Parse the attributes of labelled argument to the pattern attributes of argument instead of function.
 
 #### :boom: Breaking Change
 

lib/4.06.1/unstable/js_compiler.ml

@@ -49677,7 +49677,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 =
@@ -49688,48 +49688,26 @@ 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
+    | {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
@@ -57920,13 +57898,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
@@ -58017,22 +58005,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 ": ";

lib/4.06.1/unstable/js_playground_compiler.ml

@@ -49677,7 +49677,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 =
@@ -49688,48 +49688,26 @@ 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
+    | {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
@@ -57920,13 +57898,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
@@ -58017,22 +58005,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 ": ";
@@ -284712,6 +284703,12 @@ and parseTernaryExpr leftOperand p =
 and parseEs6ArrowExpression ?context ?parameters p =
   let startPos = p.Parser.startPos in
   Parser.leaveBreadcrumb p Grammar.Es6ArrowExpr;
+  (* Parsing function parameters and attributes:
+     1. Basically, attributes outside of `(...)` are added to the function, except
+     the uncurried attribute `(.)` is added to the function. e.g. async, uncurried
+
+     2. Attributes inside `(...)` are added to the arguments regardless of whether
+     labeled, optional or nolabeled *)
   let parameters =
     match parameters with
     | Some params -> params
@@ -284785,12 +284782,6 @@ and parseParameter p =
   then
     let startPos = p.Parser.startPos in
     let uncurried = Parser.optional p Token.Dot in
-    (* two scenarios:
-     *   attrs ~lbl ...
-     *   attrs pattern
-     * Attributes before a labelled arg, indicate that it's on the whole arrow expr
-     * Otherwise it's part of the pattern
-     * *)
     let attrs = parseAttributes p in
     if p.Parser.token = Typ then (
       Parser.next p;
@@ -284808,9 +284799,9 @@ and parseParameter p =
           match p.Parser.token with
           | Comma | Equal | Rparen ->
             let loc = mkLoc startPos p.prevEndPos in
-            ( attrs,
+            ( [],
               Asttypes.Labelled lblName,
-              Ast_helper.Pat.var ~attrs:[propLocAttr] ~loc
+              Ast_helper.Pat.var ~attrs:(propLocAttr :: attrs) ~loc
                 (Location.mkloc lblName loc) )
           | Colon ->
             let lblEnd = p.prevEndPos in
@@ -284820,25 +284811,29 @@ and parseParameter p =
             let pat =
               let pat = Ast_helper.Pat.var ~loc (Location.mkloc lblName loc) in
               let loc = mkLoc startPos p.prevEndPos in
-              Ast_helper.Pat.constraint_ ~attrs:[propLocAttr] ~loc pat typ
+              Ast_helper.Pat.constraint_ ~attrs:(propLocAttr :: attrs) ~loc pat
+                typ
             in
             (attrs, Asttypes.Labelled lblName, pat)
           | As ->
             Parser.next p;
             let pat =
               let pat = parseConstrainedPattern p in
-              {pat with ppat_attributes = propLocAttr :: pat.ppat_attributes}
+              {
+                pat with
+                ppat_attributes = (propLocAttr :: attrs) @ pat.ppat_attributes;
+              }
             in
-            (attrs, Asttypes.Labelled lblName, pat)
+            ([], Asttypes.Labelled lblName, pat)
           | t ->
             Parser.err p (Diagnostics.unexpected t p.breadcrumbs);
             let loc = mkLoc startPos p.prevEndPos in
-            ( attrs,
+            ( [],
               Asttypes.Labelled lblName,
               Ast_helper.Pat.var ~loc (Location.mkloc lblName loc) ))
         | _ ->
           let pattern = parseConstrainedPattern p in
-          let attrs = List.concat [attrs; pattern.ppat_attributes] in
+          let attrs = List.concat [pattern.ppat_attributes; attrs] in
           ([], Asttypes.Nolabel, {pattern with ppat_attributes = attrs})
       in
       match p.Parser.token with