Experiment with storing the location of function named arguments in the AST.

Author: cristianoc

compiler/frontend/ast_compatible.ml

@@ -85,6 +85,7 @@ let fun_ ?(loc = default_loc) ?(attrs = []) ?(async = false) ~arity pat exp =
       Pexp_fun
         {
           arg_label = Nolabel;
+          label_loc = Location.none;
           default = None;
           lhs = pat;
           rhs = exp;

compiler/frontend/bs_ast_mapper.ml

@@ -311,9 +311,17 @@ module E = struct
            sub vbs)
         (sub.expr sub e)
     (* #end *)
-    | Pexp_fun {arg_label = lab; default = def; lhs = p; rhs = e; arity; async}
-      ->
-      fun_ ~loc ~attrs ~arity ~async lab
+    | Pexp_fun
+        {
+          arg_label = lab;
+          label_loc;
+          default = def;
+          lhs = p;
+          rhs = e;
+          arity;
+          async;
+        } ->
+      fun_ ~loc ~attrs ~label_loc ~arity ~async lab
         (map_opt (sub.expr sub) def)
         (sub.pat sub p) (sub.expr sub e)
     | Pexp_apply {funct = e; args = l; partial} ->

compiler/ml/ast_helper.ml

@@ -151,9 +151,11 @@ module Exp = struct
   let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a)
   let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a)
   let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c))
-  let fun_ ?loc ?attrs ?(async = false) ~arity a b c d =
+  let fun_ ?loc ?attrs ?(async = false) ?(label_loc = Location.none) ~arity a b
+      c d =
     mk ?loc ?attrs
-      (Pexp_fun {arg_label = a; default = b; lhs = c; rhs = d; arity; async})
+      (Pexp_fun
+         {arg_label = a; label_loc; default = b; lhs = c; rhs = d; arity; async})
   let apply ?loc ?attrs ?(partial = false) funct args =
     mk ?loc ?attrs (Pexp_apply {funct; args; partial})
   let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b))

compiler/ml/ast_helper.mli

@@ -139,6 +139,7 @@ module Exp : sig
     ?loc:loc ->
     ?attrs:attrs ->
     ?async:bool ->
+    ?label_loc:loc ->
     arity:int option ->
     arg_label ->
     expression option ->

compiler/ml/ast_mapper.ml

@@ -274,9 +274,17 @@ module E = struct
     | Pexp_constant x -> constant ~loc ~attrs x
     | Pexp_let (r, vbs, e) ->
       let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e)
-    | Pexp_fun {arg_label = lab; default = def; lhs = p; rhs = e; arity; async}
-      ->
-      fun_ ~loc ~attrs ~arity ~async lab
+    | Pexp_fun
+        {
+          arg_label = lab;
+          label_loc;
+          default = def;
+          lhs = p;
+          rhs = e;
+          arity;
+          async;
+        } ->
+      fun_ ~loc ~attrs ~label_loc ~arity ~async lab
         (map_opt (sub.expr sub) def)
         (sub.pat sub p) (sub.expr sub e)
     | Pexp_apply {funct = e; args = l; partial} ->

compiler/ml/parsetree.ml

@@ -226,6 +226,7 @@ and expression_desc =
     *)
   | Pexp_fun of {
       arg_label: arg_label;
+      label_loc: Location.t;
       default: expression option;
       lhs: pattern;
       rhs: expression;

compiler/syntax/src/res_comments_table.ml

@@ -263,19 +263,21 @@ let fun_expr expr =
        Pexp_fun
          {
            arg_label = lbl;
+           label_loc;
            default = default_expr;
            lhs = pattern;
            rhs = return_expr;
          };
      pexp_attributes = [];
     } ->
-      let parameter = ([], lbl, default_expr, pattern) in
+      let parameter = ([], lbl, label_loc, default_expr, pattern) in
       collect attrs_before (parameter :: acc) return_expr
     | {pexp_desc = Pexp_newtype (string_loc, rest); pexp_attributes = attrs} ->
       let var, return_expr = collect_new_types [string_loc] rest in
       let parameter =
         ( attrs,
           Asttypes.Nolabel,
+          Location.none,
           None,
           Ast_helper.Pat.var ~loc:string_loc.loc var )
       in
@@ -285,26 +287,28 @@ let fun_expr expr =
        Pexp_fun
          {
            arg_label = lbl;
+           label_loc;
            default = default_expr;
            lhs = pattern;
            rhs = return_expr;
          };
      pexp_attributes = [({txt = "bs"}, _)] as attrs;
     } ->
-      let parameter = (attrs, lbl, default_expr, pattern) in
+      let parameter = (attrs, lbl, label_loc, default_expr, pattern) in
       collect attrs_before (parameter :: acc) return_expr
     | {
      pexp_desc =
        Pexp_fun
          {
            arg_label = (Labelled _ | Optional _) as lbl;
+           label_loc;
            default = default_expr;
            lhs = pattern;
            rhs = return_expr;
          };
      pexp_attributes = attrs;
     } ->
