Preserve constructor compatibility without parser modes

Apply the normalization approach proposed by @cristianoc in PR rescript-lang#8610. Keep source argument lists for printing and resolve semantic grouping after constructor disambiguation, without legacy PPX marker handling in the type checker or printer.

Signed-off-by: Christoph Knittel <ck@cca.io>

Author: cknitt

CHANGELOG.md

@@ -14,7 +14,6 @@
 
 #### :boom: Breaking Change
 
-- Distinguish multiple constructor arguments from a tuple passed as a single argument. Constructors with one tuple payload must now use nested parentheses, for example `Some((x, y))`; `Some(x, y)` now reports an arity mismatch. This makes constructor arity explicit in the parsetree and removes the separate parser modes for printing and type checking. https://github.com/rescript-lang/rescript/pull/8610
 - Reject malformed UTF-8 in documentation comments and invalid string or template literal escapes that were previously accepted, including empty or out-of-range braced Unicode escapes (`\u{}`, `\u{110000}`) and legacy decimal or octal escapes in templates (`\1`, `\01`, `\8`). These inputs now produce syntax diagnostics instead of compiling to invalid or inconsistent JavaScript. https://github.com/rescript-lang/rescript/pull/8606
 - Reject tagged template literals in patterns. Patterns cannot invoke their tag; previously their raw payload was compiled as a plain string comparison. https://github.com/rescript-lang/rescript/pull/8606
 - Remove runtime APIs that were deprecated for removal in ReScript 13, including the `Char` module, unsafe `Obj` operations, legacy `Pervasives` helpers, and `Array.unsafe_get`. https://github.com/rescript-lang/rescript/pull/8564
@@ -69,6 +68,7 @@
 
 #### :house: Internal
 
+- Remove separate parser modes for printing and type checking by preserving syntactic constructor arguments 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

compiler/ml/ast_mapper_from0.ml

@@ -166,7 +166,6 @@ let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt}
 let record_rest_attr_name = "_res.record_rest"
 let constructor_args_attr_name = "_res.constructor_args"
 let constructor_tuple_arg_attr_name = "_res.constructor_tuple_arg"
-let legacy_constructor_payload_attr_name = "_res.legacy_constructor_payload"
 
 let has_explicit_arity_attr (attrs : Pt.attributes) =
   List.exists
@@ -190,17 +189,14 @@ let remove_constructor_args_attr attrs =
 let remove_constructor_tuple_arg_attr attrs =
   remove_internal_marker_attr ~name:constructor_tuple_arg_attr_name attrs
 
-let add_legacy_constructor_payload_attr attrs =
-  (Location.mknoloc legacy_constructor_payload_attr_name, Pt.PStr []) :: attrs
-
-let decode_args ~map ~tuple_args ~split_tuple ~known_tuple_arg = function
-  | None -> ([], false)
+(* Unmarked v0 tuples remain a single syntactic payload. Typecore resolves
+   semantic argument grouping after it knows the constructor declaration. *)
+let decode_args ~map ~tuple_args ~split_tuple = function
+  | None -> []
   | Some arg -> (
     match tuple_args arg with
-    | Some args when split_tuple -> (List.map map args, false)
-    | Some _ when known_tuple_arg -> ([map arg], false)
-    | Some _ -> ([map arg], true)
-    | None -> ([map arg], false))
+    | Some args when split_tuple -> List.map map args
+    | _ -> [map arg])
 
 let record_rest_of_pattern (rest : Pt.pattern) =
   match rest.Pt.ppat_desc with
