Migrate typed tree to use AST with locs for fn arguments

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

compiler/gentype/TranslateCoreType.ml

@@ -1,13 +1,14 @@
 open GenTypeCommon
 open! TranslateTypeExprFromTypes
 
-let remove_option ~(label : Asttypes.Noloc.arg_label)
+let remove_option ~(label : Asttypes.arg_label)
     (core_type : Typedtree.core_type) =
   match (core_type.ctyp_desc, label) with
-  | Ttyp_constr (Path.Pident id, _, [t]), Optional lbl
+  | Ttyp_constr (Path.Pident id, _, [t]), Optional {txt = lbl}
     when Ident.name id = "option" ->
     Some (lbl, t)
-  | Ttyp_constr (Pdot (Path.Pident name_space, id, _), _, [t]), Optional lbl
+  | ( Ttyp_constr (Pdot (Path.Pident name_space, id, _), _, [t]),
+      Optional {txt = lbl} )
     when (* This has a different representation in 4.03+  *)
          Ident.name name_space = "FB" && id = "option" ->
     Some (lbl, t)
@@ -64,7 +65,10 @@ let rec translate_arrow_type ~config ~type_vars_gen
          ~no_function_return_dependencies ~type_env ~rev_arg_deps:next_rev_deps
          ~rev_args:((Nolabel, type_) :: rev_args)
   | Ttyp_arrow
-      ( {lbl = (Labelled lbl | Optional lbl) as label; typ = core_type1},
+      ( {
+          lbl = (Labelled {txt = lbl} | Optional {txt = lbl}) as label;
+          typ = core_type1;
+        },
         core_type2,
         arity )
     when arity = None || rev_args = [] -> (

compiler/gentype/TranslateStructure.ml

@@ -13,7 +13,7 @@ let rec addAnnotationsToTypes_ ~config ~(expr : Typedtree.expression)
     let a_name =
       if a_name = "*opt*" then
         match arg_label with
-        | Optional l -> l
+        | Optional {txt = l} -> l
         | _ -> "" (* should not happen *)
       else a_name
     in

compiler/gentype/TranslateTypeExprFromTypes.ml

@@ -2,11 +2,11 @@ open GenTypeCommon
 
 type translation = {dependencies: dep list; type_: type_}
 
-let rec remove_option ~(label : Asttypes.Noloc.arg_label)
+let rec remove_option ~(label : Asttypes.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"
-    ->
+  | Tconstr (Path.Pident id, [t], _), Optional {txt = lbl}
+    when Ident.name id = "option" ->
     Some (lbl, t)
   | Tlink t, _ -> t |> remove_option ~label
   | _ -> None
@@ -344,7 +344,10 @@ let rec translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps
          ~rev_arg_deps:next_rev_deps
          ~rev_args:((Nolabel, type_) :: rev_args)
   | Tarrow
-      ( {lbl = (Labelled lbl | Optional lbl) as label; typ = type_expr1},
+      ( {
+          lbl = (Labelled {txt = lbl} | Optional {txt = lbl}) as label;
+          typ = type_expr1;
+        },
         type_expr2,
         _,
         arity )

compiler/ml/asttypes.ml

@@ -57,18 +57,6 @@ module Noloc = struct
     | Nolabel (* x => ...*)
     | Labelled of string (*  ~label => ... *)
     | Optional of string (* ~(label=e) => ... *)
-
-  let same_arg_label (x : arg_label) y =
-    match x with
-    | Nolabel -> y = Nolabel
-    | Labelled s -> (
-      match y with
-      | Labelled s0 -> s = s0
-      | _ -> false)
-    | Optional s -> (
-      match y with
-      | Optional s0 -> s = s0
-      | _ -> false)
 end
 
 let to_arg_label ?(loc = Location.none) lbl =

compiler/ml/btype.ml

@@ -593,32 +593,24 @@ let forget_abbrev mem path =
 (**********************************)
 
 let is_optional = function
-  | Noloc.Optional _ -> true
-  | _ -> false
-
-let is_optional_loc = function
   | Optional _ -> true
   | _ -> false
 
 let label_name = function
-  | Noloc.Nolabel -> ""
-  | Labelled s | Optional s -> s
-
-let label_loc_name = function
   | Nolabel -> ""
   | Labelled {txt} | Optional {txt} -> txt
 
 let prefixed_label_name = function
-  | Noloc.Nolabel -> ""
-  | Labelled s -> "~" ^ s
-  | Optional s -> "?" ^ s
+  | Nolabel -> ""
+  | Labelled {txt = s} -> "~" ^ s
+  | Optional {txt = s} -> "?" ^ s
 
 type sargs = (Asttypes.arg_label * Parsetree.expression) list
 
 let rec extract_label_aux hd l = function
   | [] -> None
   | ((l', t) as p) :: ls ->
-    if label_loc_name l' = l then Some (l', t, List.rev_append hd ls)
+    if label_name l' = l then Some (l', t, List.rev_append hd ls)
     else extract_label_aux (p :: hd) l ls
 
 let extract_label l (ls : sargs) :

compiler/ml/btype.mli

@@ -180,13 +180,11 @@ val forget_abbrev : abbrev_memo ref -> Path.t -> unit
 
 (**** Utilities for labels ****)
 
-val is_optional : Noloc.arg_label -> bool
-val is_optional_loc : arg_label -> bool
-val label_name : Noloc.arg_label -> label
-val label_loc_name : arg_label -> label
+val is_optional : arg_label -> bool
+val label_name : arg_label -> label
 
 (* Returns the label name with first character '?' or '~' as appropriate. *)
-val prefixed_label_name : Noloc.arg_label -> label
+val prefixed_label_name : arg_label -> label
 
 type sargs = (arg_label * Parsetree.expression) list