-      let parameter = (attrs, lbl, default_expr, pattern) in
+      let parameter = (attrs, lbl, label_loc, default_expr, pattern) in
       collect attrs_before (parameter :: acc) return_expr
     | expr -> (attrs_before, List.rev acc, expr)
   in
@@ -1446,13 +1450,11 @@ and walk_expression expr t comments =
     let comments =
       visit_list_but_continue_with_remaining_comments ~newline_delimited:false
         ~walk_node:walk_expr_pararameter
-        ~get_loc:(fun (_attrs, _argLbl, expr_opt, pattern) ->
+        ~get_loc:(fun (_attrs, _argLbl, label_loc, expr_opt, pattern) ->
           let open Parsetree in
           let start_pos =
-            match pattern.ppat_attributes with
-            | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _attrs ->
-              loc.loc_start
-            | _ -> pattern.ppat_loc.loc_start
+            if label_loc <> Location.none then label_loc.loc_start
+            else pattern.ppat_loc.loc_start
           in
           match expr_opt with
           | None -> {pattern.ppat_loc with loc_start = start_pos}
@@ -1493,7 +1495,8 @@ and walk_expression expr t comments =
         attach t.trailing return_expr.pexp_loc trailing)
   | _ -> ()
 
-and walk_expr_pararameter (_attrs, _argLbl, expr_opt, pattern) t comments =
+and walk_expr_pararameter (_attrs, _argLbl, _label_loc, expr_opt, pattern) t
+    comments =
   let leading, inside, trailing = partition_by_loc comments pattern.ppat_loc in
   attach t.leading pattern.ppat_loc leading;
   walk_pattern pattern t inside;

compiler/syntax/src/res_core.ml

@@ -191,6 +191,7 @@ type fundef_type_param = {
 type fundef_term_param = {
   attrs: Parsetree.attributes;
   p_label: Asttypes.arg_label;
+  lbl_loc: Location.t;
   expr: Parsetree.expression option;
   pat: Parsetree.pattern;
   p_pos: Lexing.position;
@@ -1594,12 +1595,19 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None)
   let arrow_expr =
     List.fold_right
       (fun parameter expr ->
-        let {attrs; p_label = lbl; expr = default_expr; pat; p_pos = start_pos}
-            =
+        let {
+          attrs;
+          p_label = lbl;
+          lbl_loc;
+          expr = default_expr;
+          pat;
+          p_pos = start_pos;
+        } =
           parameter
         in
         let loc = mk_loc start_pos end_pos in
-        Ast_helper.Exp.fun_ ~loc ~attrs ~arity:None lbl default_expr pat expr)
+        Ast_helper.Exp.fun_ ~loc ~attrs ~label_loc:lbl_loc ~arity:None lbl
+          default_expr pat expr)
       term_parameters body
   in
   let arrow_expr =
@@ -1647,21 +1655,18 @@ and parse_parameter p =
       let lidents = parse_lident_list p in
       Some (TypeParameter {attrs; locs = lidents; p_pos = start_pos}))
     else
-      let attrs, lbl, pat =
+      let attrs, lbl, lbl_loc, pat =
         match p.Parser.token with
         | Tilde -> (
           Parser.next p;
-          let lbl_name, loc = parse_lident p in
-          let prop_loc_attr =
-            (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr [])
-          in
+          let lbl_name, lbl_loc = parse_lident p in
           match p.Parser.token with
           | Comma | Equal | Rparen ->
             let loc = mk_loc start_pos p.prev_end_pos in
             ( [],
               Asttypes.Labelled lbl_name,
-              Ast_helper.Pat.var ~attrs:(prop_loc_attr :: attrs) ~loc
-                (Location.mkloc lbl_name loc) )
+              lbl_loc,
+              Ast_helper.Pat.var ~attrs ~loc (Location.mkloc lbl_name loc) )
           | Colon ->
             let lbl_end = p.prev_end_pos in
             Parser.next p;
@@ -1670,31 +1675,30 @@ and parse_parameter p =
             let pat =
               let pat = Ast_helper.Pat.var ~loc (Location.mkloc lbl_name loc) in
               let loc = mk_loc start_pos p.prev_end_pos in
-              Ast_helper.Pat.constraint_ ~attrs:(prop_loc_attr :: attrs) ~loc
-                pat typ
+              Ast_helper.Pat.constraint_ ~attrs ~loc pat typ
             in
-            ([], Asttypes.Labelled lbl_name, pat)
+            ([], Asttypes.Labelled lbl_name, lbl_loc, pat)
           | As ->
             Parser.next p;
             let pat =
               let pat = parse_constrained_pattern p in
-              {
-                pat with
-                ppat_attributes = (prop_loc_attr :: attrs) @ pat.ppat_attributes;
-              }
+              {pat with ppat_attributes = attrs @ pat.ppat_attributes}
             in
