Remove parser modes

CHANGELOG.md

@@ -38,6 +38,8 @@
 
 - Fix the side-effect analysis treating bigint exponentiation and bounds-checked array and string reads as pure, which let dead-code elimination drop an unused one that throws: `let _ = 2n ** -1n` no longer raised. https://github.com/rescript-lang/rescript/pull/8617
 - Preserve record field `@as` annotations when formatting object types containing spreads. https://github.com/rescript-lang/rescript/pull/8619
+- Fix record-field completion inside constructor tuple payloads and for their destructured bindings, including both supported tuple spellings and polymorphic variants. https://github.com/rescript-lang/rescript/pull/8610
+- Limit constructor signature help to the argument parentheses, excluding whitespace and comments between the constructor name and its arguments, and keep unary tuple payloads on parameter zero. https://github.com/rescript-lang/rescript/pull/8610
 - Fix excessive parentheses and indentation in function assignments to refs, align record and array assignment formatting across refs and fields, and preserve function return-type parentheses and consistent JSX fragment layout in callbacks. https://github.com/rescript-lang/rescript/pull/8611
 - Report an error instead of crashing when an integer in a variant constructor's `@as` annotation exceeds the compiler's integer range. https://github.com/rescript-lang/rescript/pull/8619
 - Warn about an `@as` on a record field whose payload does not name the field, such as `@as(42)`. It renamed nothing and was silently accepted. https://github.com/rescript-lang/rescript/pull/8619
@@ -79,6 +81,7 @@
 - Record a record field's `@as` rename on the declaration instead of re-reading the attribute, so every place that needs the runtime name reads one field. https://github.com/rescript-lang/rescript/pull/8619
 - Record a variant constructor's `@as` tag on the declaration instead of re-interpreting its attributes, keeping the source spelling for printing. https://github.com/rescript-lang/rescript/pull/8619
 - Optimization passes now return the term they were given when they change nothing, rather than rebuilding an identical one. https://github.com/rescript-lang/rescript/pull/8620
+- Remove separate parser modes for printing and type checking by preserving syntactic constructor arguments and their source locations in the parsetree and resolving their semantic grouping during type checking. Existing constructor spellings and legacy PPX output remain supported. https://github.com/rescript-lang/rescript/pull/8610
 - Merge the duplicate Lam intermediate representation into Lambda, removing the conversion layer and obsolete supporting infrastructure. Lambda is now a single private, normalized representation, with generated JavaScript remaining semantically unchanged. https://github.com/rescript-lang/rescript/pull/8608
 - Add genType and source map controls and output to the developer playground. https://github.com/rescript-lang/rescript/pull/8448
 - Rework the object-type representation end to end: object rows are plain field chains carrying a per-field mutability state (no phantom setter members), object literals are typed directly and property access and assignment are first-class AST and Lambda nodes shared between the Lambda and JS pipelines, and dead class-system remnants (the field-presence lattice, the class-abbreviation memo on object types, method-send typing) are removed. https://github.com/rescript-lang/rescript/pull/8597

analysis/reanalyze/src/annotation.ml

@@ -30,10 +30,14 @@ let rec get_attribute_payload check_text (attributes : Typedtree.attributes) =
        _;
       } ->
         Some (BoolPayload (s = "true"))
-      | {pexp_desc = Pexp_construct ({txt = Longident.Lident "[]"}, None)} ->
+      | {pexp_desc = Pexp_construct ({txt = Longident.Lident "[]"}, {txt = []})}
+        ->
         None
-      | {pexp_desc = Pexp_construct ({txt = Longident.Lident "::"}, Some e)} ->
-        from_expr e
+      | {
+       pexp_desc =
+         Pexp_construct ({txt = Longident.Lident "::"}, {txt = [head; tail]});
+      } ->
+        from_expr {expr with pexp_desc = Pexp_tuple [head; tail]}
       | {pexp_desc = Pexp_construct ({txt}, _); _} ->
         Some (ConstructPayload (txt |> Longident.flatten |> String.concat "."))
       | {pexp_desc = Pexp_tuple exprs | Pexp_array exprs} ->

analysis/src/codemod.ml

