Migrate typed tree to use AST with locs for fn arguments (#7873)

* migrate function arguments to use the AST node that includes locations in the typed tree as well

* fix signature help after refactor

* changelog

Author: zth

CHANGELOG.md

@@ -26,6 +26,8 @@
 
 #### :house: Internal
 
+- Use AST nodes with locations for fn arguments in the typed tree. https://github.com/rescript-lang/rescript/pull/7873
+
 # 12.0.0-beta.14
 
 #### :boom: Breaking Change

analysis/reanalyze/src/Arnold.ml

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

analysis/reanalyze/src/DeadOptionalArgs.ml

@@ -40,7 +40,7 @@ let rec hasOptionalArgs (texpr : Types.type_expr) =
 let rec fromTypeExpr (texpr : Types.type_expr) =
   match texpr.desc with
   | _ when not (active ()) -> []
-  | Tarrow ({lbl = Optional s}, tTo, _, _) -> s :: fromTypeExpr tTo
+  | Tarrow ({lbl = Optional {txt = s}}, tTo, _, _) -> s :: fromTypeExpr tTo
   | Tarrow (_, tTo, _, _) -> fromTypeExpr tTo
   | Tlink t -> fromTypeExpr t
   | Tsubst t -> fromTypeExpr t

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.Noloc.Optional s when not locFrom.loc_ghost ->
+           | Asttypes.Optional {txt = 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

@@ -1075,13 +1075,12 @@ 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.Noloc.Nolabel, _) :: nextArgs, [Asttypes.Noloc.Nolabel] ->
-          nextArgs
+        | (Asttypes.Nolabel, _) :: nextArgs, [Asttypes.Nolabel] -> nextArgs
         | ((Labelled _, _) as arg) :: nextArgs, [Nolabel] ->
           arg :: processApply nextArgs labels
         | (Optional _, _) :: nextArgs, [Nolabel] -> processApply nextArgs labels
-        | ( (((Labelled s1 | Optional s1), _) as arg) :: nextArgs,
-            [(Labelled s2 | Optional s2)] ) ->
+        | ( (((Labelled {txt = s1} | Optional {txt = s1}), _) as arg) :: nextArgs,
+            [(Labelled {txt = s2} | Optional {txt = s2})] ) ->
           if s1 = s2 then nextArgs else arg :: processApply nextArgs labels
         | ((Nolabel, _) as arg) :: nextArgs, [(Labelled _ | Optional _)] ->
           arg :: processApply nextArgs labels
@@ -1132,9 +1131,9 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
             synthetic = true;
             contextPath =
               (match cp with
-              | CPApply (c, args) -> CPApply (c, args @ [Asttypes.Noloc.Nolabel])
+              | CPApply (c, args) -> CPApply (c, args @ [Asttypes.Nolabel])
               | CPId _ when TypeUtils.isFunctionType ~env ~package typ ->
-                CPApply (cp, [Asttypes.Noloc.Nolabel])
+                CPApply (cp, [Asttypes.Nolabel])
               | _ -> cp);
             id = fieldName;
             inJsx;
@@ -1893,8 +1892,8 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens
           args
           |> List.map (fun ((label, typ) : typedFnArg) ->
                  match label with
-                 | Optional name -> "~" ^ name ^ "=?"
-                 | Labelled name -> "~" ^ name
+                 | Optional {txt = name} -> "~" ^ name ^ "=?"
+                 | Labelled {txt = name} -> "~" ^ name
                  | Nolabel ->
                    if TypeUtils.typeIsUnit typ then "()"
                    else (

analysis/src/CompletionFrontEnd.ml

@@ -303,10 +303,7 @@ let rec exprToContextPathInner ~(inJsxContext : bool) (e : Parsetree.expression)
   | Pexp_apply {funct = e1; args} -> (
     match exprToContextPath ~inJsxContext e1 with
     | None -> None
-    | Some contexPath ->
-      Some
-        (CPApply (contexPath, args |> List.map fst |> List.map Asttypes.to_noloc))
-    )
+    | Some contexPath -> Some (CPApply (contexPath, args |> List.map fst)))
   | Pexp_tuple exprs ->
     let exprsAsContextPaths =
       exprs |> List.filter_map (exprToContextPath ~inJsxContext)

analysis/src/CreateInterface.ml

@@ -173,8 +173,9 @@ let printSignature ~extractor ~signature =
             in
             let lblName = labelDecl.ld_id |> Ident.name in
             let lbl =
-              if labelDecl.ld_optional then Asttypes.Noloc.Optional lblName
-              else Labelled lblName
+              if labelDecl.ld_optional then
+                Asttypes.Optional {txt = lblName; loc = Location.none}
+              else Asttypes.Labelled {txt = lblName; loc = Location.none}
             in
             {
               retType with

analysis/src/SharedTypes.ml

@@ -4,7 +4,7 @@ let ident l = l |> List.map str |> String.concat "."
 
 type path = string list
 
-type typedFnArg = Asttypes.Noloc.arg_label * Types.type_expr
+type typedFnArg = Asttypes.arg_label * Types.type_expr
 
 let pathToString (path : path) = path |> String.concat "."
 
@@ -619,7 +619,7 @@ module Completable = struct
     | CPFloat
     | CPBool
     | CPOption of contextPath
-    | CPApply of contextPath * Asttypes.Noloc.arg_label list
+    | CPApply of contextPath * Asttypes.arg_label list
     | CPId of {
         path: string list;
         completionContext: completionContext;
@@ -708,9 +708,9 @@ module Completable = struct
       contextPathToString cp ^ "("
       ^ (labels
         |> List.map (function
-             | Asttypes.Noloc.Nolabel -> "Nolabel"
-             | Labelled s -> "~" ^ s
-             | Optional s -> "?" ^ s)
+             | Asttypes.Nolabel -> "Nolabel"
+             | Labelled {txt} -> "~" ^ txt
+             | Optional {txt} -> "?" ^ txt)
         |> String.concat ", ")
       ^ ")"
     | CPArray (Some ctxPath) -> "array<" ^ contextPathToString ctxPath ^ ">"

analysis/src/SignatureHelp.ml

@@ -152,14 +152,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.Noloc.Nolabel, _)] -> Some 0
+    | [(Asttypes.Nolabel, _)] -> Some 0
     | _ -> None)
   | Some (Unlabelled unlabelledArgumentIndex) ->
     let index = ref 0 in
     args
     |> List.find_map (fun (label, _) ->
            match label with
-           | Asttypes.Noloc.Nolabel when !index = unlabelledArgumentIndex ->
+           | Asttypes.Nolabel when !index = unlabelledArgumentIndex ->
              Some !index
            | _ ->
              index := !index + 1;
@@ -169,7 +169,7 @@ let findActiveParameter ~argAtCursor ~args =
     args
     |> List.find_map (fun (label, _) ->
            match label with
-           | (Asttypes.Noloc.Labelled labelName | Optional labelName)
+           | (Asttypes.Labelled {txt = labelName} | Optional {txt = labelName})
              when labelName = name ->
              Some !index
            | _ ->
@@ -472,7 +472,6 @@ 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
@@ -485,11 +484,12 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
                                            let argCount = !unlabelledArgCount in
                                            unlabelledArgCount := argCount + 1;
                                            match (lbl, argLabel) with
-                                           | ( Asttypes.Noloc.Optional l1,
-                                               Asttypes.Noloc.Optional l2 )
+                                           | ( Asttypes.Optional {txt = l1},
+                                               Asttypes.Optional {txt = l2} )
                                              when l1 = l2 ->
                                              true
-                                           | Labelled l1, Labelled l2
+                                           | ( Labelled {txt = l1},
+                                               Labelled {txt = l2} )
                                              when l1 = l2 ->
                                              true
                                            | Nolabel, Nolabel

analysis/src/TypeUtils.ml

@@ -902,10 +902,10 @@ let getArgs ~env (t : Types.type_expr) ~full =
     match t.desc with
     | Tlink t1 | Tsubst t1 | Tpoly (t1, []) ->
       getArgsLoop ~full ~env ~currentArgumentPosition t1
-    | Tarrow ({lbl = Labelled l; typ = tArg}, tRet, _, _) ->
+    | Tarrow ({lbl = Labelled {txt = l}; typ = tArg}, tRet, _, _) ->
       (SharedTypes.Completable.Labelled l, tArg)
       :: getArgsLoop ~full ~env ~currentArgumentPosition tRet
-    | Tarrow ({lbl = Optional l; typ = tArg}, tRet, _, _) ->
+    | Tarrow ({lbl = Optional {txt = l}; typ = tArg}, tRet, _, _) ->
       (Optional l, tArg) :: getArgsLoop ~full ~env ~currentArgumentPosition tRet
     | Tarrow ({lbl = Nolabel; typ = tArg}, tRet, _, _) ->
       (Unlabelled {argumentPosition = currentArgumentPosition}, tArg)
@@ -1144,7 +1144,7 @@ let getFirstFnUnlabelledArgType ~env ~full t =
   in
   let rec findFirstUnlabelledArgType labels =
     match labels with
-    | (Asttypes.Noloc.Nolabel, t) :: _ -> Some t
+    | (Asttypes.Nolabel, t) :: _ -> Some t
     | _ :: rest -> findFirstUnlabelledArgType rest
     | [] -> None
   in