@@ -887,10 +883,8 @@ module E = struct
     | Pexp_construct (lid, arg) -> (
       let lid1 = map_loc sub lid in
       let has_constructor_args, attrs = remove_constructor_args_attr attrs in
-      let has_constructor_tuple_arg, attrs =
-        remove_constructor_tuple_arg_attr attrs
-      in
-      let args, has_legacy_constructor_payload =
+      let _, attrs = remove_constructor_tuple_arg_attr attrs in
+      let args =
         decode_args ~map:(sub.expr sub)
           ~tuple_args:(fun arg ->
             match arg.pexp_desc with
@@ -900,12 +894,7 @@ module E = struct
             (has_constructor_args
             || has_explicit_arity_attr attrs
             || lid.txt = Longident.Lident "::")
-          ~known_tuple_arg:has_constructor_tuple_arg arg
-      in
-      let attrs =
-        if has_legacy_constructor_payload then
-          add_legacy_constructor_payload_attr attrs
-        else attrs
+          arg
       in
       let exp1 = construct ~loc ~attrs lid1 args in
       match lid.txt with
@@ -974,17 +963,14 @@ module E = struct
           :: attrs
         | _ -> attrs
       in
-      let has_constructor_tuple_arg, attrs =
-        remove_constructor_tuple_arg_attr attrs
-      in
-      let args, _ =
+      let _, attrs = remove_constructor_tuple_arg_attr attrs in
+      let args =
         decode_args ~map:(sub.expr sub)
           ~tuple_args:(fun arg ->
             match arg.pexp_desc with
             | Pexp_tuple args -> Some args
             | _ -> None)
-          ~split_tuple:has_constructor_args
-          ~known_tuple_arg:has_constructor_tuple_arg arg
+          ~split_tuple:has_constructor_args arg
       in
       variant ~loc ~attrs lab args
     | Pexp_record (l, eo) ->
@@ -1155,10 +1141,8 @@ module P = struct
     | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl)
     | Ppat_construct (l, arg) ->
       let has_constructor_args, attrs = remove_constructor_args_attr attrs in
-      let has_constructor_tuple_arg, attrs =
-        remove_constructor_tuple_arg_attr attrs
-      in
-      let args, has_legacy_constructor_payload =
+      let _, attrs = remove_constructor_tuple_arg_attr attrs in
+      let args =
         decode_args ~map:(sub.pat sub)
           ~tuple_args:(fun arg ->
             match arg.ppat_desc with
@@ -1168,12 +1152,7 @@ module P = struct
             (has_constructor_args
             || has_explicit_arity_attr attrs
             || l.txt = Longident.Lident "::")
-          ~known_tuple_arg:has_constructor_tuple_arg arg
-      in
-      let attrs =
-        if has_legacy_constructor_payload then
-          add_legacy_constructor_payload_attr attrs
-        else attrs
+          arg
       in
       construct ~loc ~attrs (map_loc sub l) args
     | Ppat_variant (l, arg) ->
@@ -1186,17 +1165,14 @@ module P = struct
           :: attrs
         | _ -> attrs
       in
-      let has_constructor_tuple_arg, attrs =
-        remove_constructor_tuple_arg_attr attrs
-      in
-      let args, _ =
+      let _, attrs = remove_constructor_tuple_arg_attr attrs in
+      let args =
         decode_args ~map:(sub.pat sub)
           ~tuple_args:(fun arg ->
             match arg.ppat_desc with
             | Ppat_tuple args -> Some args
             | _ -> None)
-          ~split_tuple:has_constructor_args
-          ~known_tuple_arg:has_constructor_tuple_arg arg
+          ~split_tuple:has_constructor_args arg
       in
       variant ~loc ~attrs l args
     | Ppat_record (lpl, cf) ->

compiler/ml/parsetree.ml

@@ -220,6 +220,9 @@ and pattern_desc =
        C(P)               [P]
        C(P1, ..., Pn)     [P1; ...; Pn]
        C((P1, ..., Pn))   [Ppat_tuple [P1; ...; Pn]]
+
+       This list preserves syntax, not the declared constructor arity.
+       Type checking normalizes tuple grouping using the resolved constructor.
     *)
   | Ppat_variant of label * pattern list
     (* #A                  []
@@ -312,6 +315,9 @@ and expression_desc =
        C(E)               [E]
        C(E1, ..., En)     [E1; ...; En]
        C((E1, ..., En))   [Pexp_tuple [E1; ...; En]]
+
+       This list preserves syntax, not the declared constructor arity.
+       Type checking normalizes tuple grouping using the resolved constructor.
     *)
   | Pexp_variant of label * expression list
     (* #A                  []

compiler/ml/typecore.ml

@@ -1212,23 +1212,32 @@ type type_pat_mode =
 
 exception Need_backtrack
 
+(* The parser preserves syntactic arguments for printing. Resolve their semantic
+   grouping only after constructor disambiguation, retaining the historical
+   equivalence of C(a, b) and C((a, b)), including for legacy PPX output. *)
+let constructor_args_of_exp_payload ~arity sargs =
+  match sargs with
+  | [{pexp_desc = Pexp_tuple args}] when arity > 1 -> args
+  | {pexp_loc = first_loc} :: (_ :: _ as rest) when arity = 1 ->
+    let last = Ext_list.last rest in
+    let loc = Location.{first_loc with loc_end = last.pexp_loc.loc_end} in
+    [Ast_helper.Exp.tuple ~loc sargs]
+  | sargs -> sargs
+
+let constructor_args_of_pat_payload ~arity sargs =
+  match sargs with
+  | [{ppat_desc = Ppat_tuple args}] when arity > 1 -> args
+  | {ppat_loc = first_loc} :: (_ :: _ as rest) when arity = 1 ->
+    let last = Ext_list.last rest in
+    let loc = Location.{first_loc with loc_end = last.ppat_loc.loc_end} in
+    [Ast_helper.Pat.tuple ~loc sargs]
+  | sargs -> sargs
+
 (* type_pat propagates the expected type as well as maps for
    constructors and labels.
    Unification may update the typing environment. *)
 (* constrs <> None => called from parmatch: backtrack on or-patterns
    explode > 0 => explode Ppat_any for gadts *)
-let legacy_constructor_payload_attr_name = "_res.legacy_constructor_payload"
-
-let remove_legacy_constructor_payload_attr attrs =
-  let rec loop rev_attrs = function
-    | ({Location.txt; _}, PStr []) :: attrs
-      when txt = legacy_constructor_payload_attr_name ->
-      (true, List.rev_append rev_attrs attrs)
-    | attr :: attrs -> loop (attr :: rev_attrs) attrs
-    | [] -> (false, List.rev rev_attrs)
-  in
-  loop [] attrs
-
 let rec type_pat ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
     expected_ty k =
   Builtin_attributes.warning_scope sp.ppat_attributes (fun () ->
@@ -1402,10 +1411,6 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
             pat_env = !env;
           })
   | Ppat_construct (lid, sargs) ->
-    let has_legacy_constructor_payload, ppat_attributes =
-      remove_legacy_constructor_payload_attr sp.ppat_attributes
-    in
-    let sp = {sp with ppat_attributes} in
     let opath =
       try
         let p0, p, _ = extract_concrete_variant !env expected_ty in
@@ -1440,10 +1445,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
        correct head *)
     if constr.cstr_generalized then unify_head_only loc !env expected_ty constr;
     let sargs =