@@ -13,8 +13,8 @@ let transform_opt ~source ~pos ~debug ~typ ~hint =
     | AddMissingCases -> (
       let source = "let " ^ hint ^ " = ()" in
       let {Res_driver.parsetree = hint_structure} =
-        Res_driver.parse_implementation_from_source ~for_printer:false
-          ~display_filename:"<none>" ~source
+        Res_driver.parse_implementation_from_source ~display_filename:"<none>"
+          ~source
       in
       match hint_structure with
       | [{pstr_desc = Pstr_value (_, [{pvb_pat = pattern}])}] -> (

analysis/src/commands.ml

@@ -304,8 +304,7 @@ let format ~source ~kind_file =
     match kind_file with
     | Files.Res -> (
       let {Res_driver.parsetree = structure; comments; diagnostics} =
-        Res_driver.parsing_engine.parse_implementation_from_source
-          ~for_printer:true ~source
+        Res_driver.parsing_engine.parse_implementation_from_source ~source
       in
       match List.length diagnostics > 0 with
       | true -> Error "Document has syntax errors"
@@ -314,8 +313,7 @@ let format ~source ~kind_file =
       )
     | Resi -> (
       let {Res_driver.parsetree = signature; comments; diagnostics} =
-        Res_driver.parsing_engine.parse_interface_from_source ~for_printer:true
-          ~source
+        Res_driver.parsing_engine.parse_interface_from_source ~source
       in
       match List.length diagnostics > 0 with
       | true -> Error "Document has syntax errors"

analysis/src/completion_expressions.ml

@@ -5,11 +5,6 @@ let is_expr_hole exp =
   | Pexp_extension ({txt = "rescript.exprhole"}, _) -> true
   | _ -> false
 
-let is_expr_tuple expr =
-  match expr.Parsetree.pexp_desc with
-  | Pexp_tuple _ -> true
-  | _ -> false
-
 let rec traverse_expr (exp : Parsetree.expression) ~expr_path ~pos
     ~first_char_before_cursor_no_white =
   let loc_has_cursor loc = loc |> Cursor_position.loc_has_cursor ~pos in
@@ -24,9 +19,10 @@ let rec traverse_expr (exp : Parsetree.expression) ~expr_path ~pos
       (txt, [Completable.NRecordBody {seen_fields = []}] @ expr_path)
   | Pexp_ident {txt = Lident txt} -> some_if_has_cursor (txt, expr_path)
   | Pexp_construct ({txt = Lident "()"}, _) -> some_if_has_cursor ("", expr_path)
-  | Pexp_construct ({txt = Lident txt}, None) ->
+  | Pexp_construct ({txt = Lident txt}, {txt = []}) ->
     some_if_has_cursor (txt, expr_path)
-  | Pexp_variant (label, None) -> some_if_has_cursor ("#" ^ label, expr_path)
+  | Pexp_variant (label, {txt = []}) ->
+    some_if_has_cursor ("#" ^ label, expr_path)
   | Pexp_array array_patterns -> (
     let next_expr_path = [Completable.NArray] @ expr_path in
     (* No fields but still has cursor = empty completion *)
@@ -122,36 +118,33 @@ let rec traverse_expr (exp : Parsetree.expression) ~expr_path ~pos
       | _ -> None))
   | Pexp_construct
       ( {txt},
-        Some {pexp_loc; pexp_desc = Pexp_construct ({txt = Lident "()"}, _)} )
+        {
+          txt = [{pexp_loc; pexp_desc = Pexp_construct ({txt = Lident "()"}, _)}];
+        } )
     when loc_has_cursor pexp_loc ->
     (* Empty payload with cursor, like: Test(<com>) *)
     Some
       ( "",
         [
           Completable.NVariantPayload
-            {constructor_name = Utils.get_unqualified_name txt; item_num = 0};
-        ]
-        @ expr_path )
-  | Pexp_construct ({txt}, Some e)
-    when pos >= (e.pexp_loc |> Loc.end_)
-         && first_char_before_cursor_no_white = Some ','
-         && is_expr_tuple e = false ->
-    (* Empty payload with trailing ',', like: Test(true, <com>) *)
-    Some
-      ( "",
-        [
-          Completable.NVariantPayload
-            {constructor_name = Utils.get_unqualified_name txt; item_num = 1};
+            {
+              constructor_name = Utils.get_unqualified_name txt;
+              item_num = 0;
+              source_arity = 1;
+            };
         ]
         @ expr_path )
-  | Pexp_construct ({txt}, Some {pexp_loc; pexp_desc = Pexp_tuple tuple_items})
-    when loc_has_cursor pexp_loc ->
-    tuple_items
+  | Pexp_construct ({txt}, {txt = args}) when loc_has_cursor exp.pexp_loc ->
+    args
     |> traverse_expr_tuple_items ~first_char_before_cursor_no_white ~pos
          ~next_expr_path:(fun item_num ->
            [
              Completable.NVariantPayload
-               {constructor_name = Utils.get_unqualified_name txt; item_num};
+               {
+                 constructor_name = Utils.get_unqualified_name txt;
+                 item_num;
+                 source_arity = List.length args;
+               };
            ]
            @ expr_path)
          ~result_from_found_item_num:(fun item_num ->
@@ -160,60 +153,47 @@ let rec traverse_expr (exp : Parsetree.expression) ~expr_path ~pos
                {
                  constructor_name = Utils.get_unqualified_name txt;
                  item_num = item_num + 1;
+                 source_arity = List.length args;
                };
            ]
            @ expr_path)
