Remove res.namedArgLoc attribute and store the location information directly into the label.

CHANGELOG.md

@@ -33,9 +33,9 @@
 - AST cleanup: represent concatenation (`++`) and (dis)equality operators (`==`, `===`, `!=`, `!==`) just like in the syntax. https://github.com/rescript-lang/rescript/pull/7248
 - AST cleanup: use inline record for `Ptyp_arrow`. https://github.com/rescript-lang/rescript/pull/7250
 - Playground: Bundle stdlib runtime so that the playground can execute functions from Core/Belt/Js. (#7255)
+- AST cleanup: Remove `res.namedArgLoc` attribute and store the location information directly into the label. https://github.com/rescript-lang/rescript/pull/7247
 
 #### :nail_care: Polish
-
 - Rewatch 1.0.10. https://github.com/rescript-lang/rescript/pull/7259
 
 # 12.0.0-alpha.7

analysis/reanalyze/src/Arnold.ml

@@ -582,7 +582,7 @@ module ExtendFunctionTable = struct
             Texp_apply {funct = {exp_desc = Texp_ident (path, {loc}, _)}; args};
         }
       when kindOpt <> None ->
-      let checkArg ((argLabel : Asttypes.arg_label), _argOpt) =
+      let checkArg ((argLabel : Asttypes.Noloc.arg_label), _argOpt) =
         match (argLabel, kindOpt) with
         | (Labelled l | Optional l), Some kind ->
           kind |> List.for_all (fun {Kind.label} -> label <> l)
@@ -624,7 +624,7 @@ module ExtendFunctionTable = struct
         when callee |> FunctionTable.isInFunctionInTable ~functionTable ->
         let functionName = Path.name callee in
         args