-      match sargs with
-      | [{ppat_desc = Ppat_tuple sargs}]
-        when has_legacy_constructor_payload && constr.cstr_arity > 1 ->
-        sargs
+      match constructor_args_of_pat_payload ~arity:constr.cstr_arity sargs with
       | [({ppat_desc = Ppat_any} as sp)] when constr.cstr_arity <> 1 ->
         if constr.cstr_arity = 0 then
           Location.prerr_warning sp.ppat_loc
@@ -4429,9 +4431,6 @@ and type_application ~context total_app env funct (sargs : sargs) :
              Apply_non_function (expand_head env funct.exp_type) )))
 
 and type_construct ~context env loc lid sargs ty_expected attrs =
-  let has_legacy_constructor_payload, attrs =
-    remove_legacy_constructor_payload_attr attrs
-  in
   let opath =
     try
       let p0, p, _ = extract_concrete_variant env ty_expected in
@@ -4447,13 +4446,7 @@ and type_construct ~context env loc lid sargs ty_expected attrs =
   Env.mark_constructor Env.Positive env (Longident.last lid.txt) constr;
   Builtin_attributes.check_deprecated loc constr.cstr_attributes
     constr.cstr_name;
-  let sargs =
-    match sargs with
-    | [{pexp_desc = Pexp_tuple sargs}]
-      when has_legacy_constructor_payload && constr.cstr_arity > 1 ->
-      sargs
-    | sargs -> sargs
-  in
+  let sargs = constructor_args_of_exp_payload ~arity:constr.cstr_arity sargs in
   if List.length sargs <> constr.cstr_arity then
     raise
       (Error

compiler/syntax/src/res_parsetree_viewer.ml

@@ -228,7 +228,7 @@ let filter_parsing_attrs attrs =
               ( "res.braces" | "ns.braces" | "res.iflet" | "res.ternary"
               | "res.await" | "res.patVariantSpread" | "res.dictPattern"
               | "res.dictSpread" | "res.inlineRecordDefinition"
-              | "res.variantArgs" | "_res.legacy_constructor_payload" );
+              | "res.variantArgs" );
           },
           _ ) ->
         false