-            ([], Asttypes.Labelled lbl_name, pat)
+            ([], Asttypes.Labelled lbl_name, lbl_loc, pat)
           | t ->
             Parser.err p (Diagnostics.unexpected t p.breadcrumbs);
             let loc = mk_loc start_pos p.prev_end_pos in
             ( [],
               Asttypes.Labelled lbl_name,
-              Ast_helper.Pat.var ~attrs:(prop_loc_attr :: attrs) ~loc
-                (Location.mkloc lbl_name loc) ))
+              lbl_loc,
+              Ast_helper.Pat.var ~attrs ~loc (Location.mkloc lbl_name loc) ))
         | _ ->
           let pattern = parse_constrained_pattern p in
           let attrs = List.concat [pattern.ppat_attributes; attrs] in
-          ([], Asttypes.Nolabel, {pattern with ppat_attributes = attrs})
+          ( [],
+            Asttypes.Nolabel,
+            Location.none,
+            {pattern with ppat_attributes = attrs} )
       in
       match p.Parser.token with
       | Equal -> (
@@ -1719,17 +1723,37 @@ and parse_parameter p =
           Parser.next p;
           Some
             (TermParameter
-               {attrs; p_label = lbl; expr = None; pat; p_pos = start_pos})
+               {
+                 attrs;
+                 p_label = lbl;
+                 lbl_loc;
+                 expr = None;
+                 pat;
+                 p_pos = start_pos;
+               })
         | _ ->
           let expr = parse_constrained_or_coerced_expr p in
           Some
             (TermParameter
-               {attrs; p_label = lbl; expr = Some expr; pat; p_pos = start_pos})
-        )
+               {
+                 attrs;
+                 p_label = lbl;
+                 lbl_loc;
+                 expr = Some expr;
+                 pat;
+                 p_pos = start_pos;
+               }))
       | _ ->
         Some
           (TermParameter
-             {attrs; p_label = lbl; expr = None; pat; p_pos = start_pos})
+             {
+               attrs;
+               p_label = lbl;
+               lbl_loc;
+               expr = None;
+               pat;
+               p_pos = start_pos;
+             })
   else None
 
 and parse_parameter_list p =
@@ -1759,6 +1783,7 @@ and parse_parameters p : fundef_type_param option * fundef_term_param list =
     {
       attrs = [];
       p_label = Asttypes.Nolabel;
+      lbl_loc = Location.none;
       expr = None;
       pat = unit_pattern;
       p_pos = start_pos;
@@ -1773,6 +1798,7 @@ and parse_parameters p : fundef_type_param option * fundef_term_param list =
         {
           attrs = [];
           p_label = Asttypes.Nolabel;
+          lbl_loc = Location.none;
           expr = None;
           pat = Ast_helper.Pat.var ~loc (Location.mkloc ident loc);
           p_pos = start_pos;
@@ -1786,6 +1812,7 @@ and parse_parameters p : fundef_type_param option * fundef_term_param list =
         {
           attrs = [];
           p_label = Asttypes.Nolabel;
+          lbl_loc = Location.none;
           expr = None;
           pat = Ast_helper.Pat.any ~loc ();
           p_pos = start_pos;
@@ -3007,6 +3034,7 @@ and parse_braced_or_record_expr p =
                 {
                   attrs = [];
                   p_label = Asttypes.Nolabel;
+                  lbl_loc = Location.none;
                   expr = None;
                   pat = Ast_helper.Pat.var ~loc:ident.loc ident;
                   p_pos = start_pos;

compiler/syntax/src/res_parsetree_viewer.ml

@@ -143,6 +143,7 @@ type fun_param_kind =
   | Parameter of {
       attrs: Parsetree.attributes;
       lbl: Asttypes.arg_label;
+      lbl_loc: Location.t;
       default_expr: Parsetree.expression option;
       pat: Parsetree.pattern;
     }
@@ -157,6 +158,7 @@ let fun_expr expr_ =
        Pexp_fun
          {
            arg_label = lbl;
+           label_loc;
            default = default_expr;
            lhs = pattern;
            rhs = return_expr;
@@ -165,7 +167,9 @@ let fun_expr expr_ =
      pexp_attributes = attrs;
     }
       when arity = None || n_fun = 0 ->
-      let parameter = Parameter {attrs; lbl; default_expr; pat = pattern} in
+      let parameter =
+        Parameter {attrs; lbl; lbl_loc = label_loc; default_expr; pat = pattern}
+      in
       collect_params ~n_fun:(n_fun + 1) ~params:(parameter :: params)
         return_expr
     | _ -> (async, List.rev params, expr)

compiler/syntax/src/res_parsetree_viewer.mli

@@ -42,6 +42,7 @@ type fun_param_kind =
   | Parameter of {
       attrs: Parsetree.attributes;
       lbl: Asttypes.arg_label;
+      lbl_loc: Location.t;
       default_expr: Parsetree.expression option;
       pat: Parsetree.pattern;
     }