-  | Pexp_construct ({txt}, Some p) when loc_has_cursor exp.pexp_loc ->
-    p
-    |> traverse_expr ~first_char_before_cursor_no_white ~pos
-         ~expr_path:
-           ([
-              Completable.NVariantPayload
-                {
-                  constructor_name = Utils.get_unqualified_name txt;
-                  item_num = 0;
-                };
-            ]
-           @ expr_path)
   | Pexp_variant
-      (txt, Some {pexp_loc; pexp_desc = Pexp_construct ({txt = Lident "()"}, _)})
+      ( txt,
+        {
+          txt = [{pexp_loc; pexp_desc = Pexp_construct ({txt = Lident "()"}, _)}];
+        } )
     when loc_has_cursor pexp_loc ->
     (* Empty payload with cursor, like: #test(<com>) *)
     Some
       ( "",
-        [Completable.NPolyvariantPayload {constructor_name = txt; item_num = 0}]
-        @ expr_path )
-  | Pexp_variant (txt, Some e)
-    when pos >= (e.pexp_loc |> Loc.end_)
-         && first_char_before_cursor_no_white = Some ','
-         && is_expr_tuple e = false ->
-    (* Empty payload with trailing ',', like: #test(true, <com>) *)
-    Some
-      ( "",
-        [Completable.NPolyvariantPayload {constructor_name = txt; item_num = 1}]
+        [
+          Completable.NPolyvariantPayload
+            {constructor_name = txt; item_num = 0; source_arity = 1};
+        ]
         @ expr_path )
-  | Pexp_variant (txt, Some {pexp_loc; pexp_desc = Pexp_tuple tuple_items})
-    when loc_has_cursor pexp_loc ->
-    tuple_items
+  | Pexp_variant (txt, {txt = args}) when loc_has_cursor exp.pexp_loc ->
+    args
     |> traverse_expr_tuple_items ~first_char_before_cursor_no_white ~pos
          ~next_expr_path:(fun item_num ->
-           [Completable.NPolyvariantPayload {constructor_name = txt; item_num}]
+           [
+             Completable.NPolyvariantPayload
+               {
+                 constructor_name = txt;
+                 item_num;
+                 source_arity = List.length args;
+               };
+           ]
            @ expr_path)
          ~result_from_found_item_num:(fun item_num ->
            [
              Completable.NPolyvariantPayload
-               {constructor_name = txt; item_num = item_num + 1};
+               {
+                 constructor_name = txt;
+                 item_num = item_num + 1;
+                 source_arity = List.length args;
+               };
            ]
            @ expr_path)
-  | Pexp_variant (txt, Some p) when loc_has_cursor exp.pexp_loc ->
-    p
-    |> traverse_expr ~first_char_before_cursor_no_white ~pos
-         ~expr_path:
-           ([
-              Completable.NPolyvariantPayload
-                {constructor_name = txt; item_num = 0};
-            ]
-           @ expr_path)
   | _ -> None
 
 and traverse_expr_tuple_items tuple_items ~next_expr_path
@@ -280,35 +260,22 @@ let pretty_print_fn_template_arg_name ?current_index ~env ~state ~full
     | _ -> default_var_name)
 
 let complete_constructor_payload ~pos_before_cursor
-    ~first_char_before_cursor_no_white
+    ~first_char_before_cursor_no_white ~item_num ~source_arity
     (constructor_lid : Longident.t Location.loc) expr =
   match
     traverse_expr expr ~expr_path:[] ~pos:pos_before_cursor
       ~first_char_before_cursor_no_white
   with
   | None -> None
   | Some (prefix, nested) ->
-    (* The nested path must start with the constructor name found, plus
-       the target argument number for the constructor. We translate to
-       that here, because we need to account for multi arg constructors
-       being represented as tuples. *)
     let nested =
-      match List.rev nested with
-      | Completable.NTupleItem {item_num} :: rest ->
-        [
-          Completable.NVariantPayload
-            {constructor_name = Longident.last constructor_lid.txt; item_num};
-        ]
-        @ rest
-      | nested ->
-        [
-          Completable.NVariantPayload
-            {
-              constructor_name = Longident.last constructor_lid.txt;
-              item_num = 0;
-            };
-        ]
-        @ nested
+      Completable.NVariantPayload
+        {
+          constructor_name = Longident.last constructor_lid.txt;
+          item_num;
+          source_arity;
+        }
+      :: List.rev nested
     in
     let variant_ctx_path =
       Completable.CTypeAtPos