compiler/syntax/src/res_printer.ml

@@ -2617,16 +2617,6 @@ and print_extension ~state ~at_module_lvl (string_loc, payload) cmt_tbl =
   in
   Doc.group (Doc.concat [ext_name; print_payload ~state payload cmt_tbl])
 
-and remove_legacy_constructor_payload_attr attrs =
-  let rec loop rev_attrs = function
-    | ({Location.txt = "_res.legacy_constructor_payload"}, Parsetree.PStr [])
-      :: attrs ->
-      (true, List.rev_append rev_attrs attrs)
-    | attr :: attrs -> loop (attr :: rev_attrs) attrs
-    | [] -> (false, List.rev rev_attrs)
-  in
-  loop [] attrs
-
 and print_pattern_args ~state (patterns : Parsetree.pattern list) cmt_tbl =
   match patterns with
   | [] -> Doc.nil
@@ -2671,15 +2661,6 @@ and print_pattern_args ~state (patterns : Parsetree.pattern list) cmt_tbl =
       ]
 
 and print_pattern ~state (p : Parsetree.pattern) cmt_tbl =
-  let has_legacy_constructor_payload, ppat_attributes =
-    remove_legacy_constructor_payload_attr p.ppat_attributes
-  in
-  let p =
-    match (has_legacy_constructor_payload, p.ppat_desc) with
-    | true, Ppat_construct (constr, [{ppat_desc = Ppat_tuple args}]) ->
-      {p with ppat_desc = Ppat_construct (constr, args); ppat_attributes}
-    | _ -> {p with ppat_attributes}
-  in
   let pattern_without_attributes =
     match p.ppat_desc with
     | Ppat_any -> Doc.text "_"
@@ -3196,15 +3177,6 @@ and print_object_get_doc ~state parent_expr (label : string Location.loc)
   Doc.group (Doc.concat [parent_doc; Doc.lbracket; member; Doc.rbracket])
 
 and print_expression ~state (e : Parsetree.expression) cmt_tbl =
-  let has_legacy_constructor_payload, pexp_attributes =
-    remove_legacy_constructor_payload_attr e.pexp_attributes
-  in
-  let e =
-    match (has_legacy_constructor_payload, e.pexp_desc) with
-    | true, Pexp_construct (constr, [{pexp_desc = Pexp_tuple args}]) ->
-      {e with pexp_desc = Pexp_construct (constr, args); pexp_attributes}
-    | _ -> {e with pexp_attributes}
-  in
   let printed_expression =
     match e.pexp_desc with
     | Pexp_fun