-        |> List.iter (fun ((argLabel : Asttypes.arg_label), argOpt) ->
+        |> List.iter (fun ((argLabel : Asttypes.Noloc.arg_label), argOpt) ->
                match (argLabel, argOpt |> extractLabelledArgument) with
                | Labelled label, Some (path, loc)
                  when path |> FunctionTable.isInFunctionInTable ~functionTable
@@ -672,7 +672,7 @@ module CheckExpressionWellFormed = struct
         ->
         let functionName = Path.name functionPath in
         args
-        |> List.iter (fun ((argLabel : Asttypes.arg_label), argOpt) ->
+        |> List.iter (fun ((argLabel : Asttypes.Noloc.arg_label), argOpt) ->
                match argOpt |> ExtendFunctionTable.extractLabelledArgument with
                | Some (path, loc) -> (
                  match argLabel with
@@ -761,7 +761,7 @@ module Compile = struct
           let argsFromKind =
             innerFunctionDefinition.kind
             |> List.map (fun (entry : Kind.entry) ->
-                   ( Asttypes.Labelled entry.label,
+                   ( Asttypes.Noloc.Labelled entry.label,
                      Some
                        {
                          expr with
@@ -785,7 +785,7 @@ module Compile = struct
             args
             |> List.find_opt (fun arg ->
                    match arg with
-                   | Asttypes.Labelled s, Some _ -> s = label
+                   | Asttypes.Noloc.Labelled s, Some _ -> s = label
                    | _ -> false)
           in
           let argOpt =

analysis/reanalyze/src/DeadValue.ml

@@ -104,7 +104,7 @@ let processOptionalArgs ~expType ~(locFrom : Location.t) ~locTo ~path args =
              | None -> Some false
            in
            match lbl with
-           | Asttypes.Optional s when not locFrom.loc_ghost ->
+           | Asttypes.Noloc.Optional s when not locFrom.loc_ghost ->
              if argIsSupplied <> Some false then supplied := s :: !supplied;
              if argIsSupplied = None then suppliedMaybe := s :: !suppliedMaybe
            | _ -> ());

analysis/src/CompletionBackEnd.ml

@@ -952,7 +952,8 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
           (* compute the application of the first label, then the next ones *)
           let args = processApply args [label] in
           processApply args nextLabels
-        | (Asttypes.Nolabel, _) :: nextArgs, [Asttypes.Nolabel] -> nextArgs
+        | (Asttypes.Noloc.Nolabel, _) :: nextArgs, [Asttypes.Noloc.Nolabel] ->
+          nextArgs
         | ((Labelled _, _) as arg) :: nextArgs, [Nolabel] ->
           arg :: processApply nextArgs labels
         | (Optional _, _) :: nextArgs, [Nolabel] -> processApply nextArgs labels
@@ -1007,9 +1008,9 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
             synthetic = true;
             contextPath =
               (match cp with
-              | CPApply (c, args) -> CPApply (c, args @ [Asttypes.Nolabel])
+              | CPApply (c, args) -> CPApply (c, args @ [Asttypes.Noloc.Nolabel])
               | CPId _ when TypeUtils.isFunctionType ~env ~package typ ->
-                CPApply (cp, [Asttypes.Nolabel])
+                CPApply (cp, [Asttypes.Noloc.Nolabel])
               | _ -> cp);
             id = fieldName;
             inJsx = false;

analysis/src/CompletionFrontEnd.ml

@@ -298,7 +298,10 @@ let rec exprToContextPathInner (e : Parsetree.expression) =
   | Pexp_apply {funct = e1; args} -> (
     match exprToContextPath e1 with
     | None -> None
-    | Some contexPath -> Some (CPApply (contexPath, args |> List.map fst)))
+    | Some contexPath ->
+      Some
+        (CPApply (contexPath, args |> List.map fst |> List.map Asttypes.to_noloc))
+    )
   | Pexp_tuple exprs ->
     let exprsAsContextPaths = exprs |> List.filter_map exprToContextPath in
     if List.length exprs = List.length exprsAsContextPaths then
@@ -1446,8 +1449,8 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
                        (match lbl with
                        | Nolabel ->
                          Unlabelled {argumentPosition = currentUnlabelledCount}
-                       | Optional name -> Optional name
-                       | Labelled name -> Labelled name);
+                       | Optional {txt = name} -> Optional name
+                       | Labelled {txt = name} -> Labelled name);
                    })
           in
           (match defaultExpOpt with

analysis/src/CompletionJsx.ml

@@ -465,20 +465,19 @@ let extractJsxProps ~(compName : Longident.t Location.loc) ~args =
   in
   let rec processProps ~acc args =
     match args with
-    | (Asttypes.Labelled "children", {Parsetree.pexp_loc}) :: _ ->
+    | (Asttypes.Labelled {txt = "children"}, {Parsetree.pexp_loc}) :: _ ->
       {
         compName;
         props = List.rev acc;
         childrenStart =
           (if pexp_loc.loc_ghost then None else Some (Loc.start pexp_loc));
       }
-    | ((Labelled s | Optional s), (eProp : Parsetree.expression)) :: rest -> (
-      let namedArgLoc =
-        eProp.pexp_attributes
-        |> List.find_opt (fun ({Asttypes.txt}, _) -> txt = "res.namedArgLoc")
-      in
+    | ( (Labelled {txt = s; loc} | Optional {txt = s; loc}),
+        (eProp : Parsetree.expression) )
+      :: rest -> (
+      let namedArgLoc = if loc = Location.none then None else Some loc in
       match namedArgLoc with
-      | Some ({loc}, _) ->
+      | Some loc ->
         processProps
           ~acc:
             ({

analysis/src/CreateInterface.ml

@@ -170,7 +170,7 @@ let printSignature ~extractor ~signature =
             in
             let lblName = labelDecl.ld_id |> Ident.name in
             let lbl =
-              if labelDecl.ld_optional then Asttypes.Optional lblName
+              if labelDecl.ld_optional then Asttypes.Noloc.Optional lblName
               else Labelled lblName
             in
             {

analysis/src/DumpAst.ml

@@ -219,8 +219,8 @@ and printExprItem expr ~pos ~indentation =
     ^ "arg: "
     ^ (match arg with
       | Nolabel -> "Nolabel"
-      | Labelled name -> "Labelled(" ^ name ^ ")"
-      | Optional name -> "Optional(" ^ name ^ ")")
+      | Labelled {txt = name} -> "Labelled(" ^ name ^ ")"
+      | Optional {txt = name} -> "Optional(" ^ name ^ ")")
     ^ ",\n"
     ^ addIndentation (indentation + 2)
     ^ "pattern: "

analysis/src/SemanticTokens.ml

@@ -266,7 +266,7 @@ let command ~debug ~emitter ~path =
 
       let posOfGreatherthanAfterProps =
         let rec loop = function
-          | (Asttypes.Labelled "children", {Parsetree.pexp_loc}) :: _ ->
+          | (Asttypes.Labelled {txt = "children"}, {Parsetree.pexp_loc}) :: _ ->
             Loc.start pexp_loc
           | _ :: args -> loop args
           | [] -> (* should not happen *) (-1, -1)

analysis/src/SharedTypes.ml

@@ -4,7 +4,7 @@ let ident l = l |> List.map str |> String.concat "."
 
 type path = string list
 
-type typedFnArg = Asttypes.arg_label * Types.type_expr
+type typedFnArg = Asttypes.Noloc.arg_label * Types.type_expr
 
 let pathToString (path : path) = path |> String.concat "."
 
@@ -605,7 +605,7 @@ module Completable = struct
     | CPFloat
     | CPBool
     | CPOption of contextPath
-    | CPApply of contextPath * Asttypes.arg_label list
+    | CPApply of contextPath * Asttypes.Noloc.arg_label list
     | CPId of {
         path: string list;
         completionContext: completionContext;
@@ -692,7 +692,7 @@ module Completable = struct
       contextPathToString cp ^ "("
       ^ (labels
         |> List.map (function
-             | Asttypes.Nolabel -> "Nolabel"
+             | Asttypes.Noloc.Nolabel -> "Nolabel"
              | Labelled s -> "~" ^ s
              | Optional s -> "?" ^ s)
         |> String.concat ", ")
@@ -898,14 +898,12 @@ type arg = {label: label; exp: Parsetree.expression}
 let extractExpApplyArgs ~args =
   let rec processArgs ~acc args =
     match args with
-    | (((Asttypes.Labelled s | Optional s) as label), (e : Parsetree.expression))
+    | ( ((Asttypes.Labelled {txt = s; loc} | Optional {txt = s; loc}) as label),
+        (e : Parsetree.expression) )
       :: rest -> (
-      let namedArgLoc =
-        e.pexp_attributes
-        |> List.find_opt (fun ({Asttypes.txt}, _) -> txt = "res.namedArgLoc")
-      in
+      let namedArgLoc = if loc = Location.none then None else Some loc in
       match namedArgLoc with
-      | Some ({loc}, _) ->
+      | Some loc ->
         let labelled =
           {
             name = s;
@@ -919,7 +917,7 @@ let extractExpApplyArgs ~args =
         in
         processArgs ~acc:({label = Some labelled; exp = e} :: acc) rest
       | None -> processArgs ~acc rest)
-    | (Asttypes.Nolabel, (e : Parsetree.expression)) :: rest ->
+    | (Nolabel, (e : Parsetree.expression)) :: rest ->
       if e.pexp_loc.loc_ghost then processArgs ~acc rest
       else processArgs ~acc:({label = None; exp = e} :: acc) rest
     | [] -> List.rev acc

analysis/src/SignatureHelp.ml

@@ -154,14 +154,14 @@ let findActiveParameter ~argAtCursor ~args =
     (* If a function only has one, unlabelled argument, we can safely assume that's active whenever we're in the signature help for that function,
        even if we technically didn't find anything at the cursor (which we don't for empty expressions). *)
     match args with
-    | [(Asttypes.Nolabel, _)] -> Some 0
+    | [(Asttypes.Noloc.Nolabel, _)] -> Some 0
     | _ -> None)
   | Some (Unlabelled unlabelledArgumentIndex) ->
     let index = ref 0 in
     args
     |> List.find_map (fun (label, _) ->
            match label with
-           | Asttypes.Nolabel when !index = unlabelledArgumentIndex ->
+           | Asttypes.Noloc.Nolabel when !index = unlabelledArgumentIndex ->
              Some !index
            | _ ->
              index := !index + 1;
@@ -171,7 +171,7 @@ let findActiveParameter ~argAtCursor ~args =
     args
     |> List.find_map (fun (label, _) ->
            match label with
-           | (Asttypes.Labelled labelName | Optional labelName)
+           | (Asttypes.Noloc.Labelled labelName | Optional labelName)
              when labelName = name ->
              Some !index
            | _ ->
@@ -474,6 +474,7 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
                     parameters =
                       parameters
                       |> List.map (fun (argLabel, start, end_) ->
+                             let argLabel = Asttypes.to_noloc argLabel in
                              let paramArgCount = !paramUnlabelledArgCount in
                              paramUnlabelledArgCount := paramArgCount + 1;
                              let unlabelledArgCount = ref 0 in
@@ -486,8 +487,8 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
                                            let argCount = !unlabelledArgCount in
                                            unlabelledArgCount := argCount + 1;
                                            match (lbl, argLabel) with
-                                           | ( Asttypes.Optional l1,
-                                               Asttypes.Optional l2 )
+                                           | ( Asttypes.Noloc.Optional l1,
+                                               Asttypes.Noloc.Optional l2 )
                                              when l1 = l2 ->
                                              true
                                            | Labelled l1, Labelled l2

analysis/src/TypeUtils.ml

@@ -1123,7 +1123,7 @@ let getFirstFnUnlabelledArgType ~env ~full t =
   in
   let rec findFirstUnlabelledArgType labels =
     match labels with
-    | (Asttypes.Nolabel, t) :: _ -> Some t
+    | (Asttypes.Noloc.Nolabel, t) :: _ -> Some t
     | _ :: rest -> findFirstUnlabelledArgType rest
     | [] -> None
   in

compiler/frontend/ast_compatible.ml

@@ -117,22 +117,29 @@ let apply_labels ?(loc = default_loc) ?(attrs = []) fn
       Pexp_apply
         {
           funct = fn;
-          args = Ext_list.map args (fun (l, a) -> (Asttypes.Labelled l, a));
+          args =
+            Ext_list.map args (fun (l, a) ->
+                (Asttypes.Labelled {txt = l; loc = Location.none}, a));
           partial = false;
         };
   }
 
-let label_arrow ?(loc = default_loc) ?(attrs = []) ~arity s arg ret : core_type
-    =
+let label_arrow ?(loc = default_loc) ?(attrs = []) ~arity txt arg ret :
+    core_type =
   {
-    ptyp_desc = Ptyp_arrow {lbl = Labelled s; arg; ret; arity};
+    ptyp_desc =
+      Ptyp_arrow
+        {lbl = Asttypes.Labelled {txt; loc = default_loc}; arg; ret; arity};
     ptyp_loc = loc;
     ptyp_attributes = attrs;
   }
 
-let opt_arrow ?(loc = default_loc) ?(attrs = []) ~arity s arg ret : core_type =
+let opt_arrow ?(loc = default_loc) ?(attrs = []) ~arity txt arg ret : core_type
+    =
   {
-    ptyp_desc = Ptyp_arrow {lbl = Asttypes.Optional s; arg; ret; arity};
+    ptyp_desc =
+      Ptyp_arrow
+        {lbl = Asttypes.Optional {txt; loc = default_loc}; arg; ret; arity};
     ptyp_loc = loc;
     ptyp_attributes = attrs;
   }

compiler/frontend/ast_external_process.ml

@@ -471,7 +471,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
               | _ ->
                 Location.raise_errorf ~loc
                   "expect label, optional, or unit here")
-            | Labelled label -> (
+            | Labelled {txt = label} -> (
               let field_name =
                 match
                   Ast_attributes.iter_process_bs_string_as param_type.attr
@@ -530,7 +530,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
               | Unwrap ->
                 Location.raise_errorf ~loc
                   "%@obj label %s does not support %@unwrap arguments" label)
-            | Optional label -> (
+            | Optional {txt = label} -> (
               let field_name =
                 match
                   Ast_attributes.iter_process_bs_string_as param_type.attr
@@ -983,7 +983,7 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type)
                 arg_type,
                 new_arg_types ) =
             match arg_label with
-            | Optional s -> (
+            | Optional {txt = s} -> (
               let arg_type = get_opt_arg_type ~nolabel:false ty in
               match arg_type with
               | Poly_var _ ->

compiler/gentype/TranslateCoreType.ml

@@ -1,7 +1,7 @@
 open GenTypeCommon
 open! TranslateTypeExprFromTypes
 
-let remove_option ~(label : Asttypes.arg_label)
+let remove_option ~(label : Asttypes.Noloc.arg_label)
     (core_type : Typedtree.core_type) =
   match (core_type.ctyp_desc, label) with
   | Ttyp_constr (Path.Pident id, _, [t]), Optional lbl

compiler/gentype/TranslateTypeExprFromTypes.ml

@@ -2,7 +2,7 @@ open GenTypeCommon
 
 type translation = {dependencies: dep list; type_: type_}
 
-let rec remove_option ~(label : Asttypes.arg_label)
+let rec remove_option ~(label : Asttypes.Noloc.arg_label)
     (type_expr : Types.type_expr) =
   match (type_expr.desc, label) with
   | Tconstr (Path.Pident id, [t], _), Optional lbl when Ident.name id = "option"

compiler/ml/ast_helper.ml

@@ -82,8 +82,8 @@ module Typ = struct
         | Ptyp_var x ->
           check_variable var_names t.ptyp_loc x;
           Ptyp_var x
-        | Ptyp_arrow {lbl = label; arg; ret; arity = a} ->
-          Ptyp_arrow {lbl = label; arg = loop arg; ret = loop ret; arity = a}
+        | Ptyp_arrow ({arg; ret} as arr) ->
+          Ptyp_arrow {arr with arg = loop arg; ret = loop ret}
         | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
         | Ptyp_constr ({txt = Longident.Lident s}, []) when List.mem s var_names
           ->

compiler/ml/ast_mapper_from0.ml

@@ -99,6 +99,7 @@ module T = struct
     | Ptyp_any -> any ~loc ~attrs ()
     | Ptyp_var s -> var ~loc ~attrs s
     | Ptyp_arrow (lab, t1, t2) ->
+      let lab = Asttypes.to_arg_label lab in
       arrow ~loc ~attrs ~arity:None lab (sub.typ sub t1) (sub.typ sub t2)
     | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl)
     | Ptyp_constr (lid, tl) -> (
@@ -304,6 +305,7 @@ module E = struct
     | Pexp_let (r, vbs, e) ->
       let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e)
     | Pexp_fun (lab, def, p, e) ->
+      let lab = Asttypes.to_arg_label lab in
       let async = Ext_list.exists attrs (fun ({txt}, _) -> txt = "res.async") in
       fun_ ~loc ~attrs ~async ~arity:None lab
         (map_opt (sub.expr sub) def)
@@ -349,7 +351,9 @@ module E = struct
       in
       let partial, attrs = process_partial_app_attribute attrs in
       apply ~loc ~attrs ~partial (sub.expr sub e)
-        (List.map (map_snd (sub.expr sub)) l)
+        (List.map
+           (fun (lbl, e) -> (Asttypes.to_arg_label lbl, sub.expr sub e))
+           l)
     | Pexp_match (e, pel) ->
       match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
     | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)