tests/ERROR_VARIANTS.md

@@ -201,7 +201,7 @@ Source: [typecore.ml:27](../compiler/ml/typecore.ml).
 | Variant | Status | Fixture | Notes |
 |---|---|---|---|
 | `Polymorphic_label` | ✓ | `polymorphic_label.res` | Pattern that instantiates a polymorphic record field: `({f: (f: int => int)}: t) =>` constrains the universal `'a` of `f: 'a. 'a => 'a` to `int => int`. |
-| `Constructor_arity_mismatch` | ✓ | `constructor_arity_mismatch.res`, `constructor_arity_mismatch_pattern.res`, `constructor_tuple_arity_mismatch.res`, `constructor_tuple_arity_mismatch_pattern.res`, `arity_mismatch*.res` | Triggers in both expression and pattern paths, including the distinction between multiple arguments and one tuple argument. |
+| `Constructor_arity_mismatch` | ✓ | `constructor_arity_mismatch.res`, `constructor_arity_mismatch_pattern.res`, `constructor_tuple_arity_mismatch.res`, `constructor_tuple_arity_mismatch_pattern.res`, `arity_mismatch*.res` | Triggers in both expression and pattern paths, after semantic argument normalization. |
 | `Label_mismatch` | ✓ | `label_mismatch_record_literal.res` | Record literal without expected type mixing fields from two different record types — disambiguation picks one type per label, and the cross-type unify fails inside `type_label_exp`. |
 | `Pattern_type_clash` | ✓ | many `*_pattern_type_clash.res` etc. | Most-fired pattern error. Sub-case fixtures: `pattern_matching_on_option_but_value_not_option.res` and `pattern_matching_on_value_but_is_option.res` (option-vs-non-option trace), `pattern_type_clash_polyvariant.res` (polyvariant tag against concrete type), `pattern_type_clash_tuple_arity.res` (tuple arity mismatch). |
 | `Or_pattern_type_clash` | ✓ | `or_pattern_type_clash.res` | |

tests/build_tests/super_errors/expected/constructor_tuple_arity_mismatch.res.expected

@@ -1,10 +1,10 @@
 
   We've found a bug for you!
-  /.../fixtures/constructor_tuple_arity_mismatch.res:3:15-25
+  /.../fixtures/constructor_tuple_arity_mismatch.res:3:15-31
 
-  1 │ type unary = Unary((int, int))
+  1 │ type binary = Binary(int, int)
   2 │ 
-  3 │ let invalid = Unary(1, 2)
+  3 │ let invalid = Binary((1, 2, 3))
   4 │ 
 
-  This variant constructor Unary expects 1 argument, but it's being passed 2.
+  This variant constructor Binary expects 2 arguments, but it's being passed 3.

tests/build_tests/super_errors/expected/constructor_tuple_arity_mismatch_pattern.res.expected

@@ -1,11 +1,11 @@
 
   We've found a bug for you!
-  /.../fixtures/constructor_tuple_arity_mismatch_pattern.res:5:5-18
+  /.../fixtures/constructor_tuple_arity_mismatch_pattern.res:5:5-21
 
   3 │ let read = value =>
   4 │   switch value {
-  5 │   | Binary((x, y)) => x + y
+  5 │   | Binary((x, y, z)) => x + y + z
   6 │   }
   7 │ 
 
-  This variant constructor Binary expects 2 arguments, but it's only being passed 1.
+  This variant constructor Binary expects 2 arguments, but it's being passed 3.

tests/build_tests/super_errors/fixtures/constructor_tuple_arity_mismatch.res

@@ -1,3 +1,3 @@
-type unary = Unary((int, int))
+type binary = Binary(int, int)
 
-let invalid = Unary(1, 2)
+let invalid = Binary((1, 2, 3))