diff --git a/CHANGELOG.md b/CHANGELOG.md
index c3ee0d8c30..24d3fac35a 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -35,6 +35,9 @@
 
 #### :bug: Bug fix
 
+- Fix record-field completion inside tuple arguments of constructors with multiple arguments, in expressions and patterns. 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. 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
 - Fix a recursive module with an empty signature discarding its right-hand side. Lambda-to-Lam conversion rewrote `Pupdate_mod` to unit when the module's shape had no fields, dropping the primitive's arguments - one of which is the right-hand side - so `module rec M: {} = { let () = Console.log("effect") }` emitted nothing for `M`. The elision now happens where the bindings are produced, with the right-hand side still in hand. https://github.com/rescript-lang/rescript/pull/8608
 - Fix `Int.Ref.increment` and `Int.Ref.decrement` evaluating their argument twice: `Int.Ref.increment(mkRef())` emitted `mkRef().contents = mkRef().contents + 1 | 0`. The `%incr` and `%decr` builtins lowered to an assignment that repeated the argument expression; they now bind the reference before the read-modify-write. Inlining decisions around an increment are taken on the code it stands for rather than on a single primitive node. https://github.com/rescript-lang/rescript/pull/8608
@@ -68,6 +71,7 @@
 
 #### :house: Internal
 
+- 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
diff --git a/analysis/reanalyze/src/annotation.ml b/analysis/reanalyze/src/annotation.ml
index 697c69d4b5..5f60b5c303 100644
--- a/analysis/reanalyze/src/annotation.ml
+++ b/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} ->
diff --git a/analysis/src/codemod.ml b/analysis/src/codemod.ml
index 235948bdd1..5f7cfbc934 100644
--- a/analysis/src/codemod.ml
+++ b/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}])}] -> (
diff --git a/analysis/src/commands.ml b/analysis/src/commands.ml
index 391661b216..746c9d9ea5 100644
--- a/analysis/src/commands.ml
+++ b/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"
diff --git a/analysis/src/completion_expressions.ml b/analysis/src/completion_expressions.ml
index 5c01dd6d1b..a47019b3bd 100644
--- a/analysis/src/completion_expressions.ml
+++ b/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,41 +153,23 @@ 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}]
-        @ 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}]
@@ -205,15 +180,6 @@ let rec traverse_expr (exp : Parsetree.expression) ~expr_path ~pos
                {constructor_name = txt; item_num = item_num + 1};
            ]
            @ 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,7 +246,7 @@ 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
@@ -288,27 +254,14 @@ let complete_constructor_payload ~pos_before_cursor
   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
diff --git a/analysis/src/completion_front_end.ml b/analysis/src/completion_front_end.ml
index a3ed213e9f..732a7f76bc 100644
--- a/analysis/src/completion_front_end.ml
+++ b/analysis/src/completion_front_end.ml
@@ -222,7 +222,8 @@ let rec expr_to_context_path_inner ~(in_jsx_context : bool)
     | None -> None)
   | Pexp_constant (Pconst_integer _) -> Some CPInt
   | Pexp_constant (Pconst_float _) -> Some CPFloat
-  | Pexp_construct ({txt = Lident ("true" | "false")}, None) -> Some CPBool
+  | Pexp_construct ({txt = Lident ("true" | "false")}, {txt = []}) ->
+    Some CPBool
   | Pexp_array exprs ->
     Some
       (CPArray
@@ -492,41 +493,29 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
           scope_pattern p
             ~pattern_path:(NTupleItem {item_num = index} :: pattern_path)
             ?context_path)
-    | Ppat_construct (_, None) -> ()
-    | Ppat_construct ({txt}, Some {ppat_desc = Ppat_tuple pl}) ->
-      pl
+    | Ppat_construct (_, {txt = []}) -> ()
+    | Ppat_construct ({txt}, {txt = patterns}) ->
+      patterns
       |> List.iteri (fun index p ->
           scope_pattern p
             ~pattern_path:
               (NVariantPayload
                  {
                    item_num = index;
+                   source_arity = List.length patterns;
                    constructor_name = Utils.get_unqualified_name txt;
                  }
               :: pattern_path)
             ?context_path)
-    | Ppat_construct ({txt}, Some p) ->
-      scope_pattern
-        ~pattern_path:
-          (NVariantPayload
-             {item_num = 0; constructor_name = Utils.get_unqualified_name txt}
-          :: pattern_path)
-        ?context_path p
-    | Ppat_variant (_, None) -> ()
-    | Ppat_variant (txt, Some {ppat_desc = Ppat_tuple pl}) ->
-      pl
+    | Ppat_variant (_, {txt = []}) -> ()
+    | Ppat_variant (txt, {txt = patterns}) ->
+      patterns
       |> List.iteri (fun index p ->
           scope_pattern p
             ~pattern_path:
               (NPolyvariantPayload {item_num = index; constructor_name = txt}
               :: pattern_path)
             ?context_path)
-    | Ppat_variant (txt, Some p) ->
-      scope_pattern
-        ~pattern_path:
-          (NPolyvariantPayload {item_num = 0; constructor_name = txt}
-          :: pattern_path)
-        ?context_path p
     | Ppat_record (fields, _, rest) -> (
       Ext_list.iter fields (fun {lid = fname; x = p} ->
           match fname with
@@ -1043,7 +1032,7 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
                  Pstr_eval
                    ( {
                        pexp_loc;
-                       pexp_desc = Pexp_construct ({txt = path; loc}, None);
+                       pexp_desc = Pexp_construct ({txt = path; loc}, {txt = []});
                      },
                      _ );
              };
@@ -1283,17 +1272,21 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
                          then ValueOrField
                          else Value);
                     }))
-        | Pexp_construct (lid, e_opt) -> (
+        | Pexp_construct (lid, {txt = args}) ->
           let lid_path = flatten_lid_check_dot lid in
           if debug then
             Printf.printf "Pexp_construct %s:%s %s\n"
               (lid_path |> String.concat "\n")
               (Loc.to_string lid.loc)
-              (match e_opt with
-              | None -> "None"
-              | Some e -> Loc.to_string e.pexp_loc);
+              (match args with
+              | [] -> "None"
+              | args ->
+                args
+                |> List.map (fun (e : Parsetree.expression) ->
+                    Loc.to_string e.pexp_loc)
+                |> String.concat ", ");
           if
-            e_opt = None && (not lid.loc.loc_ghost)
+            args = [] && (not lid.loc.loc_ghost)
             && lid.loc |> Loc.has_pos ~pos:pos_before_cursor
           then
             set_result
@@ -1301,18 +1294,19 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
                  (CPId
                     {loc = lid.loc; path = lid_path; completion_context = Value}))
           else
-            match e_opt with
-            | Some e when loc_has_cursor e.pexp_loc -> (
-              match
-                Completion_expressions.complete_constructor_payload
-                  ~pos_before_cursor ~first_char_before_cursor_no_white lid e
-              with
-              | Some result ->
-                (* Check if anything else more important completes before setting this completion. *)
-                Ast_iterator.default_iterator.expr iterator e;
-                set_result result
-              | None -> ())
-            | _ -> ())
+            args
+            |> List.iteri (fun item_num (e : Parsetree.expression) ->
+                if loc_has_cursor e.pexp_loc then
+                  match
+                    Completion_expressions.complete_constructor_payload
+                      ~pos_before_cursor ~first_char_before_cursor_no_white
+                      ~item_num ~source_arity:(List.length args) lid e
+                  with
+                  | Some result ->
+                    (* Check if anything else more important completes before setting this completion. *)
+                    Ast_iterator.default_iterator.expr iterator e;
+                    set_result result
+                  | None -> ())
         | Pexp_field (e, field_name) -> (
           if debug then
             Printf.printf "Pexp_field %s %s:%s\n" (Loc.to_string e.pexp_loc)
@@ -1864,10 +1858,7 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
   in
 
   if kind_file = Files.Res then (
-    let parser =
-      Res_driver.parsing_engine.parse_implementation_from_source
-        ~for_printer:false
-    in
+    let parser = Res_driver.parsing_engine.parse_implementation_from_source in
     let {Res_driver.parsetree = str} = parser ~source:text in
     iterator.structure iterator str |> ignore;
     if blank_after_cursor = Some ' ' || blank_after_cursor = Some '\n' then (
@@ -1878,9 +1869,7 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
     if !found = false then if debug then Printf.printf "XXX Not found!\n";
     !result)
   else if kind_file = Resi then (
-    let parser =
-      Res_driver.parsing_engine.parse_interface_from_source ~for_printer:false
-    in
+    let parser = Res_driver.parsing_engine.parse_interface_from_source in
     let {Res_driver.parsetree = signature} = parser ~source:text in
     iterator.signature iterator signature |> ignore;
     if blank_after_cursor = Some ' ' || blank_after_cursor = Some '\n' then (
diff --git a/analysis/src/completion_patterns.ml b/analysis/src/completion_patterns.ml
index 706b4d924b..880b08e53e 100644
--- a/analysis/src/completion_patterns.ml
+++ b/analysis/src/completion_patterns.ml
@@ -5,11 +5,6 @@ let is_pattern_hole pat =
   | Ppat_extension ({txt = "rescript.patternhole"}, _) -> true
   | _ -> false
 
-let is_pattern_tuple pat =
-  match pat.Parsetree.ppat_desc with
-  | Ppat_tuple _ -> true
-  | _ -> false
-
 let rec traverse_tuple_items tuple_items ~next_pattern_path
     ~result_from_found_item_num ~loc_has_cursor
     ~first_char_before_cursor_no_white ~pos_before_cursor =
@@ -86,14 +81,14 @@ and traverse_pattern (pat : Parsetree.pattern) ~pattern_path ~loc_has_cursor
        lot. *)
     some_if_has_cursor ("", pattern_path) "Ppat_any"
   | Ppat_var {txt} -> some_if_has_cursor (txt, pattern_path) "Ppat_var"
-  | Ppat_construct ({txt = Lident "()"}, None) ->
+  | Ppat_construct ({txt = Lident "()"}, {txt = []}) ->
     (* switch s { | (<com>) }*)
     some_if_has_cursor
       ("", pattern_path @ [Completable.NTupleItem {item_num = 0}])
       "Ppat_construct()"
-  | Ppat_construct ({txt = Lident prefix}, None) ->
+  | Ppat_construct ({txt = Lident prefix}, {txt = []}) ->
     some_if_has_cursor (prefix, pattern_path) "Ppat_construct(Lident)"
-  | Ppat_variant (prefix, None) ->
+  | Ppat_variant (prefix, {txt = []}) ->
     some_if_has_cursor ("#" ^ prefix, pattern_path) "Ppat_variant"
   | Ppat_array array_patterns ->
     let next_pattern_path = [Completable.NArray] @ pattern_path in
@@ -180,37 +175,34 @@ and traverse_pattern (pat : Parsetree.pattern) ~pattern_path ~loc_has_cursor
       | _ -> None))
   | Ppat_construct
       ( {txt},
-        Some {ppat_loc; ppat_desc = Ppat_construct ({txt = Lident "()"}, _)} )
+        {
+          txt = [{ppat_loc; ppat_desc = Ppat_construct ({txt = Lident "()"}, _)}];
+        } )
     when loc_has_cursor ppat_loc ->
     (* Empty payload with cursor, like: Test(<com>) *)
     Some
       ( "",
         [
           Completable.NVariantPayload
-            {constructor_name = Utils.get_unqualified_name txt; item_num = 0};
+            {
+              constructor_name = Utils.get_unqualified_name txt;
+              item_num = 0;
+              source_arity = 1;
+            };
         ]
         @ pattern_path )
-  | Ppat_construct ({txt}, Some pat)
-    when pos_before_cursor >= (pat.ppat_loc |> Loc.end_)
-         && first_char_before_cursor_no_white = Some ','
-         && is_pattern_tuple pat = false ->
-    (* Empty payload with trailing ',', like: Test(true, <com>) *)
-    Some
-      ( "",
-        [
-          Completable.NVariantPayload
-            {constructor_name = Utils.get_unqualified_name txt; item_num = 1};
-        ]
-        @ pattern_path )
-  | Ppat_construct ({txt}, Some {ppat_loc; ppat_desc = Ppat_tuple tuple_items})
-    when loc_has_cursor ppat_loc ->
-    tuple_items
+  | Ppat_construct ({txt}, {txt = patterns}) when loc_has_cursor pat.ppat_loc ->
+    patterns
     |> traverse_tuple_items ~loc_has_cursor ~first_char_before_cursor_no_white
          ~pos_before_cursor
          ~next_pattern_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 patterns;
+               };
            ]
            @ pattern_path)
          ~result_from_found_item_num:(fun item_num ->
@@ -219,42 +211,23 @@ and traverse_pattern (pat : Parsetree.pattern) ~pattern_path ~loc_has_cursor
                {
                  constructor_name = Utils.get_unqualified_name txt;
                  item_num = item_num + 1;
+                 source_arity = List.length patterns;
                };
            ]
            @ pattern_path)
-  | Ppat_construct ({txt}, Some p) when loc_has_cursor pat.ppat_loc ->
-    p
-    |> traverse_pattern ~loc_has_cursor ~first_char_before_cursor_no_white
-         ~pos_before_cursor
-         ~pattern_path:
-           ([
-              Completable.NVariantPayload
-                {
-                  constructor_name = Utils.get_unqualified_name txt;
-                  item_num = 0;
-                };
-            ]
-           @ pattern_path)
   | Ppat_variant
-      (txt, Some {ppat_loc; ppat_desc = Ppat_construct ({txt = Lident "()"}, _)})
+      ( txt,
+        {
+          txt = [{ppat_loc; ppat_desc = Ppat_construct ({txt = Lident "()"}, _)}];
+        } )
     when loc_has_cursor ppat_loc ->
     (* Empty payload with cursor, like: #test(<com>) *)
     Some
       ( "",
         [Completable.NPolyvariantPayload {constructor_name = txt; item_num = 0}]
         @ pattern_path )
-  | Ppat_variant (txt, Some pat)
-    when pos_before_cursor >= (pat.ppat_loc |> Loc.end_)
-         && first_char_before_cursor_no_white = Some ','
-         && is_pattern_tuple pat = false ->
-    (* Empty payload with trailing ',', like: #test(true, <com>) *)
-    Some
-      ( "",
-        [Completable.NPolyvariantPayload {constructor_name = txt; item_num = 1}]
-        @ pattern_path )
-  | Ppat_variant (txt, Some {ppat_loc; ppat_desc = Ppat_tuple tuple_items})
-    when loc_has_cursor ppat_loc ->
-    tuple_items
+  | Ppat_variant (txt, {txt = patterns}) when loc_has_cursor pat.ppat_loc ->
+    patterns
     |> traverse_tuple_items ~loc_has_cursor ~first_char_before_cursor_no_white
          ~pos_before_cursor
          ~next_pattern_path:(fun item_num ->
@@ -266,14 +239,4 @@ and traverse_pattern (pat : Parsetree.pattern) ~pattern_path ~loc_has_cursor
                {constructor_name = txt; item_num = item_num + 1};
            ]
            @ pattern_path)
-  | Ppat_variant (txt, Some p) when loc_has_cursor pat.ppat_loc ->
-    p
-    |> traverse_pattern ~loc_has_cursor ~first_char_before_cursor_no_white
-         ~pos_before_cursor
-         ~pattern_path:
-           ([
-              Completable.NPolyvariantPayload
-                {constructor_name = txt; item_num = 0};
-            ]
-           @ pattern_path)
   | _ -> None
diff --git a/analysis/src/diagnostics.ml b/analysis/src/diagnostics.ml
index 2b73f9b7d9..fa1fc720c8 100644
--- a/analysis/src/diagnostics.ml
+++ b/analysis/src/diagnostics.ml
@@ -22,14 +22,12 @@ let document_syntax ~source ~kind_file =
   in
   if kind_file = Files.Res then
     let parse_implementation =
-      Res_driver.parsing_engine.parse_implementation_from_source
-        ~for_printer:false ~source
+      Res_driver.parsing_engine.parse_implementation_from_source ~source
     in
     get_diagnostics parse_implementation.diagnostics
   else if kind_file = Files.Resi then
     let parse_interface =
-      Res_driver.parsing_engine.parse_interface_from_source ~for_printer:false
-        ~source
+      Res_driver.parsing_engine.parse_interface_from_source ~source
     in
     get_diagnostics parse_interface.diagnostics
   else []
diff --git a/analysis/src/document_symbol.ml b/analysis/src/document_symbol.ml
index 3ef53933e5..92ee9e1813 100644
--- a/analysis/src/document_symbol.ml
+++ b/analysis/src/document_symbol.ml
@@ -118,16 +118,11 @@ let get_symbols ~source ~kind_file =
   in
 
   (if kind_file = Files.Res then
-     let parser =
-       Res_driver.parsing_engine.parse_implementation_from_source
-         ~for_printer:false
-     in
+     let parser = Res_driver.parsing_engine.parse_implementation_from_source in
      let {Res_driver.parsetree = structure} = parser ~source in
      iterator.structure iterator structure |> ignore
    else
-     let parser =
-       Res_driver.parsing_engine.parse_interface_from_source ~for_printer:false
-     in
+     let parser = Res_driver.parsing_engine.parse_interface_from_source in
      let {Res_driver.parsetree = signature} = parser ~source in
      iterator.signature iterator signature |> ignore);
   let is_inside
diff --git a/analysis/src/dump_ast.ml b/analysis/src/dump_ast.ml
index 2eb536e7af..aa30c5d461 100644
--- a/analysis/src/dump_ast.ml
+++ b/analysis/src/dump_ast.ml
@@ -98,19 +98,19 @@ let rec print_pattern pattern ~pos ~indentation =
   | Ppat_var ({txt} as loc) ->
     "Ppat_var(" ^ (loc |> print_loc_denominator_loc ~pos) ^ txt ^ ")"
   | Ppat_constant const -> "Ppat_constant(" ^ print_constant const ^ ")"
-  | Ppat_construct (({txt} as loc), maybe_pat) ->
+  | Ppat_construct (({txt} as loc), {txt = patterns}) ->
     "Ppat_construct("
     ^ (loc |> print_loc_denominator_loc ~pos)
     ^ (Utils.flatten_long_ident txt |> ident |> str)
-    ^ (match maybe_pat with
-      | None -> ""
-      | Some pat -> "," ^ print_pattern pat ~pos ~indentation)
+    ^ (patterns
+      |> List.map (fun pat -> "," ^ print_pattern pat ~pos ~indentation)
+      |> String.concat "")
     ^ ")"
-  | Ppat_variant (label, maybe_pat) ->
+  | Ppat_variant (label, {txt = patterns}) ->
     "Ppat_variant(" ^ str label
-    ^ (match maybe_pat with
-      | None -> ""
-      | Some pat -> "," ^ print_pattern pat ~pos ~indentation)
+    ^ (patterns
+      |> List.map (fun pat -> "," ^ print_pattern pat ~pos ~indentation)
+      |> String.concat "")
     ^ ")"
   | Ppat_record (fields, _, rest) ->
     "Ppat_record(\n"
@@ -231,19 +231,19 @@ and print_expr_item expr ~pos ~indentation =
     ^ add_indentation indentation
     ^ ")"
   | Pexp_constant constant -> "Pexp_constant(" ^ print_constant constant ^ ")"
-  | Pexp_construct (({txt} as loc), maybe_expr) ->
+  | Pexp_construct (({txt} as loc), {txt = exprs}) ->
     "Pexp_construct("
     ^ (loc |> print_loc_denominator_loc ~pos)
     ^ (Utils.flatten_long_ident txt |> ident |> str)
-    ^ (match maybe_expr with
-      | None -> ""
-      | Some expr -> ", " ^ print_expr_item expr ~pos ~indentation)
+    ^ (exprs
+      |> List.map (fun expr -> ", " ^ print_expr_item expr ~pos ~indentation)
+      |> String.concat "")
     ^ ")"
-  | Pexp_variant (label, maybe_expr) ->
+  | Pexp_variant (label, {txt = exprs}) ->
     "Pexp_variant(" ^ str label
-    ^ (match maybe_expr with
-      | None -> ""
-      | Some expr -> "," ^ print_expr_item expr ~pos ~indentation)
+    ^ (exprs
+      |> List.map (fun expr -> "," ^ print_expr_item expr ~pos ~indentation)
+      |> String.concat "")
     ^ ")"
   | Pexp_fun {params = {p_lbl = arg; p_pat = pattern} :: _; body = next_expr} ->
     "Pexp_fun(\n"
@@ -383,8 +383,7 @@ let print_struct_item struct_item ~pos ~source =
 
 let dump ~current_file ~pos =
   let {Res_driver.parsetree = structure; source} =
-    Res_driver.parsing_engine.parse_implementation ~for_printer:true
-      ~filename:current_file
+    Res_driver.parsing_engine.parse_implementation ~filename:current_file
   in
 
   print_endline
diff --git a/analysis/src/hint.ml b/analysis/src/hint.ml
index fa39a0ce02..6ab41e6478 100644
--- a/analysis/src/hint.ml
+++ b/analysis/src/hint.ml
@@ -73,10 +73,7 @@ let inlay ~source ~kind_file ~pos ~max_length ~full ~state ~debug =
   in
   let iterator = {Ast_iterator.default_iterator with value_binding} in
   (if kind_file = Files.Res then
-     let parser =
-       Res_driver.parsing_engine.parse_implementation_from_source
-         ~for_printer:false
-     in
+     let parser = Res_driver.parsing_engine.parse_implementation_from_source in
      let {Res_driver.parsetree = structure} = parser ~source in
      iterator.structure iterator structure |> ignore);
   match full with
@@ -136,10 +133,7 @@ let code_lens ~source ~kind_file ~full ~debug =
   (* We only print code lenses in implementation files. This is because they'd be redundant in interface files,
      where the definition itself will be the same thing as what would've been printed in the code lens. *)
   (if kind_file = Files.Res then
-     let parser =
-       Res_driver.parsing_engine.parse_implementation_from_source
-         ~for_printer:false
-     in
+     let parser = Res_driver.parsing_engine.parse_implementation_from_source in
      let {Res_driver.parsetree = structure} = parser ~source in
      iterator.structure iterator structure |> ignore);
   match full with
diff --git a/analysis/src/process_attributes.ml b/analysis/src/process_attributes.ml
index ccbb057426..10ce3508a4 100644
--- a/analysis/src/process_attributes.ml
+++ b/analysis/src/process_attributes.ml
@@ -69,7 +69,7 @@ let rec find_editor_complete_from_attribute ?(module_paths = []) attributes =
       items
       |> List.filter_map (fun item ->
           match item.Parsetree.pexp_desc with
-          | Pexp_construct ({txt = path}, None) ->
+          | Pexp_construct ({txt = path}, {txt = []}) ->
             Some (Utils.flatten_long_ident path)
           | _ -> None)
     in
diff --git a/analysis/src/semantic_tokens.ml b/analysis/src/semantic_tokens.ml
index 3a8f925cd1..0ec8f6363d 100644
--- a/analysis/src/semantic_tokens.ml
+++ b/analysis/src/semantic_tokens.ml
@@ -498,19 +498,14 @@ let command ~debug ~emitter ~source ~kind_file =
   in
 
   if kind_file = Files.Res then (
-    let parser =
-      Res_driver.parsing_engine.parse_implementation_from_source
-        ~for_printer:false
-    in
+    let parser = Res_driver.parsing_engine.parse_implementation_from_source in
     let {Res_driver.parsetree = structure; diagnostics} = parser ~source in
     if debug then
       Printf.printf "structure items:%d diagnostics:%d\n"
         (List.length structure) (List.length diagnostics);
     iterator.structure iterator structure |> ignore)
   else
-    let parser =
-      Res_driver.parsing_engine.parse_interface_from_source ~for_printer:false
-    in
+    let parser = Res_driver.parsing_engine.parse_interface_from_source in
     let {Res_driver.parsetree = signature; diagnostics} = parser ~source in
     if debug then
       Printf.printf "signature items:%d diagnostics:%d\n"
diff --git a/analysis/src/shared_types.ml b/analysis/src/shared_types.ml
index b2b9819d6e..5c2e20e133 100644
--- a/analysis/src/shared_types.ml
+++ b/analysis/src/shared_types.ml
@@ -605,7 +605,11 @@ module Completable = struct
     | NTupleItem of {item_num: int}
     | NFollowRecordField of {field_name: string}
     | NRecordBody of {seen_fields: string list}
-    | NVariantPayload of {constructor_name: string; item_num: int}
+    | NVariantPayload of {
+        constructor_name: string;
+        item_num: int;
+        source_arity: int;
+      }
     | NPolyvariantPayload of {constructor_name: string; item_num: int}
     | NArray
 
diff --git a/analysis/src/signature_help.ml b/analysis/src/signature_help.ml
index d84fe61030..09dd23b531 100644
--- a/analysis/src/signature_help.ml
+++ b/analysis/src/signature_help.ml
@@ -257,6 +257,19 @@ let signature_help ~debug ~source ~kind_file ~pos
       let loc_has_cursor loc =
         loc |> Cursor_position.loc_has_cursor ~pos:pos_before_cursor
       in
+      let constructor_arg_index locations =
+        let rec loop index = function
+          | [] -> -1
+          | [_] -> index
+          | loc :: (next :: _ as rest) ->
+            if pos_before_cursor < Loc.end_ loc then index
+            else if pos_before_cursor < Loc.start next then
+              if first_char_before_cursor_no_white = Some ',' then index + 1
+              else index
+            else loop (index + 1) rest
+        in
+        loop 0 locations
+      in
       let supports_markdown_links = true in
       let result = ref None in
       let print_thing thg =
@@ -400,29 +413,28 @@ let signature_help ~debug ~source ~kind_file ~pos
           in
           set_result
             (exp.pexp_loc, `FunctionCall (arg_at_cursor, exp, extracted_args))
-        | {pexp_desc = Pexp_construct (lid, Some payload_exp); pexp_loc}
-          when loc_has_cursor payload_exp.pexp_loc
-               || Completion_expressions.is_expr_hole payload_exp
-                  && loc_has_cursor pexp_loc ->
+        | {
+         pexp_desc = Pexp_construct (lid, {txt = payload_exps; loc = args_loc});
+        }
+          when payload_exps <> [] && loc_has_cursor args_loc ->
           (* Constructor payloads *)
-          set_result (lid.loc, `ConstructorExpr (lid, payload_exp))
+          set_result (lid.loc, `ConstructorExpr (lid, payload_exps))
         | _ -> ());
         Ast_iterator.default_iterator.expr iterator expr
       in
       let pat (iterator : Ast_iterator.iterator) (pat : Parsetree.pattern) =
         (match pat with
-        | {ppat_desc = Ppat_construct (lid, Some payload_pat)}
-          when loc_has_cursor payload_pat.ppat_loc ->
+        | {
+         ppat_desc = Ppat_construct (lid, {txt = payload_pats; loc = args_loc});
+        }
+          when payload_pats <> [] && loc_has_cursor args_loc ->
           (* Constructor payloads *)
-          set_result (lid.loc, `ConstructorPat (lid, payload_pat))
+          set_result (lid.loc, `ConstructorPat (lid, payload_pats))
         | _ -> ());
         Ast_iterator.default_iterator.pat iterator pat
       in
       let iterator = {Ast_iterator.default_iterator with expr; pat} in
-      let parser =
-        Res_driver.parsing_engine.parse_implementation_from_source
-          ~for_printer:false
-      in
+      let parser = Res_driver.parsing_engine.parse_implementation_from_source in
       let {Res_driver.parsetree = structure} = parser ~source in
       iterator.structure iterator structure |> ignore;
       (* Handle function application, if found *)
@@ -452,7 +464,7 @@ let signature_help ~debug ~source ~kind_file ~pos
           let fn_type_str = Shared.type_to_string type_expr in
           let type_str_for_parser = label_prefix ^ fn_type_str in
           let {Res_driver.parsetree = signature} =
-            Res_driver.parse_interface_from_source ~for_printer:false
+            Res_driver.parse_interface_from_source
               ~display_filename:"<missing-file>" ~source:type_str_for_parser
           in
 
@@ -621,22 +633,26 @@ let signature_help ~debug ~source ~kind_file ~pos
                   |> String.concat ", ")
               ^ ")"
             in
+            let constructor_has_multiple_args =
+              match arg_parts with
+              | Some (`TupleArg (_ :: _ :: _)) -> true
+              | _ -> false
+            in
             let active_parameter =
               match cs with
-              | `ConstructorExpr (_, {pexp_desc = Pexp_tuple items}) -> (
-                let idx = ref 0 in
-                let tuple_item_with_cursor =
-                  items
-                  |> List.find_map (fun (item : Parsetree.expression) ->
-                      let current_index = !idx in
-                      idx := current_index + 1;
-                      if loc_has_cursor item.pexp_loc then Some current_index
-                      else None)
-                in
-                match tuple_item_with_cursor with
-                | None -> -1
-                | Some i -> i)
-              | `ConstructorExpr (_, {pexp_desc = Pexp_record (fields, _)}) -> (
+              | `ConstructorExpr (_, [{pexp_desc = Pexp_tuple tuple_items}])
+                when constructor_has_multiple_args ->
+                constructor_arg_index
+                  (List.map
+                     (fun (item : Parsetree.expression) -> item.pexp_loc)
+                     tuple_items)
+              | `ConstructorExpr (_, items) when List.length items > 1 ->
+                constructor_arg_index
+                  (List.map
+                     (fun (item : Parsetree.expression) -> item.pexp_loc)
+                     items)
+              | `ConstructorExpr (_, [{pexp_desc = Pexp_record (fields, _)}])
+                -> (
                 let field_name_with_cursor =
                   fields
                   |> List.find_map
@@ -664,23 +680,20 @@ let signature_help ~debug ~source ~kind_file ~pos
                       else ());
                   !field_index
                 | _ -> -1)
-              | `ConstructorExpr (_, expr) when loc_has_cursor expr.pexp_loc ->
-                0
-              | `ConstructorPat (_, {ppat_desc = Ppat_tuple items}) -> (
-                let idx = ref 0 in
-                let tuple_item_with_cursor =
-                  items
-                  |> List.find_map (fun (item : Parsetree.pattern) ->
-                      let current_index = !idx in
-                      idx := current_index + 1;
-                      if loc_has_cursor item.ppat_loc then Some current_index
-                      else None)
-                in
-                match tuple_item_with_cursor with
-                | None -> -1
-                | Some i -> i)
-              | `ConstructorPat (_, {ppat_desc = Ppat_record (fields, _, _rest)})
-                -> (
+              | `ConstructorExpr (_, [_]) -> 0
+              | `ConstructorPat (_, [{ppat_desc = Ppat_tuple tuple_items}])
+                when constructor_has_multiple_args ->
+                constructor_arg_index
+                  (List.map
+                     (fun (item : Parsetree.pattern) -> item.ppat_loc)
+                     tuple_items)
+              | `ConstructorPat (_, items) when List.length items > 1 ->
+                constructor_arg_index
+                  (List.map
+                     (fun (item : Parsetree.pattern) -> item.ppat_loc)
+                     items)
+              | `ConstructorPat
+                  (_, [{ppat_desc = Ppat_record (fields, _, _rest)}]) -> (
                 let field_name_with_cursor =
                   fields
                   |> List.find_map
@@ -708,7 +721,7 @@ let signature_help ~debug ~source ~kind_file ~pos
                       else ());
                   !field_index
                 | _ -> -1)
-              | `ConstructorPat (_, pat) when loc_has_cursor pat.ppat_loc -> 0
+              | `ConstructorPat (_, [_]) -> 0
               | _ -> -1
             in
 
diff --git a/analysis/src/type_utils.ml b/analysis/src/type_utils.ml
index 5f5cedfaff..9e0c2793e9 100644
--- a/analysis/src/type_utils.ml
+++ b/analysis/src/type_utils.ml
@@ -603,6 +603,16 @@ let extract_type_from_resolved_type (typ : Type.t) ~env ~full ~state =
 (** The context we just came from as we resolve the nested structure. *)
 type ctx = Rfield of string  (** A record field of name *)
 
+(* Only a sole syntactic argument can be a tuple wrapping all constructor
+   arguments. A tuple within a multi-argument application is a real payload. *)
+let normalize_constructor_payload_path ~argument_count ~source_arity ~item_num
+    ~nested =
+  match nested with
+  | Completable.NTupleItem {item_num = tuple_item_num} :: nested
+    when source_arity = 1 && item_num = 0 && argument_count > 1 ->
+    (tuple_item_num, nested)
+  | _ -> (item_num, nested)
+
 let rec resolve_nested ?type_arg_context ~env ~full ~state ~nested ?ctx
     (typ : completion_type) =
   let extract_type = extract_type ?type_arg_context in
@@ -721,8 +731,8 @@ let rec resolve_nested ?type_arg_context ~env ~full ~state ~nested ?ctx
       |> extract_type ~env ~state ~package:full.package
       |> Utils.Option.flat_map (fun (t, type_arg_context) ->
           t |> resolve_nested ?type_arg_context ~env ~state ~full ~nested)
-    | NVariantPayload {constructor_name; item_num}, Tvariant {env; constructors}
-      -> (
+    | ( NVariantPayload {constructor_name; item_num; source_arity},
+        Tvariant {env; constructors} ) -> (
       if Debug.verbose () then
         Printf.printf
           "[nested]--> trying to move into variant payload $%i of constructor \
@@ -736,6 +746,10 @@ let rec resolve_nested ?type_arg_context ~env ~full ~state ~nested ?ctx
       | Some {args = Args args} -> (
         if Debug.verbose () then
           print_endline "[nested]--> found constructor (Args type)";
+        let item_num, nested =
+          normalize_constructor_payload_path ~argument_count:(List.length args)
+            ~source_arity ~item_num ~nested
+        in
         match List.nth_opt args item_num with
         | None ->
           if Debug.verbose () then
@@ -904,16 +918,27 @@ let rec resolve_nested_pattern_path (typ : inner_type) ~env ~full ~state ~nested
           |> Utils.Option.flat_map (fun typ ->
               ExtractedType typ
               |> resolve_nested_pattern_path ~env ~state ~full ~nested))
-      | ( NVariantPayload {constructor_name; item_num},
+      | ( NVariantPayload {constructor_name; item_num; source_arity},
           Tvariant {env; constructors} ) -> (
         match
           constructors
-          |> find_type_of_constructor_arg ~constructor_name
-               ~payload_num:item_num ~env
+          |> List.find_opt (fun (constructor : Constructor.t) ->
+              constructor.cname.txt = constructor_name)
         with
-        | Some typ ->
-          typ |> resolve_nested_pattern_path ~env ~state ~full ~nested
-        | None -> None)
+        | Some {args = Args args} -> (
+          let item_num, nested =
+            normalize_constructor_payload_path
+              ~argument_count:(List.length args) ~source_arity ~item_num ~nested
+          in
+          match List.nth_opt args item_num with
+          | Some (typ, _) ->
+            TypeExpr typ
+            |> resolve_nested_pattern_path ~env ~state ~full ~nested
+          | None -> None)
+        | Some {args = InlineRecord fields} when item_num = 0 ->
+          ExtractedType (TinlineRecord {env; fields})
+          |> resolve_nested_pattern_path ~env ~state ~full ~nested
+        | Some {args = InlineRecord _} | None -> None)
       | ( NPolyvariantPayload {constructor_name; item_num},
           Tpolyvariant {env; constructors} ) -> (
         match
@@ -1014,9 +1039,17 @@ module Codegen = struct
   let mk_construct_pat ?payload name =
     Ast_helper.Pat.construct
       {Asttypes.txt = Longident.Lident name; loc = Location.none}
-      payload
+      (Location.mknoloc
+         (match payload with
+         | None -> []
+         | Some payload -> [payload]))
 
-  let mk_tag_pat ?payload name = Ast_helper.Pat.variant name payload
+  let mk_tag_pat ?payload name =
+    Ast_helper.Pat.variant name
+      (Location.mknoloc
+         (match payload with
+         | None -> []
+         | Some payload -> [payload]))
 
   let any () = Ast_helper.Pat.any ()
 
diff --git a/analysis/src/xform.ml b/analysis/src/xform.ml
index 2bb2c1d88b..3ea35b09cf 100644
--- a/analysis/src/xform.ml
+++ b/analysis/src/xform.ml
@@ -55,16 +55,16 @@ module If_then_else = struct
       Ast_helper.Pat.mk ~loc:exp.pexp_loc ~attrs:exp.pexp_attributes ppat_desc
     in
     match exp.pexp_desc with
-    | Pexp_construct (lid, None) -> Some (mk_pat (Ppat_construct (lid, None)))
-    | Pexp_construct (lid, Some e1) -> (
-      match exp_to_pat e1 with
+    | Pexp_construct (lid, {txt = exprs; loc}) -> (
+      match list_to_pat ~item_to_pat:exp_to_pat exprs with
       | None -> None
-      | Some p1 -> Some (mk_pat (Ppat_construct (lid, Some p1))))
-    | Pexp_variant (label, None) -> Some (mk_pat (Ppat_variant (label, None)))
-    | Pexp_variant (label, Some e1) -> (
-      match exp_to_pat e1 with
+      | Some patterns ->
+        Some (mk_pat (Ppat_construct (lid, {txt = patterns; loc}))))
+    | Pexp_variant (label, {txt = exprs; loc}) -> (
+      match list_to_pat ~item_to_pat:exp_to_pat exprs with
       | None -> None
-      | Some p1 -> Some (mk_pat (Ppat_variant (label, Some p1))))
+      | Some patterns ->
+        Some (mk_pat (Ppat_variant (label, {txt = patterns; loc}))))
     | Pexp_constant c -> Some (mk_pat (Ppat_constant c))
     | Pexp_template {source_segments = [{txt = source}]; values = []} -> (
       match String_literal.decode_js_template_escapes source with
@@ -408,7 +408,7 @@ module Expand_catch_all_for_variants = struct
           ?(mode : [`option | `default] = `default) ?(constructor_names = [])
           (p : Parsetree.pattern) =
         match p.ppat_desc with
-        | Ppat_construct ({txt = Lident "Some"}, Some payload)
+        | Ppat_construct ({txt = Lident "Some"}, {txt = [payload]})
           when mode = `option ->
           find_all_constructor_names ~mode ~constructor_names payload
         | Ppat_construct ({txt}, _) -> Longident.last txt :: constructor_names
@@ -867,8 +867,7 @@ end
 
 let parse_implementation ~source =
   let {Res_driver.parsetree = structure; comments} =
-    Res_driver.parsing_engine.parse_implementation_from_source
-      ~for_printer:false ~source
+    Res_driver.parsing_engine.parse_implementation_from_source ~source
   in
   let filter_comments ~loc comments =
     (* Relevant comments in the range of the expression *)
@@ -901,8 +900,7 @@ let parse_implementation ~source =
 
 let parse_interface ~source =
   let {Res_driver.parsetree = structure; comments} =
-    Res_driver.parsing_engine.parse_interface_from_source ~for_printer:false
-      ~source
+    Res_driver.parsing_engine.parse_interface_from_source ~source
   in
   let filter_comments ~loc comments =
     (* Relevant comments in the range of the expression *)
diff --git a/compiler/bsc/rescript_compiler_main.ml b/compiler/bsc/rescript_compiler_main.ml
index 95ec7b79e8..8045973e6c 100644
--- a/compiler/bsc/rescript_compiler_main.ml
+++ b/compiler/bsc/rescript_compiler_main.ml
@@ -22,7 +22,7 @@ module Error_message_utils_support = struct
     (Error_message_utils.Parser.parse_source :=
        fun source ->
          let res =
-           Res_driver.parse_implementation_from_source ~for_printer:false
+           Res_driver.parse_implementation_from_source
              ~display_filename:"<none>" ~source
          in
          (res.parsetree, res.comments |> List.map to_comment));
@@ -108,8 +108,7 @@ let reprint_source_file sourcefile =
     match kind with
     | Res ->
       let parse_result =
-        Res_driver.parsing_engine.parse_implementation ~for_printer:true
-          ~filename:sourcefile
+        Res_driver.parsing_engine.parse_implementation ~filename:sourcefile
       in
       if parse_result.invalid then (
         Res_diagnostics.print_report parse_result.diagnostics
@@ -125,8 +124,7 @@ let reprint_source_file sourcefile =
       |> print_endline
     | Resi ->
       let parse_result =
-        Res_driver.parsing_engine.parse_interface ~for_printer:true
-          ~filename:sourcefile
+        Res_driver.parsing_engine.parse_interface ~filename:sourcefile
       in
       if parse_result.invalid then (
         Res_diagnostics.print_report parse_result.diagnostics
diff --git a/compiler/common/pattern_printer.ml b/compiler/common/pattern_printer.ml
index de47287bdd..2745fce6db 100644
--- a/compiler/common/pattern_printer.ml
+++ b/compiler/common/pattern_printer.ml
@@ -47,7 +47,7 @@ let[@warning "-4"] rec classify_optional_field_state pat =
   | _ -> Field_normal
 
 let none_pattern =
-  mkpat (Ppat_construct (mknoloc (Longident.Lident "None"), None))
+  mkpat (Ppat_construct (mknoloc (Longident.Lident "None"), mknoloc []))
 
 let[@warning "-4"] strip_synthetic_some pat =
   match pat.pat_desc with
@@ -71,16 +71,14 @@ let untype typed =
     | Tpat_tuple lst -> mkpat (Ppat_tuple (List.map loop lst))
     | Tpat_construct (cstr_lid, cstr, lst) ->
       let lid = {cstr_lid with txt = Longident.Lident cstr.cstr_name} in
-      let arg =
-        match List.map loop lst with
-        | [] -> None
-        | [p] -> Some p
-        | lst -> Some (mkpat (Ppat_tuple lst))
-      in
-      mkpat (Ppat_construct (lid, arg))
+      mkpat (Ppat_construct (lid, mknoloc (List.map loop lst)))
     | Tpat_variant (label, p_opt, _row_desc) ->
-      let arg = Option.map loop p_opt in
-      mkpat (Ppat_variant (label, arg))
+      let args =
+        match p_opt with
+        | None -> []
+        | Some p -> [loop p]
+      in
+      mkpat (Ppat_variant (label, mknoloc args))
     | Tpat_record (subpatterns, closed_flag, rest) ->
       let fields, saw_optional_rewrite =
         List.fold_right
diff --git a/compiler/ext/config.ml b/compiler/ext/config.ml
index 25c05907f9..1a187acfa8 100644
--- a/compiler/ext/config.ml
+++ b/compiler/ext/config.ml
@@ -1,10 +1,10 @@
-let cmi_magic_number = "Caml1999I030"
+let cmi_magic_number = "Caml1999I031"
 
 (* Magic numbers for marshaled values of the *current* parsetree, whose layout
    changes across compiler versions. *)
-and ast_impl_magic_number = "ResImpl01304"
+and ast_impl_magic_number = "ResImpl01305"
 
-and ast_intf_magic_number = "ResIntf01304"
+and ast_intf_magic_number = "ResIntf01305"
 
 (* Magic numbers of the frozen Parsetree0 (OCaml 4.06) layout used on the
    external-PPX wire. They must never be written in front of a
@@ -13,6 +13,6 @@ and ast0_impl_magic_number = "Caml1999M022"
 
 and ast0_intf_magic_number = "Caml1999N022"
 
-and cmt_magic_number = "Caml1999T032"
+and cmt_magic_number = "Caml1999T033"
 
 let load_path = ref ([] : string list)
diff --git a/compiler/frontend/ast_derive_js_mapper.ml b/compiler/frontend/ast_derive_js_mapper.ml
index b8ccadda9e..09dfbf50ab 100644
--- a/compiler/frontend/ast_derive_js_mapper.ml
+++ b/compiler/frontend/ast_derive_js_mapper.ml
@@ -50,7 +50,7 @@ let handle_config (config : Parsetree.expression option) =
                 {
                   pexp_desc =
                     ( Pexp_construct
-                        ({txt = Lident (("true" | "false") as x)}, None)
+                        ({txt = Lident (("true" | "false") as x)}, {txt = []})
                     | Pexp_ident {txt = Lident ("newType" as x)} );
                 };
             };
diff --git a/compiler/frontend/ast_derive_projector.ml b/compiler/frontend/ast_derive_projector.ml
index 3203b11608..edec70be4b 100644
--- a/compiler/frontend/ast_derive_projector.ml
+++ b/compiler/frontend/ast_derive_projector.ml
@@ -83,7 +83,7 @@ let init () =
                          Exp.constraint_
                            (Exp.construct
                               {loc; txt = Longident.Lident con_name}
-                              None)
+                              {txt = []; loc})
                            annotate_type
                        else
                          let vars =
@@ -94,14 +94,12 @@ let init () =
                            Exp.constraint_
                              (Exp.construct
                                 {loc; txt = Longident.Lident con_name}
-                             @@ Some
-                                  (if arity = 1 then
-                                     Exp.ident
-                                       {loc; txt = Lident (List.hd vars)}
-                                   else
-                                     Exp.tuple
-                                       (Ext_list.map vars (fun x ->
-                                            Exp.ident {loc; txt = Lident x}))))
+                                {
+                                  txt =
+                                    Ext_list.map vars (fun x ->
+                                        Exp.ident {loc; txt = Lident x});
+                                  loc;
+                                })
                              annotate_type
                          in
                          Ast_helper.Exp.fun_
diff --git a/compiler/frontend/ast_exp_apply.ml b/compiler/frontend/ast_exp_apply.ml
index 5f4924bb27..b3f7614cbd 100644
--- a/compiler/frontend/ast_exp_apply.ml
+++ b/compiler/frontend/ast_exp_apply.ml
@@ -80,10 +80,18 @@ let app_exp_mapper (e : exp) (self : Ast_mapper.mapper) : exp =
     let a = self.expr self a_ in
     let f = self.expr self f_ in
     match f.pexp_desc with
-    | Pexp_variant (label, None) ->
-      {f with pexp_desc = Pexp_variant (label, Some a); pexp_loc = e.pexp_loc}
-    | Pexp_construct (ctor, None) ->
-      {f with pexp_desc = Pexp_construct (ctor, Some a); pexp_loc = e.pexp_loc}
+    | Pexp_variant (label, {txt = []}) ->
+      {
+        f with
+        pexp_desc = Pexp_variant (label, {txt = [a]; loc = a.pexp_loc});
+        pexp_loc = e.pexp_loc;
+      }
+    | Pexp_construct (ctor, {txt = []}) ->
+      {
+        f with
+        pexp_desc = Pexp_construct (ctor, {txt = [a]; loc = a.pexp_loc});
+        pexp_loc = e.pexp_loc;
+      }
     | Pexp_apply {funct = fn1; args; partial; transformed_jsx} ->
       Bs_ast_invariant.warn_discarded_unused_attributes fn1.pexp_attributes;
       {
@@ -100,10 +108,16 @@ let app_exp_mapper (e : exp) (self : Ast_mapper.mapper) : exp =
               Pexp_tuple
                 (Ext_list.map xs (fun fn ->
                      match fn.pexp_desc with
-                     | Pexp_construct (ctor, None) ->
+                     | Pexp_construct (ctor, {txt = []}) ->
                        {
                          fn with
-                         pexp_desc = Pexp_construct (ctor, Some bounded_obj_arg);
+                         pexp_desc =
+                           Pexp_construct
+                             ( ctor,
+                               {
+                                 txt = [bounded_obj_arg];
+                                 loc = bounded_obj_arg.pexp_loc;
+                               } );
                        }
                      | Pexp_apply {funct = fn; args; transformed_jsx} ->
                        Bs_ast_invariant.warn_discarded_unused_attributes
diff --git a/compiler/frontend/ast_literal.ml b/compiler/frontend/ast_literal.ml
index 97ff7c1c56..03fd5a2978 100644
--- a/compiler/frontend/ast_literal.ml
+++ b/compiler/frontend/ast_literal.ml
@@ -65,7 +65,8 @@ end
 module No_loc = struct
   let loc = Location.none
 
-  let val_unit = Ast_helper.Exp.construct {txt = Lid.val_unit; loc} None
+  let val_unit =
+    Ast_helper.Exp.construct {txt = Lid.val_unit; loc} {txt = []; loc}
 
   let type_unit =
     Ast_helper.Typ.mk (Ptyp_constr ({txt = Lid.type_unit; loc}, []))
@@ -86,7 +87,7 @@ module No_loc = struct
 
   let type_any = Ast_helper.Typ.any ()
 
-  let pat_unit = Pat.construct {txt = Lid.val_unit; loc} None
+  let pat_unit = Pat.construct {txt = Lid.val_unit; loc} {txt = []; loc}
 end
 
 type 'a lit = ?loc:Location.t -> unit -> 'a
@@ -100,7 +101,8 @@ type pattern_lit = Parsetree.pattern lit
 let val_unit ?loc () =
   match loc with
   | None -> No_loc.val_unit
-  | Some loc -> Ast_helper.Exp.construct {txt = Lid.val_unit; loc} None
+  | Some loc ->
+    Ast_helper.Exp.construct {txt = Lid.val_unit; loc} {txt = []; loc}
 
 let type_unit ?loc () =
   match loc with
@@ -150,4 +152,5 @@ let type_any ?loc () =
 let pat_unit ?loc () =
   match loc with
   | None -> No_loc.pat_unit
-  | Some loc -> Pat.construct ~loc {txt = Lid.val_unit; loc} None
+  | Some loc ->
+    Pat.construct ~loc {txt = Lid.val_unit; loc} (Location.mkloc [] loc)
diff --git a/compiler/frontend/bs_builtin_ppx.ml b/compiler/frontend/bs_builtin_ppx.ml
index 25fc5eb04f..8886205d14 100644
--- a/compiler/frontend/bs_builtin_ppx.ml
+++ b/compiler/frontend/bs_builtin_ppx.ml
@@ -164,12 +164,14 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
       ( b,
         [
           {
-            pc_lhs = {ppat_desc = Ppat_construct ({txt = Lident "true"}, None)};
+            pc_lhs =
+              {ppat_desc = Ppat_construct ({txt = Lident "true"}, {txt = []})};
             pc_guard = None;
             pc_rhs = t_exp;
           };
           {
-            pc_lhs = {ppat_desc = Ppat_construct ({txt = Lident "false"}, None)};
+            pc_lhs =
+              {ppat_desc = Ppat_construct ({txt = Lident "false"}, {txt = []})};
             pc_guard = None;
             pc_rhs = f_exp;
           };
@@ -178,12 +180,14 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
       ( b,
         [
           {
-            pc_lhs = {ppat_desc = Ppat_construct ({txt = Lident "false"}, None)};
+            pc_lhs =
+              {ppat_desc = Ppat_construct ({txt = Lident "false"}, {txt = []})};
             pc_guard = None;
             pc_rhs = f_exp;
           };
           {
-            pc_lhs = {ppat_desc = Ppat_construct ({txt = Lident "true"}, None)};
+            pc_lhs =
+              {ppat_desc = Ppat_construct ({txt = Lident "true"}, {txt = []})};
             pc_guard = None;
             pc_rhs = t_exp;
           };
@@ -204,13 +208,13 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
               {
                 ppat_desc =
                   ( Ppat_construct
-                      ({txt = Lident ("Ok" as variant_name)}, Some _)
+                      ({txt = Lident ("Ok" as variant_name)}, {txt = _ :: _})
                   | Ppat_construct
-                      ({txt = Lident ("Error" as variant_name)}, Some _)
+                      ({txt = Lident ("Error" as variant_name)}, {txt = _ :: _})
                   | Ppat_construct
-                      ({txt = Lident ("Some" as variant_name)}, Some _)
+                      ({txt = Lident ("Some" as variant_name)}, {txt = _ :: _})
                   | Ppat_construct
-                      ({txt = Lident ("None" as variant_name)}, None) );
+                      ({txt = Lident ("None" as variant_name)}, {txt = []}) );
               } as pvb_pat;
             pvb_expr;
             pvb_constraint = None;
@@ -245,7 +249,7 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
       (* Extract the variable name from the pattern (e.g., myVar from Some(myVar)) *)
       let var_name =
         match pvb_pat.ppat_desc with
-        | Ppat_construct (_, Some inner_pat) -> (
+        | Ppat_construct (_, {txt = [inner_pat]}) -> (
           match Ast_pat.is_single_variable_pattern_conservative inner_pat with
           | Some name when name <> "" -> name
           | _ -> "x")
@@ -261,7 +265,7 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
               Ast_helper.Pat.alias
                 (Ast_helper.Pat.construct ~loc
                    {txt = Lident "Error"; loc}
-                   (Some (Ast_helper.Pat.any ~loc ())))
+                   (Location.mkloc [Ast_helper.Pat.any ~loc ()] loc))
                 {txt = var_name; loc};
             pc_guard = None;
             pc_rhs = Ast_helper.Exp.ident ~loc {txt = Lident var_name; loc};
@@ -273,7 +277,7 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
             pc_lhs =
               Ast_helper.Pat.alias
                 (Ast_helper.Pat.construct ~loc {txt = Lident "Ok"; loc}
-                   (Some (Ast_helper.Pat.any ~loc ())))
+                   (Location.mkloc [Ast_helper.Pat.any ~loc ()] loc))
                 {txt = var_name; loc};
             pc_guard = None;
             pc_rhs = Ast_helper.Exp.ident ~loc {txt = Lident var_name; loc};
@@ -284,7 +288,8 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
             Parsetree.pc_bar = None;
             pc_lhs =
               Ast_helper.Pat.alias
-                (Ast_helper.Pat.construct ~loc {txt = Lident "None"; loc} None)
+                (Ast_helper.Pat.construct ~loc {txt = Lident "None"; loc}
+                   (Location.mkloc [] loc))
                 {txt = var_name; loc};
             pc_guard = None;
             pc_rhs = Ast_helper.Exp.ident ~loc {txt = Lident var_name; loc};
@@ -296,7 +301,7 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
             pc_lhs =
               Ast_helper.Pat.alias
                 (Ast_helper.Pat.construct ~loc {txt = Lident "Some"; loc}
-                   (Some (Ast_helper.Pat.any ~loc ())))
+                   (Location.mkloc [Ast_helper.Pat.any ~loc ()] loc))
                 {txt = var_name; loc};
             pc_guard = None;
             pc_rhs = Ast_helper.Exp.ident ~loc {txt = Lident var_name; loc};
@@ -501,7 +506,8 @@ let signature_item_mapper (self : mapper) (sigi : Parsetree.signature_item) :
                   pval_attributes = [];
                 };
           }
-        | Pexp_construct ({txt = Lident (("true" | "false") as txt)}, None) ->
+        | Pexp_construct ({txt = Lident (("true" | "false") as txt)}, {txt = []})
+          ->
           succeed attr pval_attributes;
           {
             sigi with
@@ -617,7 +623,8 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) :
             };
       }
     | ( Some attr,
-        Pexp_construct ({txt = Lident (("true" | "false") as txt)}, None) ) ->
+        Pexp_construct ({txt = Lident (("true" | "false") as txt)}, {txt = []})
+      ) ->
       succeed attr pvb_attributes;
       {
         str with
@@ -797,7 +804,7 @@ let rec structure_mapper ~await_context (self : mapper) (stru : Ast_structure.t)
             | Pexp_let (_, vbs, expr) -> aux expr @ spelunk_vbs acc vbs
             | Pexp_ifthenelse (_, then_expr, Some else_expr) ->
               aux then_expr @ aux else_expr
-            | Pexp_construct (_, Some expr) -> aux expr
+            | Pexp_construct (_, {txt = [expr]}) -> aux expr
             | Pexp_fun {body = expr} -> aux expr
             | Pexp_constraint (expr, _) -> aux expr
             | Pexp_match (expr, cases) ->
diff --git a/compiler/jsoo/jsoo_playground_main.ml b/compiler/jsoo/jsoo_playground_main.ml
index 9d7fc83ff2..8e36ce3a19 100644
--- a/compiler/jsoo/jsoo_playground_main.ml
+++ b/compiler/jsoo/jsoo_playground_main.ml
@@ -255,11 +255,7 @@ module Res_driver = struct
   open Res_driver
 
   (* adds ~src parameter *)
-  let setup ~src ~filename ~for_printer () =
-    let mode =
-      if for_printer then Res_parser.Default else ParseForTypeChecker
-    in
-    Res_parser.make ~mode src filename
+  let setup ~src ~filename = Res_parser.make src filename
 
   (* get full super error message *)
   let diagnostic_to_string ~(src : string) (d : Res_diagnostics.t) =
@@ -273,10 +269,10 @@ module Res_driver = struct
     Location.default_error_reporter ~src:(Some src) Format.str_formatter err;
     Format.flush_str_formatter ()
 
-  let parse_implementation ~sourcefile ~for_printer ~src =
+  let parse_implementation ~sourcefile ~src =
     Location.input_name := sourcefile;
     let parse_result =
-      let engine = setup ~filename:sourcefile ~for_printer ~src () in
+      let engine = setup ~filename:sourcefile ~src in
       let structure = Res_core.parse_implementation engine in
       let invalid, diagnostics =
         match engine.diagnostics with
@@ -316,7 +312,7 @@ end
 
 let rescript_parse ~filename src =
   let structure, _ =
-    Res_driver.parse_implementation ~for_printer:false ~sourcefile:filename ~src
+    Res_driver.parse_implementation ~sourcefile:filename ~src
   in
   structure
 
@@ -743,12 +739,9 @@ module Compile = struct
       let code =
         match (from, to_) with
         | Res, Res ->
-          (* Essentially pretty printing.
-           * IMPORTANT: we need forPrinter:true when parsing code here,
-           * otherwise we will loose some information for the ReScript printer *)
+          (* Essentially pretty printing. *)
           let structure, comments =
-            Res_driver.parse_implementation ~for_printer:true
-              ~sourcefile:filename ~src
+            Res_driver.parse_implementation ~sourcefile:filename ~src
           in
           Res_printer.print_implementation ~width:80 structure ~comments
       in
diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml
index 658095545a..fec1388df0 100644
--- a/compiler/ml/ast_helper.ml
+++ b/compiler/ml/ast_helper.ml
@@ -119,8 +119,14 @@ module Typ = struct
       in
       {t with ptyp_desc = desc}
     and loop_row_field = function
-      | Rtag (label, attrs, flag, lst) ->
-        Rtag (label, attrs, flag, List.map loop lst)
+      | Rtag (label, attrs, flag, groups) ->
+        Rtag
+          ( label,
+            attrs,
+            flag,
+            List.map
+              (fun ({txt} as group) -> {group with txt = List.map loop txt})
+              groups )
       | Rinherit t -> Rinherit (loop t)
     and loop_object_field = function
       | Otag (label, attrs, t) -> Otag (label, attrs, loop t)
@@ -242,7 +248,7 @@ module Exp = struct
         | None ->
           let loc = {loc with Location.loc_ghost = true} in
           let nil = Location.mkloc (Longident.Lident "[]") loc in
-          construct ~loc nil None)
+          construct ~loc nil (Location.mkloc [] loc))
       | e1 :: el ->
         let exp_el = handle_seq el in
         let loc =
@@ -253,8 +259,9 @@ module Exp = struct
               loc_ghost = false;
             }
         in
-        let arg = tuple ~loc [e1; exp_el] in
-        construct ~loc (Location.mkloc (Longident.Lident "::") loc) (Some arg)
+        construct ~loc
+          (Location.mkloc (Longident.Lident "::") loc)
+          (Location.mkloc [e1; exp_el] loc)
     in
     let expr = handle_seq seq in
     {expr with pexp_loc = loc}
diff --git a/compiler/ml/ast_helper.mli b/compiler/ml/ast_helper.mli
index 2899c91416..f7e0142dad 100644
--- a/compiler/ml/ast_helper.mli
+++ b/compiler/ml/ast_helper.mli
@@ -97,8 +97,13 @@ module Pat : sig
   val constant : ?loc:loc -> ?attrs:attrs -> constant -> pattern
   val interval : ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern
   val tuple : ?loc:loc -> ?attrs:attrs -> pattern list -> pattern
-  val construct : ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern
-  val variant : ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern
+
+  (* Argument lists carry their own locations. Generated nodes must supply
+     an explicit fallback location; see the parsetree location contract. *)
+  val construct :
+    ?loc:loc -> ?attrs:attrs -> lid -> pattern list Location.loc -> pattern
+  val variant :
+    ?loc:loc -> ?attrs:attrs -> label -> pattern list Location.loc -> pattern
   val record :
     ?loc:loc ->
     ?attrs:attrs ->
@@ -153,9 +158,17 @@ module Exp : sig
   val try_ : ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression
   val tuple : ?loc:loc -> ?attrs:attrs -> expression list -> expression
   val construct :
-    ?loc:loc -> ?attrs:attrs -> lid -> expression option -> expression
+    ?loc:loc ->
+    ?attrs:attrs ->
+    lid ->
+    expression list Location.loc ->
+    expression
   val variant :
-    ?loc:loc -> ?attrs:attrs -> label -> expression option -> expression
+    ?loc:loc ->
+    ?attrs:attrs ->
+    label ->
+    expression list Location.loc ->
+    expression
   val record :
     ?loc:loc ->
     ?attrs:attrs ->
diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml
index c94169eb0c..a4b6fa9cd6 100644
--- a/compiler/ml/ast_iterator.ml
+++ b/compiler/ml/ast_iterator.ml
@@ -80,9 +80,13 @@ module T = struct
   (* Type expressions for the core language *)
 
   let row_field sub = function
-    | Rtag (_, attrs, _, tl) ->
+    | Rtag (_, attrs, _, groups) ->
       sub.attributes sub attrs;
-      List.iter (sub.typ sub) tl
+      List.iter
+        (fun {loc; txt} ->
+          sub.location sub loc;
+          List.iter (sub.typ sub) txt)
+        groups
     | Rinherit t -> sub.typ sub t
 
   let object_field sub = function
@@ -311,10 +315,13 @@ module E = struct
       sub.expr sub e;
       sub.cases sub pel
     | Pexp_tuple el -> List.iter (sub.expr sub) el
-    | Pexp_construct (lid, arg) ->
+    | Pexp_construct (lid, {txt = args; loc = args_loc}) ->
       iter_loc sub lid;
-      iter_opt (sub.expr sub) arg
-    | Pexp_variant (_lab, eo) -> iter_opt (sub.expr sub) eo
+      sub.location sub args_loc;
+      List.iter (sub.expr sub) args
+    | Pexp_variant (_lab, {txt = args; loc = args_loc}) ->
+      sub.location sub args_loc;
+      List.iter (sub.expr sub) args
     | Pexp_record (l, eo) ->
       List.iter
         (fun {lid; x = exp} ->
@@ -423,10 +430,13 @@ module P = struct
     | Ppat_constant _ -> ()
     | Ppat_interval _ -> ()
     | Ppat_tuple pl -> List.iter (sub.pat sub) pl
-    | Ppat_construct (l, p) ->
+    | Ppat_construct (l, {txt = args; loc = args_loc}) ->
       iter_loc sub l;
-      iter_opt (sub.pat sub) p
-    | Ppat_variant (_l, p) -> iter_opt (sub.pat sub) p
+      sub.location sub args_loc;
+      List.iter (sub.pat sub) args
+    | Ppat_variant (_l, {txt = args; loc = args_loc}) ->
+      sub.location sub args_loc;
+      List.iter (sub.pat sub) args
     | Ppat_record (lpl, _cf, rest) ->
       List.iter
         (fun {lid; x = pat} ->
diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml
index 99e54d2f4c..e12f876ae6 100644
--- a/compiler/ml/ast_mapper.ml
+++ b/compiler/ml/ast_mapper.ml
@@ -75,9 +75,15 @@ module T = struct
   (* Type expressions for the core language *)
 
   let row_field sub = function
-    | Rtag (l, attrs, b, tl) ->
+    | Rtag (l, attrs, b, groups) ->
       Rtag
-        (map_loc sub l, sub.attributes sub attrs, b, List.map (sub.typ sub) tl)
+        ( map_loc sub l,
+          sub.attributes sub attrs,
+          b,
+          List.map
+            (fun {loc; txt} ->
+              {loc = sub.location sub loc; txt = List.map (sub.typ sub) txt})
+            groups )
     | Rinherit t -> Rinherit (sub.typ sub t)
 
   let object_field sub = function
@@ -310,10 +316,12 @@ module E = struct
       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)
     | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el)
-    | Pexp_construct (lid, arg) ->
-      construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg)
-    | Pexp_variant (lab, eo) ->
-      variant ~loc ~attrs lab (map_opt (sub.expr sub) eo)
+    | Pexp_construct (lid, {txt = args; loc = args_loc}) ->
+      construct ~loc ~attrs (map_loc sub lid)
+        {txt = List.map (sub.expr sub) args; loc = sub.location sub args_loc}
+    | Pexp_variant (lab, {txt = args; loc = args_loc}) ->
+      variant ~loc ~attrs lab
+        {txt = List.map (sub.expr sub) args; loc = sub.location sub args_loc}
     | Pexp_record (l, eo) ->
       record ~loc ~attrs
         (List.map
@@ -418,9 +426,12 @@ module P = struct
     | Ppat_constant c -> constant ~loc ~attrs c
     | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2
     | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl)
-    | Ppat_construct (l, p) ->
-      construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p)
-    | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p)
+    | Ppat_construct (l, {txt = args; loc = args_loc}) ->
+      construct ~loc ~attrs (map_loc sub l)
+        {txt = List.map (sub.pat sub) args; loc = sub.location sub args_loc}
+    | Ppat_variant (l, {txt = args; loc = args_loc}) ->
+      variant ~loc ~attrs l
+        {txt = List.map (sub.pat sub) args; loc = sub.location sub args_loc}
     | Ppat_record (lpl, cf, rest) ->
       record ~loc ~attrs
         ?rest:
@@ -595,14 +606,14 @@ module Ppx_context = struct
       (Const.string x)
 
   let make_bool x =
-    if x then Exp.construct (lid "true") None
-    else Exp.construct (lid "false") None
+    if x then Exp.construct (lid "true") (Location.mknoloc [])
+    else Exp.construct (lid "false") (Location.mknoloc [])
 
   let rec make_list f lst =
     match lst with
     | x :: rest ->
-      Exp.construct (lid "::") (Some (Exp.tuple [f x; make_list f rest]))
-    | [] -> Exp.construct (lid "[]") None
+      Exp.construct (lid "::") (Location.mknoloc [f x; make_list f rest])
+    | [] -> Exp.construct (lid "[]") (Location.mknoloc [])
 
   let make_pair f1 f2 (x1, x2) = Exp.tuple [f1 x1; f2 x2]
 
@@ -664,11 +675,14 @@ module Ppx_context = struct
             name
       and get_bool pexp =
         match pexp with
-        | {pexp_desc = Pexp_construct ({txt = Longident.Lident "true"}, None)}
-          ->
+        | {
+         pexp_desc = Pexp_construct ({txt = Longident.Lident "true"}, {txt = []});
+        } ->
           true
-        | {pexp_desc = Pexp_construct ({txt = Longident.Lident "false"}, None)}
-          ->
+        | {
+         pexp_desc =
+           Pexp_construct ({txt = Longident.Lident "false"}, {txt = []});
+        } ->
           false
         | _ ->
           raise_errorf
@@ -677,12 +691,13 @@ module Ppx_context = struct
       and get_list elem = function
         | {
             pexp_desc =
-              Pexp_construct
-                ( {txt = Longident.Lident "::"},
-                  Some {pexp_desc = Pexp_tuple [exp; rest]} );
+              Pexp_construct ({txt = Longident.Lident "::"}, {txt = [exp; rest]});
           } ->
           elem exp :: get_list elem rest
-        | {pexp_desc = Pexp_construct ({txt = Longident.Lident "[]"}, None)} ->
+        | {
+            pexp_desc =
+              Pexp_construct ({txt = Longident.Lident "[]"}, {txt = []});
+          } ->
           []
         | _ ->
           raise_errorf
diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml
index 4d9af4ce7c..9ccf39ff02 100644
--- a/compiler/ml/ast_mapper_from0.ml
+++ b/compiler/ml/ast_mapper_from0.ml
@@ -164,6 +164,54 @@ let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt}
 
 (* Internal Parsetree0 bridge metadata; public res.* attributes pass through. *)
 let record_rest_attr_name = "_res.record_rest"
+let constructor_args_attr_name = "_res.constructor_args"
+
+let has_explicit_arity_attr (attrs : Pt.attributes) =
+  List.exists
+    (function
+      | {txt = "ocaml.explicit_arity" | "explicit_arity"}, _ -> true
+      | _ -> false)
+    attrs
+
+let remove_constructor_args_attr (attrs : Pt.attributes) =
+  let rec loop rev_attrs = function
+    | ({Location.txt}, Pt.PStr []) :: attrs
+      when txt = constructor_args_attr_name ->
+      (true, List.rev_append rev_attrs attrs)
+    | attr :: attrs -> loop (attr :: rev_attrs) attrs
+    | [] -> (false, List.rev rev_attrs)
+  in
+  loop [] attrs
+
+(* Constructor argument bridge contract (shared with Ast_mapper_to0):
+
+   The current parsetree records source argument lists, not declaration arity.
+   Frozen v0 has only an optional payload, so encoding multiple arguments
+   packs them into a tuple and adds [_res.constructor_args] to the constructor.
+   A single tuple argument needs no marker. List cons nodes also need none:
+   their tuple payload always means head and tail, preserving the v0 wire shape.
+   Polymorphic variant type payload groups use the same encoding, with the
+   marker on the tuple type itself.
+
+   Decoding consumes the internal marker and restores the source list.
+   Ordinary constructors also accept PPX-produced [explicit_arity] and
+   [ocaml.explicit_arity] attributes, and split the list constructor [::] when
+   its tuple has no attributes. Attributed cons tuples remain one payload so
+   their attributes survive another v0 conversion. Other unmarked v0 tuples
+   also remain a single syntactic payload; Typecore resolves semantic grouping
+   once it knows the constructor declaration.
+
+   The tuple used to encode multiple arguments carries the argument-list
+   location, preserving its parentheses span. For a single argument, v0
+   cannot store both the payload and outer argument-list locations: decoding
+   falls back to the payload location. Nullary constructors use the enclosing
+   node location. No location-only attributes are needed. *)
+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
+    | _ -> [map arg])
 
 let record_rest_of_pattern (rest : Pt.pattern) =
   match rest.Pt.ppat_desc with
@@ -192,9 +240,21 @@ module T = struct
   (* Type expressions for the core language *)
 
   let row_field sub = function
-    | Rtag (l, attrs, b, tl) ->
+    | Rtag (l, attrs, b, types) ->
+      let map_group typ =
+        let typ = sub.typ sub typ in
+        let has_constructor_args, attrs =
+          remove_constructor_args_attr typ.ptyp_attributes
+        in
+        let txt =
+          match typ.ptyp_desc with
+          | Ptyp_tuple args when has_constructor_args -> args
+          | _ -> [{typ with ptyp_attributes = attrs}]
+        in
+        {loc = typ.ptyp_loc; txt}
+      in
       Pt.Rtag
-        (map_loc sub l, sub.attributes sub attrs, b, List.map (sub.typ sub) tl)
+        (map_loc sub l, sub.attributes sub attrs, b, List.map map_group types)
     | Rinherit t -> Rinherit (sub.typ sub t)
 
   let object_field sub = function
@@ -836,9 +896,30 @@ module E = struct
       jsx_fragment ~loc ~attrs loc.loc_start (map_jsx_children sub e)
         loc.loc_end
     | Pexp_construct (lid, arg) -> (
+      let args_loc =
+        match arg with
+        | Some arg -> sub.location sub arg.pexp_loc
+        | None -> loc
+      in
       let lid1 = map_loc sub lid in
-      let arg1 = map_opt (sub.expr sub) arg in
-      let exp1 = construct ~loc ~attrs lid1 arg1 in
+      let has_constructor_args, attrs = remove_constructor_args_attr attrs in
+      let args =
+        decode_args ~map:(sub.expr sub)
+          ~tuple_args:(fun arg ->
+            match arg.pexp_desc with
+            | Pexp_tuple _
+              when lid.txt = Longident.Lident "::" && arg.pexp_attributes <> []
+              ->
+              None
+            | Pexp_tuple args -> Some args
+            | _ -> None)
+          ~split_tuple:
+            (has_constructor_args
+            || has_explicit_arity_attr attrs
+            || lid.txt = Longident.Lident "::")
+          arg
+      in
+      let exp1 = construct ~loc ~attrs lid1 {txt = args; loc = args_loc} in
       match lid.txt with
       | Lident "Function$" -> (
         let rec attributes_to_arity (attrs : Parsetree.attributes) =
@@ -858,8 +939,8 @@ module E = struct
           | _ :: rest -> attributes_to_arity rest
           | [] -> assert false
         in
-        match arg1 with
-        | Some ({pexp_desc = Pexp_fun f} as e1) -> (
+        match args with
+        | [({pexp_desc = Pexp_fun f} as e1)] -> (
           let arity = attributes_to_arity attrs in
           (* Gather [arity] parameters from the converted chain of unary
              functions into one n-ary node. Nested first-class functions are
@@ -895,8 +976,22 @@ module E = struct
             })
         | _ -> exp1)
       | _ -> exp1)
-    | Pexp_variant (lab, eo) ->
-      variant ~loc ~attrs lab (map_opt (sub.expr sub) eo)
+    | Pexp_variant (lab, arg) ->
+      let has_constructor_args, attrs = remove_constructor_args_attr attrs in
+      let args_loc =
+        match arg with
+        | Some arg -> sub.location sub arg.pexp_loc
+        | None -> loc
+      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 arg
+      in
+      variant ~loc ~attrs lab {txt = args; loc = args_loc}
     | Pexp_record (l, eo) ->
       record ~loc ~attrs
         (Ext_list.map l (fun (lid, e) ->
@@ -1063,9 +1158,45 @@ module P = struct
         (map_pattern_constant ~loc c1)
         (map_pattern_constant ~loc c2)
     | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl)
-    | Ppat_construct (l, p) ->
-      construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p)
-    | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p)
+    | Ppat_construct (l, arg) ->
+      let args_loc =
+        match arg with
+        | Some arg -> sub.location sub arg.ppat_loc
+        | None -> loc
+      in
+      let has_constructor_args, attrs = remove_constructor_args_attr attrs in
+      let args =
+        decode_args ~map:(sub.pat sub)
+          ~tuple_args:(fun arg ->
+            match arg.ppat_desc with
+            | Ppat_tuple _
+              when l.txt = Longident.Lident "::" && arg.ppat_attributes <> [] ->
+              None
+            | Ppat_tuple args -> Some args
+            | _ -> None)
+          ~split_tuple:
+            (has_constructor_args
+            || has_explicit_arity_attr attrs
+            || l.txt = Longident.Lident "::")
+          arg
+      in
+      construct ~loc ~attrs (map_loc sub l) {txt = args; loc = args_loc}
+    | Ppat_variant (l, arg) ->
+      let has_constructor_args, attrs = remove_constructor_args_attr attrs in
+      let args_loc =
+        match arg with
+        | Some arg -> sub.location sub arg.ppat_loc
+        | None -> loc
+      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 arg
+      in
+      variant ~loc ~attrs l {txt = args; loc = args_loc}
     | Ppat_record (lpl, cf) ->
       let rest, attrs = get_record_rest_attr attrs in
       record ~loc ~attrs ?rest
diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml
index 030aa7fe59..35e2a5ecdb 100644
--- a/compiler/ml/ast_mapper_to0.ml
+++ b/compiler/ml/ast_mapper_to0.ml
@@ -107,6 +107,19 @@ let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt}
 
 (* Internal Parsetree0 bridge metadata; public res.* attributes pass through. *)
 let record_rest_attr_name = "_res.record_rest"
+let constructor_args_attr_name = "_res.constructor_args"
+
+let add_constructor_args_attr attrs =
+  (Location.mknoloc constructor_args_attr_name, Pt.PStr []) :: attrs
+
+(* See the constructor argument bridge contract at Ast_mapper_from0.decode_args. *)
+let encode_args ~map ~tuple ~attrs ~mark_args args =
+  match List.map map args with
+  | [] -> (None, attrs)
+  | [arg] -> (Some arg, attrs)
+  | args ->
+    let attrs = if mark_args then add_constructor_args_attr attrs else attrs in
+    (Some (tuple args), attrs)
 
 let add_record_rest_attr ~rest attrs =
   (Location.mknoloc record_rest_attr_name, Pt.PPat (rest, None)) :: attrs
@@ -123,9 +136,20 @@ module T = struct
   (* Type expressions for the core language *)
 
   let row_field sub = function
-    | Rtag (l, attrs, b, tl) ->
+    | Rtag (l, attrs, b, groups) ->
+      let map_group {loc; txt = args} =
+        let loc = sub.location sub loc in
+        match List.map (sub.typ sub) args with
+        | [arg] -> arg
+        | args ->
+          let typ = Ast_helper0.Typ.tuple ~loc args in
+          {
+            typ with
+            ptyp_attributes = add_constructor_args_attr typ.ptyp_attributes;
+          }
+      in
       Pt.Rtag
-        (map_loc sub l, sub.attributes sub attrs, b, List.map (sub.typ sub) tl)
+        (map_loc sub l, sub.attributes sub attrs, b, List.map map_group groups)
     | Rinherit t -> Rinherit (sub.typ sub t)
 
   let object_field sub = function
@@ -555,10 +579,25 @@ module E = struct
       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)
     | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el)
-    | Pexp_construct (lid, arg) ->
-      construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg)
-    | Pexp_variant (lab, eo) ->
-      variant ~loc ~attrs lab (map_opt (sub.expr sub) eo)
+    | Pexp_construct (lid, {txt = args; loc = args_loc}) ->
+      let lid = map_loc sub lid in
+      let args_loc = sub.location sub args_loc in
+      let arg, attrs =
+        encode_args ~map:(sub.expr sub)
+          ~tuple:(fun args -> Ast_helper0.Exp.tuple ~loc:args_loc args)
+          ~attrs
+          ~mark_args:(lid.txt <> Longident.Lident "::")
+          args
+      in
+      construct ~loc ~attrs lid arg
+    | Pexp_variant (lab, {txt = args; loc = args_loc}) ->
+      let args_loc = sub.location sub args_loc in
+      let arg, attrs =
+        encode_args ~map:(sub.expr sub)
+          ~tuple:(fun args -> Ast_helper0.Exp.tuple ~loc:args_loc args)
+          ~attrs ~mark_args:true args
+      in
+      variant ~loc ~attrs lab arg
     | Pexp_record (l, eo) ->
       record ~loc ~attrs
         (Ext_list.map l (fun {lid; x = e; opt = optional} ->
@@ -792,9 +831,25 @@ module P = struct
     | Ppat_interval (c1, c2) ->
       interval ~loc ~attrs (map_constant c1) (map_constant c2)
     | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl)
-    | Ppat_construct (l, p) ->
-      construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p)
-    | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p)
+    | Ppat_construct (l, {txt = args; loc = args_loc}) ->
+      let l = map_loc sub l in
+      let args_loc = sub.location sub args_loc in
+      let arg, attrs =
+        encode_args ~map:(sub.pat sub)
+          ~tuple:(fun args -> Ast_helper0.Pat.tuple ~loc:args_loc args)
+          ~attrs
+          ~mark_args:(l.txt <> Longident.Lident "::")
+          args
+      in
+      construct ~loc ~attrs l arg
+    | Ppat_variant (l, {txt = args; loc = args_loc}) ->
+      let args_loc = sub.location sub args_loc in
+      let arg, attrs =
+        encode_args ~map:(sub.pat sub)
+          ~tuple:(fun args -> Ast_helper0.Pat.tuple ~loc:args_loc args)
+          ~attrs ~mark_args:true args
+      in
+      variant ~loc ~attrs l arg
     | Ppat_record (lpl, cf, rest) ->
       let attrs =
         match rest with
diff --git a/compiler/ml/ast_payload.ml b/compiler/ml/ast_payload.ml
index 72f81567fb..2d0977613d 100644
--- a/compiler/ml/ast_payload.ml
+++ b/compiler/ml/ast_payload.ml
@@ -279,8 +279,8 @@ let assert_strings loc (x : t) : string list =
 
 let assert_bool_lit (e : Parsetree.expression) =
   match e.pexp_desc with
-  | Pexp_construct ({txt = Lident "true"}, None) -> true
-  | Pexp_construct ({txt = Lident "false"}, None) -> false
+  | Pexp_construct ({txt = Lident "true"}, {txt = []}) -> true
+  | Pexp_construct ({txt = Lident "false"}, {txt = []}) -> false
   | _ ->
     Location.raise_errorf ~loc:e.pexp_loc
       "expect `true` or `false` in this field"
diff --git a/compiler/ml/builtin_attributes.ml b/compiler/ml/builtin_attributes.ml
index 9aa5c5756b..15c3d43b13 100644
--- a/compiler/ml/builtin_attributes.ml
+++ b/compiler/ml/builtin_attributes.ml
@@ -207,11 +207,6 @@ let warn_on_literal_pattern =
       true
     | _ -> false)
 
-let explicit_arity =
-  List.exists (function
-    | {txt = "ocaml.explicit_arity" | "explicit_arity"; _}, _ -> true
-    | _ -> false)
-
 let immediate =
   List.exists (function
     | {txt = "ocaml.immediate" | "immediate"; _}, _ -> true
diff --git a/compiler/ml/builtin_attributes.mli b/compiler/ml/builtin_attributes.mli
index 63bf762331..a5ccce220a 100644
--- a/compiler/ml/builtin_attributes.mli
+++ b/compiler/ml/builtin_attributes.mli
@@ -20,7 +20,6 @@
    ocaml.ppwarning
    ocaml.warning
    ocaml.warnerror
-   ocaml.explicit_arity (for camlp4/camlp5)
    ocaml.warn_on_literal_pattern
    ocaml.deprecated_mutable
    ocaml.immediate
@@ -89,7 +88,6 @@ val warning_scope :
   *)
 
 val warn_on_literal_pattern : Parsetree.attributes -> bool
-val explicit_arity : Parsetree.attributes -> bool
 
 val immediate : Parsetree.attributes -> bool
 
diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml
index 50537890c5..80fc2dc8cb 100644
--- a/compiler/ml/depend.ml
+++ b/compiler/ml/depend.ml
@@ -116,7 +116,8 @@ let rec add_type bv ty =
   | Ptyp_variant (fl, _, _) ->
     List.iter
       (function
-        | Rtag (_, _, _, stl) -> List.iter (add_type bv) stl
+        | Rtag (_, _, _, groups) ->
+          List.iter (fun {txt} -> List.iter (add_type bv) txt) groups
         | Rinherit sty -> add_type bv sty)
       fl
   | Ptyp_poly (_, t) -> add_type bv t
@@ -174,9 +175,9 @@ let rec add_pattern bv pat =
   | Ppat_alias (p, _) -> add_pattern bv p
   | Ppat_interval _ | Ppat_constant _ -> ()
   | Ppat_tuple pl -> List.iter (add_pattern bv) pl
-  | Ppat_construct (c, op) ->
+  | Ppat_construct (c, {txt = args}) ->
     add bv c;
-    add_opt add_pattern bv op
+    List.iter (add_pattern bv) args
   | Ppat_record (pl, _, rest) ->
     List.iter
       (fun {lid = lbl; x = p} ->
@@ -191,7 +192,7 @@ let rec add_pattern bv pat =
   | Ppat_constraint (p, ty) ->
     add_pattern bv p;
     add_type bv ty
-  | Ppat_variant (_, op) -> add_opt add_pattern bv op
+  | Ppat_variant (_, {txt = args}) -> List.iter (add_pattern bv) args
   | Ppat_type li -> add bv li
   | Ppat_unpack id -> pattern_bv := String_map.add id.txt bound !pattern_bv
   | Ppat_open (m, p) ->
@@ -235,10 +236,10 @@ let rec add_expr bv exp =
     add_expr bv e;
     add_cases bv pel
   | Pexp_tuple el -> List.iter (add_expr bv) el
-  | Pexp_construct (c, opte) ->
+  | Pexp_construct (c, {txt = args}) ->
     add bv c;
-    add_opt add_expr bv opte
-  | Pexp_variant (_, opte) -> add_opt add_expr bv opte
+    List.iter (add_expr bv) args
+  | Pexp_variant (_, {txt = args}) -> List.iter (add_expr bv) args
   | Pexp_record (lblel, opte) ->
     List.iter
       (fun {lid = lbl; x = e} ->
@@ -301,7 +302,7 @@ let rec add_expr bv exp =
       (( {txt = "ocaml.extension_constructor" | "extension_constructor"; _},
          PStr [item] ) as e) -> (
     match item.pstr_desc with
-    | Pstr_eval ({pexp_desc = Pexp_construct (c, None)}, _) -> add bv c
+    | Pstr_eval ({pexp_desc = Pexp_construct (c, {txt = []})}, _) -> add bv c
     | _ -> handle_extension e)
   | Pexp_extension e -> handle_extension e
   | Pexp_await e -> add_expr bv e
diff --git a/compiler/ml/error_message_utils.ml b/compiler/ml/error_message_utils.ml
index 4ee3f1aeaf..cafb45f8e1 100644
--- a/compiler/ml/error_message_utils.ml
+++ b/compiler/ml/error_message_utils.ml
@@ -676,7 +676,9 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf
                 {
                   exp with
                   Parsetree.pexp_desc =
-                    Pexp_variant (String_literal.string_semantic payload, None);
+                    Pexp_variant
+                      ( String_literal.string_semantic payload,
+                        {txt = []; loc = exp.pexp_loc} );
                 }
             | _ -> None)
       in
@@ -735,7 +737,7 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf
                     Parsetree.pexp_desc =
                       Pexp_construct
                         ( {txt = Lident constructor_name; loc = exp.pexp_loc},
-                          None );
+                          {txt = []; loc = exp.pexp_loc} );
                   }
               | _ -> None)
         in
diff --git a/compiler/ml/parmatch.ml b/compiler/ml/parmatch.ml
index ef6ccd8c21..418749f5f9 100644
--- a/compiler/ml/parmatch.ml
+++ b/compiler/ml/parmatch.ml
@@ -1955,16 +1955,14 @@ module Conv = struct
         let id = fresh cstr.cstr_name in
         let lid = {cstr_lid with txt = Longident.Lident id} in
         Hashtbl.add constrs id cstr;
-        let arg =
-          match List.map loop lst with
-          | [] -> None
-          | [p] -> Some p
-          | lst -> Some (mkpat (Ppat_tuple lst))
-        in
-        mkpat (Ppat_construct (lid, arg))
+        mkpat (Ppat_construct (lid, Location.mknoloc (List.map loop lst)))
       | Tpat_variant (label, p_opt, _row_desc) ->
-        let arg = Misc.may_map loop p_opt in
-        mkpat (Ppat_variant (label, arg))
+        let args =
+          match p_opt with
+          | None -> []
+          | Some p -> [loop p]
+        in
+        mkpat (Ppat_variant (label, Location.mknoloc args))
       | Tpat_record (subpatterns, _closed_flag, rest) ->
         let fields =
           List.map
diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml
index 3044e9a08b..e3f4f520de 100644
--- a/compiler/ml/parsetree.ml
+++ b/compiler/ml/parsetree.ml
@@ -162,22 +162,28 @@ and package_type = Longident.t loc * (Longident.t loc * core_type) list
        *)
 
 and row_field =
-  | Rtag of label loc * attributes * bool * core_type list
+  | Rtag of label loc * attributes * bool * variant_type_args list
     (* [`A]                   ( true,  [] )
-        [`A of T]              ( false, [T] )
-        [`A of T1 & .. & Tn]   ( false, [T1;...Tn] )
-        [`A of & T1 & .. & Tn] ( true,  [T1;...Tn] )
+        [`A of T]              ( false, [{txt = [T]}] )
+        [`A of T1 & .. & Tn]   ( false, [{txt = [T1]};...;{txt = [Tn]}] )
+        [`A of & T1 & .. & Tn] ( true,  [{txt = [T1]};...;{txt = [Tn]}] )
+
+       Each inner list records the syntactic arity of one payload group:
+       #A(T1, ..., Tn)         [T1; ...; Tn]
+       #A((T1, ..., Tn))       [Ptyp_tuple [T1; ...; Tn]]
 
        - The 2nd field is true if the tag contains a
          constant (empty) constructor.
        - '&' occurs when several types are used for the same constructor
          (see 4.2 in the manual)
 
-       - TODO: switch to a record representation, and keep location
+       - TODO: switch to a record representation
     *)
   | Rinherit of core_type
 (* [ T ] *)
 
+and variant_type_args = core_type list loc
+
 and object_field =
   | Otag of label loc * attributes * core_type
   | Oinherit of core_type
@@ -209,14 +215,27 @@ and pattern_desc =
 
        Invariant: n >= 2
     *)
-  | Ppat_construct of Longident.t loc * pattern option
-    (* C                None
-       C P              Some P
-       C (P1, ..., Pn)  Some (Ppat_tuple [P1; ...; Pn])
+  | Ppat_construct of Longident.t loc * pattern list loc
+    (* C                  []
+       C(P)               [P]
+       C(P1, ..., Pn)     [P1; ...; Pn]
+       C((P1, ..., Pn))   [Ppat_tuple [P1; ...; Pn]]
+
+       The list's location spans the argument parentheses, including both
+       delimiters. For constructors without parentheses or generated nodes,
+       use the enclosing node's location. The v0 bridge uses the payload's
+       location when the original parentheses span is unavailable.
+
+       This list preserves syntax, not the declared constructor arity.
+       Type checking normalizes tuple grouping using the resolved constructor.
     *)
-  | Ppat_variant of label * pattern option
-    (* `A             (None)
-       `A P           (Some P)
+  | Ppat_variant of label * pattern list loc
+    (* #A                  []
+       #A(P)               [P]
+       #A(P1, ..., Pn)     [P1; ...; Pn]
+       #A((P1, ..., Pn))   [Ppat_tuple [P1; ...; Pn]]
+
+       Argument locations follow Ppat_construct.
     *)
   | Ppat_record of
       pattern record_element list * closed_flag * record_pat_rest option
@@ -298,14 +317,24 @@ and expression_desc =
 
        Invariant: n >= 2
     *)
-  | Pexp_construct of Longident.t loc * expression option
-    (* C                None
-       C E              Some E
-       C (E1, ..., En)  Some (Pexp_tuple[E1;...;En])
+  | Pexp_construct of Longident.t loc * expression list loc
+    (* C                  []
+       C(E)               [E]
+       C(E1, ..., En)     [E1; ...; En]
+       C((E1, ..., En))   [Pexp_tuple [E1; ...; En]]
+
+       Argument locations follow Ppat_construct.
+
+       This list preserves syntax, not the declared constructor arity.
+       Type checking normalizes tuple grouping using the resolved constructor.
     *)
-  | Pexp_variant of label * expression option
-    (* `A             (None)
-       `A E           (Some E)
+  | Pexp_variant of label * expression list loc
+    (* #A                  []
+       #A(E)               [E]
+       #A(E1, ..., En)     [E1; ...; En]
+       #A((E1, ..., En))   [Pexp_tuple [E1; ...; En]]
+
+       Argument locations follow Ppat_construct.
     *)
   | Pexp_record of expression record_element list * expression option
     (* { l1=P1; ...; ln=Pn }     (None)
diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml
index d421bc2b6f..6e4d1aba93 100644
--- a/compiler/ml/pprintast.ml
+++ b/compiler/ml/pprintast.ml
@@ -110,19 +110,16 @@ let view_expr x =
   match x.pexp_desc with
   | Pexp_construct ({txt = Lident "()"; _}, _) -> `tuple
   | Pexp_construct ({txt = Lident "[]"; _}, _) -> `nil
-  | Pexp_construct ({txt = Lident "::"; _}, Some _) ->
+  | Pexp_construct ({txt = Lident "::"; _}, {txt = [_; _]}) ->
     let rec loop exp acc =
       match exp with
       | {
-       pexp_desc = Pexp_construct ({txt = Lident "[]"; _}, _);
+       pexp_desc = Pexp_construct ({txt = Lident "[]"; _}, {txt = []});
        pexp_attributes = [];
       } ->
         (List.rev acc, true)
       | {
-       pexp_desc =
-         Pexp_construct
-           ( {txt = Lident "::"; _},
-             Some {pexp_desc = Pexp_tuple [e1; e2]; pexp_attributes = []} );
+       pexp_desc = Pexp_construct ({txt = Lident "::"; _}, {txt = [e1; e2]});
        pexp_attributes = [];
       } ->
         loop e2 (e1 :: acc)
@@ -130,7 +127,7 @@ let view_expr x =
     in
     let ls, b = loop x [] in
     if b then `list ls else `cons ls
-  | Pexp_construct (x, None) -> `simple x.txt
+  | Pexp_construct (x, {txt = []}) -> `simple x.txt
   | _ -> `normal
 
 let is_simple_construct : construct -> bool = function
@@ -355,7 +352,15 @@ and core_type1 ctxt f x =
     | Ptyp_variant (l, closed, low) ->
       let type_variant_helper f x =
         match x with
-        | Rtag (l, attrs, _, ctl) ->
+        | Rtag (l, attrs, _, groups) ->
+          let ctl =
+            List.map
+              (fun {loc; txt = args} ->
+                match args with
+                | [arg] -> arg
+                | args -> Ast_helper.Typ.tuple ~loc args)
+              groups
+          in
           pp f "@[<2>%a%a@;%a@]" string_quot l.txt
             (fun f l ->
               match l with
@@ -441,10 +446,7 @@ and pattern ctxt f x =
 and pattern1 ctxt (f : Format.formatter) (x : pattern) : unit =
   let rec pattern_list_helper f = function
     | {
-        ppat_desc =
-          Ppat_construct
-            ( {txt = Lident "::"; _},
-              Some {ppat_desc = Ppat_tuple [pat1; pat2]; _} );
+        ppat_desc = Ppat_construct ({txt = Lident "::"; _}, {txt = [pat1; pat2]});
         ppat_attributes = [];
       } ->
       pp f "%a::%a" (simple_pattern ctxt) pat1 pattern_list_helper pat2 (*RA*)
@@ -453,19 +455,25 @@ and pattern1 ctxt (f : Format.formatter) (x : pattern) : unit =
   if x.ppat_attributes <> [] then pattern ctxt f x
   else
     match x.ppat_desc with
-    | Ppat_variant (l, Some p) ->
-      pp f "@[<2>`%s@;%a@]" l (simple_pattern ctxt) p
+    | Ppat_variant (l, {txt = args}) when args <> [] ->
+      let payload =
+        match args with
+        | [arg] -> arg
+        | args -> Ast_helper.Pat.tuple ~loc:x.ppat_loc args
+      in
+      pp f "@[<2>`%s@;%a@]" l (simple_pattern ctxt) payload
     | Ppat_construct ({txt = Lident ("()" | "[]"); _}, _) ->
       simple_pattern ctxt f x
-    | Ppat_construct (({txt; _} as li), po) -> (
-      if
-        (* FIXME The third field always false *)
-        txt = Lident "::"
-      then pp f "%a" pattern_list_helper x
+    | Ppat_construct (({txt; _} as li), {txt = po}) -> (
+      if txt = Lident "::" && List.length po = 2 then
+        pp f "%a" pattern_list_helper x
       else
         match po with
-        | Some x -> pp f "%a@;%a" longident_loc li (simple_pattern ctxt) x
-        | None -> pp f "%a" longident_loc li)
+        | [] -> pp f "%a" longident_loc li
+        | [x] -> pp f "%a@;%a" longident_loc li (simple_pattern ctxt) x
+        | patterns ->
+          let tuple = Ast_helper.Pat.tuple ~loc:x.ppat_loc patterns in
+          pp f "%a@;%a" longident_loc li (simple_pattern ctxt) tuple)
     | _ -> simple_pattern ctxt f x
 
 and simple_pattern ctxt (f : Format.formatter) (x : pattern) : unit =
@@ -507,7 +515,7 @@ and simple_pattern ctxt (f : Format.formatter) (x : pattern) : unit =
       pp f "@[<1>(%a)@]" (list ~sep:",@;" (pattern1 ctxt)) l (* level1*)
     | Ppat_constant c -> pp f "%a" constant c
     | Ppat_interval (c1, c2) -> pp f "%a..%a" constant c1 constant c2
-    | Ppat_variant (l, None) -> pp f "`%s" l
+    | Ppat_variant (l, {txt = []}) -> pp f "`%s" l
     | Ppat_constraint (p, ct) ->
       pp f "@[<2>(%a@;:@;%a)@]" (pattern1 ctxt) p (core_type ctxt) ct
     | Ppat_exception p -> pp f "@[<2>exception@;%a@]" (pattern1 ctxt) p
@@ -717,12 +725,18 @@ and expression ctxt f x =
               (* reset here only because [function,match,try,sequence]
                  are lower priority *)
             (e, l) partial_str)
-    | Pexp_construct (li, Some eo) when not (is_simple_construct (view_expr x))
-      -> (
+    | Pexp_construct (li, {txt = args})
+      when args <> [] && not (is_simple_construct (view_expr x)) -> (
       (* Not efficient FIXME*)
       match view_expr x with
       | `cons ls -> list (simple_expr ctxt) f ls ~sep:"@;::@;"
-      | `normal -> pp f "@[<2>%a@;%a@]" longident_loc li (simple_expr ctxt) eo
+      | `normal ->
+        let arg =
+          match args with
+          | [arg] -> arg
+          | args -> Ast_helper.Exp.tuple ~loc:x.pexp_loc args
+        in
+        pp f "@[<2>%a@;%a@]" longident_loc li (simple_expr ctxt) arg
       | _ -> assert false)
     | Pexp_setfield (e1, li, e2) ->
       pp f "@[<2>%a.%a@ <-@ %a@]" (simple_expr ctxt) e1 longident_loc li
@@ -758,7 +772,13 @@ and expression ctxt f x =
     | Pexp_open (ovf, lid, e) ->
       pp f "@[<2>let open%s %a in@;%a@]" (override ovf) longident_loc lid
         (expression ctxt) e
-    | Pexp_variant (l, Some eo) -> pp f "@[<2>`%s@;%a@]" l (simple_expr ctxt) eo
+    | Pexp_variant (l, {txt = args}) when args <> [] ->
+      let payload =
+        match args with
+        | [arg] -> arg
+        | args -> Ast_helper.Exp.tuple ~loc:x.pexp_loc args
+      in
+      pp f "@[<2>`%s@;%a@]" l (simple_expr ctxt) payload
     | Pexp_extension e -> extension ctxt f e
     | Pexp_await e -> pp f "@[<hov2>await@ %a@]" (simple_expr ctxt) e
     | Pexp_template {source_segments; values} ->
@@ -828,7 +848,7 @@ and simple_expr ctxt f x =
       pp f "(%a : %a)" (expression ctxt) e (core_type ctxt) ct
     | Pexp_coerce (e, (), ct) ->
       pp f "(%a :> %a)" (expression ctxt) e (core_type ctxt) ct
-    | Pexp_variant (l, None) -> pp f "`%s" l
+    | Pexp_variant (l, {txt = []}) -> pp f "`%s" l
     | Pexp_record (l, eo) ->
       let longident_x_expression f {lid = li; x = e; opt} =
         let opt_str = if opt then "?" else "" in
diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml
index b15cecd6f3..4e5e52d07f 100644
--- a/compiler/ml/printast.ml
+++ b/compiler/ml/printast.ml
@@ -203,12 +203,12 @@ and pattern i ppf x =
   | Ppat_tuple l ->
     line i ppf "Ppat_tuple\n";
     list i pattern ppf l
-  | Ppat_construct (li, po) ->
+  | Ppat_construct (li, {txt = po}) ->
     line i ppf "Ppat_construct %a\n" fmt_longident_loc li;
-    option i pattern ppf po
-  | Ppat_variant (l, po) ->
+    list i pattern ppf po
+  | Ppat_variant (l, {txt = args}) ->
     line i ppf "Ppat_variant \"%s\"\n" l;
-    option i pattern ppf po
+    list i pattern ppf args
   | Ppat_record (l, c, rest) -> (
     line i ppf "Ppat_record %a\n" fmt_closed_flag c;
     list i longident_x_pattern ppf l;
@@ -294,12 +294,12 @@ and expression i ppf x =
   | Pexp_tuple l ->
     line i ppf "Pexp_tuple\n";
     list i expression ppf l
-  | Pexp_construct (li, eo) ->
+  | Pexp_construct (li, {txt = args}) ->
     line i ppf "Pexp_construct %a\n" fmt_longident_loc li;
-    option i expression ppf eo
-  | Pexp_variant (l, eo) ->
+    list i expression ppf args
+  | Pexp_variant (l, {txt = args}) ->
     line i ppf "Pexp_variant \"%s\"\n" l;
-    option i expression ppf eo
+    list i expression ppf args
   | Pexp_record (l, eo) ->
     line i ppf "Pexp_record\n";
     list i longident_x_expression ppf l;
@@ -778,10 +778,12 @@ and label_x_expression i ppf (l, e) =
 
 and label_x_bool_x_core_type_list i ppf x =
   match x with
-  | Rtag (l, attrs, b, ctl) ->
+  | Rtag (l, attrs, b, groups) ->
     line i ppf "Rtag \"%s\" %s\n" l.txt (string_of_bool b);
     attributes (i + 1) ppf attrs;
-    list (i + 1) core_type ppf ctl
+    list (i + 1)
+      (fun i ppf {txt = types} -> list i core_type ppf types)
+      ppf groups
   | Rinherit ct ->
     line i ppf "Rinherit\n";
     core_type (i + 1) ppf ct
diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml
index 00b6b60e72..8674b3c998 100644
--- a/compiler/ml/typecore.ml
+++ b/compiler/ml/typecore.ml
@@ -184,8 +184,11 @@ let iter_expression f e =
     | Pexp_match (e, pel) | Pexp_try (e, pel) ->
       expr e;
       List.iter case pel
-    | Pexp_array el | Pexp_tuple el -> List.iter expr el
-    | Pexp_construct (_, eo) | Pexp_variant (_, eo) -> may expr eo
+    | Pexp_array args
+    | Pexp_tuple args
+    | Pexp_construct (_, {txt = args})
+    | Pexp_variant (_, {txt = args}) ->
+      List.iter expr args
     | Pexp_record (iel, eo) ->
       may expr eo;
       List.iter (fun {x = e} -> expr e) iel
@@ -677,9 +680,13 @@ let build_ppat_or_for_variant_spread pat env expected_ty =
                ( Location.mkloc
                    (Longident.Lident (Ident.name c.cd_id))
                    lident.loc,
-                 match c.cd_args with
-                 | Cstr_tuple [] -> None
-                 | _ -> Some (Ast_helper.Pat.any ()) )))
+                 {
+                   loc = lident.loc;
+                   txt =
+                     (match c.cd_args with
+                     | Cstr_tuple [] -> []
+                     | _ -> [Ast_helper.Pat.any ()]);
+                 } )))
       |> List.rev
     in
     let pat =
@@ -1211,6 +1218,21 @@ 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 normalize_constructor_expr_args ~arity {Location.txt = sargs; loc} =
+  match sargs with
+  | [{pexp_desc = Pexp_tuple args}] when arity > 1 -> args
+  | _ :: _ :: _ when arity = 1 -> [Ast_helper.Exp.tuple ~loc sargs]
+  | sargs -> sargs
+
+let normalize_constructor_pat_args ~arity {Location.txt = sargs; loc} =
+  match sargs with
+  | [{ppat_desc = Ppat_tuple args}] when arity > 1 -> args
+  | _ :: _ :: _ when arity = 1 -> [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. *)
@@ -1388,7 +1410,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
             pat_attributes = sp.ppat_attributes;
             pat_env = !env;
           })
-  | Ppat_construct (lid, sarg) ->
+  | Ppat_construct (lid, sargs) ->
     let opath =
       try
         let p0, p, _ = extract_concrete_variant !env expected_ty in
@@ -1423,18 +1445,13 @@ 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 sarg with
-      | None -> []
-      | Some {ppat_desc = Ppat_tuple spl}
-        when constr.cstr_arity > 1
-             || Builtin_attributes.explicit_arity sp.ppat_attributes ->
-        spl
-      | Some ({ppat_desc = Ppat_any} as sp) when constr.cstr_arity <> 1 ->
+      match normalize_constructor_pat_args ~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
             Warnings.Wildcard_arg_to_constant_constr;
         replicate_list sp constr.cstr_arity
-      | Some sp -> [sp]
+      | sargs -> sargs
     in
     (match sargs with
     | [({ppat_desc = Ppat_constant _} as sp)]
@@ -1486,8 +1503,14 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
             pat_attributes = sp.ppat_attributes;
             pat_env = !env;
           })
-  | Ppat_variant (l, sarg) -> (
+  | Ppat_variant (l, {txt = sargs; loc = args_loc}) -> (
     check_polyvar_name !env loc l;
+    let sarg =
+      match sargs with
+      | [] -> None
+      | [sarg] -> Some sarg
+      | sargs -> Some (Ast_helper.Pat.tuple ~loc:args_loc sargs)
+    in
     let arg_type =
       match sarg with
       | None -> []
@@ -1553,7 +1576,8 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
       if label_is_optional ld && (not exp_optional_attr) && not is_from_pamatch
       then
         let lid = mknoloc Longident.(Ldot (Lident "*predef*", "Some")) in
-        Ast_helper.Pat.construct ~loc:pat.ppat_loc lid (Some pat)
+        Ast_helper.Pat.construct ~loc:pat.ppat_loc lid
+          (Location.mkloc [pat] pat.ppat_loc)
       else pat
     in
     let type_label_pat (label_lid, label, sarg, opt) k =
@@ -2171,7 +2195,8 @@ let iter_ppat f p =
   | Ppat_or (p1, p2) ->
     f p1;
     f p2
-  | Ppat_variant (_, arg) | Ppat_construct (_, arg) -> may f arg
+  | Ppat_construct (_, {txt = args}) -> List.iter f args
+  | Ppat_variant (_, {txt = args}) -> List.iter f args
   | Ppat_tuple lst -> List.iter f lst
   | Ppat_exception p
   | Ppat_alias (p, _)
@@ -2426,7 +2451,10 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp
     let exp_optional_attr = check_optional_attr env ld opt e.pexp_loc in
     if label_is_optional ld && not exp_optional_attr then
       let lid = mknoloc Longident.(Ldot (Lident "*predef*", "Some")) in
-      let e = Ast_helper.Exp.construct ~loc:e.pexp_loc lid (Some e) in
+      let e =
+        Ast_helper.Exp.construct ~loc:e.pexp_loc lid
+          (Location.mkloc [e] e.pexp_loc)
+      in
       (id, ld, e, opt)
     else (id, ld, e, opt)
   in
@@ -2737,10 +2765,16 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp
         exp_attributes = sexp.pexp_attributes;
         exp_env = env;
       }
-  | Pexp_construct (lid, sarg) ->
-    type_construct ~context env loc lid sarg ty_expected sexp.pexp_attributes
-  | Pexp_variant (l, sarg) -> (
+  | Pexp_construct (lid, sargs) ->
+    type_construct ~context env loc lid sargs ty_expected sexp.pexp_attributes
+  | Pexp_variant (l, {txt = sargs; loc = args_loc}) -> (
     check_polyvar_name env loc l;
+    let sarg =
+      match sargs with
+      | [] -> None
+      | [sarg] -> Some sarg
+      | sargs -> Some (Ast_helper.Exp.tuple ~loc:args_loc sargs)
+    in
     (* Keep sharing *)
     let ty_expected0 = instance env ty_expected in
     try
@@ -3553,7 +3587,7 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp
         [
           {
             pstr_desc =
-              Pstr_eval ({pexp_desc = Pexp_construct (lid, None); _}, _);
+              Pstr_eval ({pexp_desc = Pexp_construct (lid, {txt = []}); _}, _);
           };
         ] ->
       let path =
@@ -3662,13 +3696,15 @@ and type_function ~async loc attrs env ty_expected_
               Exp.case
                 (Pat.construct ~loc:default_loc
                    (mknoloc Longident.(Ldot (Lident "*predef*", "Some")))
-                   (Some (Pat.var ~loc:default_loc (mknoloc "*sth*"))))
+                   (Location.mkloc
+                      [Pat.var ~loc:default_loc (mknoloc "*sth*")]
+                      default_loc))
                 (Exp.ident ~loc:default_loc
                    (mknoloc (Longident.Lident "*sth*")));
               Exp.case
                 (Pat.construct ~loc:default_loc
                    (mknoloc Longident.(Ldot (Lident "*predef*", "None")))
-                   None)
+                   (Location.mkloc [] default_loc))
                 default;
             ]
           in
@@ -4340,7 +4376,9 @@ and type_application ~context total_app env funct (sargs : sargs) :
       (* Leftover syntactic arguments *)
       (match !remaining with
       | [] -> ()
-      | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})]
+      | [
+       (Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, {txt = []})});
+      ]
         when total_app && !omitted = [] && !rev_args <> []
              && List.length !rev_args = List.length !ignored ->
         (* foo() treated as empty application if all args are optional
@@ -4404,7 +4442,7 @@ and type_application ~context total_app env funct (sargs : sargs) :
              env,
              Apply_non_function (expand_head env funct.exp_type) )))
 
-and type_construct ~context env loc lid sarg ty_expected attrs =
+and type_construct ~context env loc lid sargs ty_expected attrs =
   let opath =
     try
       let p0, p, _ = extract_concrete_variant env ty_expected in
@@ -4420,14 +4458,7 @@ and type_construct ~context env loc lid sarg 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 sarg with
-    | None -> []
-    | Some {pexp_desc = Pexp_tuple sel}
-      when constr.cstr_arity > 1 || Builtin_attributes.explicit_arity attrs ->
-      sel
-    | Some se -> [se]
-  in
+  let sargs = normalize_constructor_expr_args ~arity:constr.cstr_arity sargs in
   if List.length sargs <> constr.cstr_arity then
     raise
       (Error
diff --git a/compiler/ml/typetexp.ml b/compiler/ml/typetexp.ml
index d72edc9900..6ab2a3ef34 100644
--- a/compiler/ml/typetexp.ml
+++ b/compiler/ml/typetexp.ml
@@ -437,8 +437,16 @@ and transl_type_aux env policy styp =
       with Not_found -> Hashtbl.add hfields l (l, f)
     in
     let add_field = function
-      | Rtag (l, attrs, c, stl) ->
+      | Rtag (l, attrs, c, groups) ->
         name := None;
+        let stl =
+          List.map
+            (fun {loc; txt = args} ->
+              match args with
+              | [arg] -> arg
+              | args -> Ast_helper.Typ.tuple ~loc args)
+            groups
+        in
         let tl =
           Builtin_attributes.warning_scope attrs (fun () ->
               List.map (transl_type env policy) stl)
diff --git a/compiler/syntax/cli/res_cli.ml b/compiler/syntax/cli/res_cli.ml
index dae94cd7cc..82f359634b 100644
--- a/compiler/syntax/cli/res_cli.ml
+++ b/compiler/syntax/cli/res_cli.ml
@@ -160,7 +160,6 @@ module Res_clflags : sig
   val interface : bool ref
   val jsx_version : int ref
   val jsx_module : string ref
-  val typechecker : bool ref
   val test_ast_conversion : bool ref
 
   val parse : unit -> unit
@@ -173,7 +172,6 @@ end = struct
   let jsx_version = ref (-1)
   let jsx_module = ref "react"
   let file = ref ""
-  let typechecker = ref false
   let test_ast_conversion = ref false
 
   let usage =
@@ -206,10 +204,6 @@ end = struct
       ( "-jsx-module",
         Arg.String (fun txt -> jsx_module := txt),
         "Specify the jsx module. Default: react" );
-      ( "-typechecker",
-        Arg.Unit (fun () -> typechecker := true),
-        "Parses the ast as it would be passed to the typechecker and not the \
-         printer" );
       ( "-test-ast-conversion",
         Arg.Unit (fun () -> test_ast_conversion := true),
         "Test the ast conversion" );
@@ -223,7 +217,7 @@ module Cli_arg_processor = struct
   [@@unboxed]
 
   let process_file ~is_interface ~width ~recover ~target ~jsx_version
-      ~jsx_module ~typechecker ~test_ast_conversion filename =
+      ~jsx_module ~test_ast_conversion filename =
     let len = String.length filename in
     let process_interface =
       is_interface
@@ -246,12 +240,6 @@ module Cli_arg_processor = struct
         exit 1
     in
 
-    let for_printer =
-      match target with
-      | ("res" | "sexp") when not typechecker -> true
-      | _ -> false
-    in
-
     let (Parser backend) = parsing_engine in
     (* This is the whole purpose of the Color module above *)
     Color.setup None;
@@ -260,7 +248,7 @@ module Cli_arg_processor = struct
     if target = "tokens" then
       print_engine.print_implementation ~width ~filename ~comments:[] []
     else if process_interface then
-      let parse_result = backend.parse_interface ~for_printer ~filename in
+      let parse_result = backend.parse_interface ~filename in
       if parse_result.invalid then (
         backend.string_of_diagnostics ~source:parse_result.source
           ~filename:parse_result.filename parse_result.diagnostics;
@@ -285,7 +273,7 @@ module Cli_arg_processor = struct
         print_engine.print_interface ~width ~filename
           ~comments:parse_result.comments parsetree
     else
-      let parse_result = backend.parse_implementation ~for_printer ~filename in
+      let parse_result = backend.parse_implementation ~filename in
       if parse_result.invalid then (
         backend.string_of_diagnostics ~source:parse_result.source
           ~filename:parse_result.filename parse_result.diagnostics;
@@ -318,7 +306,6 @@ let () =
     Cli_arg_processor.process_file ~is_interface:!Res_clflags.interface
       ~width:!Res_clflags.width ~recover:!Res_clflags.recover
       ~target:!Res_clflags.print ~jsx_version:!Res_clflags.jsx_version
-      ~jsx_module:!Res_clflags.jsx_module ~typechecker:!Res_clflags.typechecker
-      !Res_clflags.file
+      ~jsx_module:!Res_clflags.jsx_module !Res_clflags.file
       ~test_ast_conversion:!Res_clflags.test_ast_conversion)
 [@@raises exit]
diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml
index 9b15ed3f30..4a7775fdb6 100644
--- a/compiler/syntax/src/jsx_v4.ml
+++ b/compiler/syntax/src/jsx_v4.ml
@@ -32,7 +32,8 @@ let get_label str =
 let constant_string ~loc str =
   Ast_helper.Exp.constant ~loc (Ast_helper.Const.string str)
 
-let unit_expr ~loc = Exp.construct ~loc (Location.mkloc (Lident "()") loc) None
+let unit_expr ~loc =
+  Exp.construct ~loc (Location.mkloc (Lident "()") loc) (Location.mkloc [] loc)
 
 let safe_type_from_value value_str =
   let value_str = get_label value_str in
@@ -513,10 +514,12 @@ let vb_match ~expr (name, default, pattern, _alias, loc, _) =
              Exp.case
                (Pat.construct
                   (Location.mknoloc @@ Lident "Some")
-                  (Some (Pat.var (Location.mknoloc label))))
+                  (Location.mknoloc [Pat.var (Location.mknoloc label)]))
                (Exp.ident (Location.mknoloc @@ Lident label));
              Exp.case
-               (Pat.construct (Location.mknoloc @@ Lident "None") None)
+               (Pat.construct
+                  (Location.mknoloc @@ Lident "None")
+                  (Location.mknoloc []))
                default;
            ])
     in
diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml
index 1dde1a2566..32a76a1ca9 100644
--- a/compiler/syntax/src/res_ast_debugger.ml
+++ b/compiler/syntax/src/res_ast_debugger.ml
@@ -633,23 +633,19 @@ module Sexp_ast = struct
       | Pexp_tuple exprs ->
         Sexp.list
           [Sexp.atom "Pexp_tuple"; Sexp.list (map_empty ~f:expression exprs)]
-      | Pexp_construct (longident_loc, expr_opt) ->
+      | Pexp_construct (longident_loc, {txt = exprs}) ->
         Sexp.list
           [
             Sexp.atom "Pexp_construct";
             longident longident_loc.Asttypes.txt;
-            (match expr_opt with
-            | None -> Sexp.atom "None"
-            | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr]);
+            Sexp.list (map_empty ~f:expression exprs);
           ]
-      | Pexp_variant (lbl, expr_opt) ->
+      | Pexp_variant (lbl, {txt = exprs}) ->
         Sexp.list
           [
             Sexp.atom "Pexp_variant";
             string lbl;
-            (match expr_opt with
-            | None -> Sexp.atom "None"
-            | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr]);
+            Sexp.list (map_empty ~f:expression exprs);
           ]
       | Pexp_record (rows, opt_expr) ->
         Sexp.list
@@ -846,23 +842,19 @@ module Sexp_ast = struct
       | Ppat_tuple patterns ->
         Sexp.list
           [Sexp.atom "Ppat_tuple"; Sexp.list (map_empty ~f:pattern patterns)]
-      | Ppat_construct (longident_loc, opt_pattern) ->
+      | Ppat_construct (longident_loc, {txt = patterns}) ->
         Sexp.list
           [
             Sexp.atom "Ppat_construct";
             longident longident_loc.Location.txt;
-            (match opt_pattern with
-            | None -> Sexp.atom "None"
-            | Some p -> Sexp.list [Sexp.atom "some"; pattern p]);
+            Sexp.list (map_empty ~f:pattern patterns);
           ]
-      | Ppat_variant (lbl, opt_pattern) ->
+      | Ppat_variant (lbl, {txt = patterns}) ->
         Sexp.list
           [
             Sexp.atom "Ppat_variant";
             string lbl;
-            (match opt_pattern with
-            | None -> Sexp.atom "None"
-            | Some p -> Sexp.list [Sexp.atom "Some"; pattern p]);
+            Sexp.list (map_empty ~f:pattern patterns);
           ]
       | Ppat_record (rows, flag, rest) ->
         Sexp.list
@@ -935,7 +927,11 @@ module Sexp_ast = struct
           string label_loc.txt;
           attributes attrs;
           Sexp.atom (if truth then "true" else "false");
-          Sexp.list (map_empty ~f:core_type types);
+          Sexp.list
+            (map_empty
+               ~f:(fun {Location.txt = types} ->
+                 Sexp.list (map_empty ~f:core_type types))
+               types);
         ]
     | Rinherit typexpr -> Sexp.list [Sexp.atom "Rinherit"; core_type typexpr]
 
diff --git a/compiler/syntax/src/res_comments_table.ml b/compiler/syntax/src/res_comments_table.ml
index 4a689a51c5..bb2afa3a94 100644
--- a/compiler/syntax/src/res_comments_table.ml
+++ b/compiler/syntax/src/res_comments_table.ml
@@ -296,19 +296,21 @@ let partition_between_lines start_line end_line comments =
 let rec collect_list_patterns acc pattern =
   let open Parsetree in
   match pattern.ppat_desc with
+  | Ppat_construct ({txt = Longident.Lident "::"}, {txt = [pat; rest]})
   | Ppat_construct
-      ({txt = Longident.Lident "::"}, Some {ppat_desc = Ppat_tuple [pat; rest]})
-    ->
+      ( {txt = Longident.Lident "::"},
+        {txt = [{ppat_desc = Ppat_tuple [pat; rest]}]} ) ->
     collect_list_patterns (pat :: acc) rest
-  | Ppat_construct ({txt = Longident.Lident "[]"}, None) -> List.rev acc
+  | Ppat_construct ({txt = Longident.Lident "[]"}, {txt = []}) -> List.rev acc
   | _ -> List.rev (pattern :: acc)
 
 let rec collect_list_exprs acc expr =
   let open Parsetree in
   match expr.pexp_desc with
+  | Pexp_construct ({txt = Longident.Lident "::"}, {txt = [expr; rest]})
   | Pexp_construct
-      ({txt = Longident.Lident "::"}, Some {pexp_desc = Pexp_tuple [expr; rest]})
-    ->
+      ( {txt = Longident.Lident "::"},
+        {txt = [{pexp_desc = Pexp_tuple [expr; rest]}]} ) ->
     collect_list_exprs (expr :: acc) rest
   | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> List.rev acc
   | _ -> List.rev (expr :: acc)
@@ -1007,7 +1009,8 @@ and walk_expression expr t comments =
   | Pexp_let
       ( _recFlag,
         value_bindings,
-        {pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None)} ) ->
+        {pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, {txt = []})}
+      ) ->
     walk_value_bindings value_bindings t comments
   | Pexp_let (_recFlag, value_bindings, expr2) ->
     let comments =
@@ -1159,19 +1162,19 @@ and walk_expression expr t comments =
     walk_list
       (collect_list_exprs [] expr |> List.map (fun e -> Expression e))
       t comments
-  | Pexp_construct (longident, args) -> (
+  | Pexp_construct (longident, {txt = args}) -> (
     let leading, trailing = partition_leading_trailing comments longident.loc in
     attach t.leading longident.loc leading;
     match args with
-    | Some expr ->
+    | _ :: _ as exprs ->
       let after_longident, rest =
         partition_adjacent_trailing longident.loc trailing
       in
       attach t.trailing longident.loc after_longident;
-      walk_expression expr t rest
-    | None -> attach t.trailing longident.loc trailing)
-  | Pexp_variant (_label, None) -> ()
-  | Pexp_variant (_label, Some expr) -> walk_expression expr t comments
+      walk_list (List.map (fun expr -> Expression expr) exprs) t rest
+    | [] -> attach t.trailing longident.loc trailing)
+  | Pexp_variant (_label, {txt = args}) ->
+    walk_list (List.map (fun expr -> Expression expr) args) t comments
   | Pexp_array exprs | Pexp_tuple exprs ->
     walk_list (exprs |> List.map (fun e -> Expression e)) t comments
   | Pexp_record (rows, spread_expr) ->
@@ -2057,13 +2060,13 @@ and walk_pattern pat t comments =
     walk_list
       (collect_list_patterns [] pat |> List.map (fun p -> Pattern p))
       t comments
-  | Ppat_construct (constr, None) ->
+  | Ppat_construct (constr, {txt = []}) ->
     let before_constr, after_constr =
       partition_leading_trailing comments constr.loc
     in
     attach t.leading constr.loc before_constr;
     attach t.trailing constr.loc after_constr
-  | Ppat_construct (constr, Some pat) ->
+  | Ppat_construct (constr, {txt = [pat]}) ->
     let leading, trailing = partition_leading_trailing comments constr.loc in
     attach t.leading constr.loc leading;
     let after_constructor, rest =
@@ -2074,8 +2077,16 @@ and walk_pattern pat t comments =
     attach t.leading pat.ppat_loc leading;
     walk_pattern pat t inside;
     attach t.trailing pat.ppat_loc trailing
-  | Ppat_variant (_label, None) -> ()
-  | Ppat_variant (_label, Some pat) -> walk_pattern pat t comments
+  | Ppat_construct (constr, {txt = pats}) ->
+    let leading, trailing = partition_leading_trailing comments constr.loc in
+    attach t.leading constr.loc leading;
+    let after_constructor, rest =
+      partition_adjacent_trailing constr.loc trailing
+    in
+    attach t.trailing constr.loc after_constructor;
+    walk_list (List.map (fun pat -> Pattern pat) pats) t rest
+  | Ppat_variant (_label, {txt = args}) ->
+    walk_list (List.map (fun pat -> Pattern pat) args) t comments
   | Ppat_type _ -> ()
   | Ppat_record (record_rows, _, rest) ->
     let nodes =
diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml
index adfb7f34e8..1445419774 100644
--- a/compiler/syntax/src/res_core.ml
+++ b/compiler/syntax/src/res_core.ml
@@ -590,7 +590,7 @@ let make_list_pattern loc seq ext_opt =
         | None ->
           let loc = {loc with Location.loc_ghost = true} in
           let nil = {Location.txt = Longident.Lident "[]"; loc} in
-          Ast_helper.Pat.construct ~loc nil None
+          Ast_helper.Pat.construct ~loc nil (Location.mkloc [] loc)
       in
       base_case
     | p1 :: pl ->
@@ -598,9 +598,10 @@ let make_list_pattern loc seq ext_opt =
       let loc =
         mk_loc p1.Parsetree.ppat_loc.loc_start pat_pl.ppat_loc.loc_end
       in
-      let arg = Ast_helper.Pat.mk ~loc (Ppat_tuple [p1; pat_pl]) in
       Ast_helper.Pat.mk ~loc
-        (Ppat_construct (Location.mkloc (Longident.Lident "::") loc, Some arg))
+        (Ppat_construct
+           ( Location.mkloc (Longident.Lident "::") loc,
+             {txt = [p1; pat_pl]; loc} ))
   in
   handle_seq seq
 
@@ -1246,7 +1247,7 @@ let rec parse_pattern ?(alias = true) ?(or_ = true) p =
       let loc = mk_loc start_pos end_pos in
       Ast_helper.Pat.construct ~loc
         (Location.mkloc (Longident.Lident (Token.to_string token)) loc)
-        None
+        (Location.mkloc [] loc)
     | Int _ | String _ | Float _ | Codepoint _ | Minus | Plus -> (
       let c = parse_constant p in
       match p.token with
@@ -1265,7 +1266,7 @@ let rec parse_pattern ?(alias = true) ?(or_ = true) p =
         Parser.next p;
         let loc = mk_loc start_pos p.prev_end_pos in
         let lid = Location.mkloc (Longident.Lident "()") loc in
-        Ast_helper.Pat.construct ~loc lid None
+        Ast_helper.Pat.construct ~loc lid (Location.mkloc [] loc)
       | _ -> (
         let pat = parse_constrained_pattern p in
         match p.token with
@@ -1302,7 +1303,9 @@ let rec parse_pattern ?(alias = true) ?(or_ = true) p =
       let constr = parse_module_long_ident ~lowercase:false p in
       match p.Parser.token with
       | Lparen -> parse_constructor_pattern_args p constr start_pos attrs
-      | _ -> Ast_helper.Pat.construct ~loc:constr.loc ~attrs constr None)
+      | _ ->
+        Ast_helper.Pat.construct ~loc:constr.loc ~attrs constr
+          (Location.mkloc [] constr.loc))
     | DotDotDot ->
       Parser.next p;
       let ident = parse_value_path p in
@@ -1342,7 +1345,7 @@ let rec parse_pattern ?(alias = true) ?(or_ = true) p =
         in
         match p.Parser.token with
         | Lparen -> parse_variant_pattern_args p ident start_pos attrs
-        | _ -> Ast_helper.Pat.variant ~loc ~attrs ident None)
+        | _ -> Ast_helper.Pat.variant ~loc ~attrs ident (Location.mkloc [] loc))
     | Exception ->
       Parser.next p;
       let pat = parse_pattern ~alias:false ~or_:false p in
@@ -1738,7 +1741,7 @@ and parse_array_pattern ~attrs p =
   let loc = mk_loc start_pos p.prev_end_pos in
   Ast_helper.Pat.array ~loc ~attrs patterns
 
-and parse_constructor_pattern_args p constr start_pos attrs =
+and parse_pattern_args (p : Parser.t) =
   let lparen = p.start_pos in
   Parser.expect Lparen p;
   let args =
@@ -1746,56 +1749,27 @@ and parse_constructor_pattern_args p constr start_pos attrs =
       ~f:parse_constrained_pattern_region
   in
   Parser.expect Rparen p;
+  let loc = mk_loc lparen p.prev_end_pos in
   let args =
     match args with
     | [] ->
-      let loc = mk_loc lparen p.prev_end_pos in
-      Some
-        (Ast_helper.Pat.construct ~loc
-           (Location.mkloc (Longident.Lident "()") loc)
-           None)
-    | [({ppat_desc = Ppat_tuple _} as pat)] as patterns ->
-      if p.mode = ParseForTypeChecker then
-        (* Some(1, 2) for type-checker *)
-        Some pat
-      else
-        (* Some((1, 2)) for printer *)
-        Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns)
-    | [pattern] -> Some pattern
-    | patterns ->
-      Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns)
+      [
+        Ast_helper.Pat.construct ~loc
+          (Location.mkloc (Longident.Lident "()") loc)
+          (Location.mkloc [] loc);
+      ]
+    | patterns -> patterns
   in
+  Location.mkloc args loc
+
+and parse_constructor_pattern_args p constr start_pos attrs =
+  let args = parse_pattern_args p in
   Ast_helper.Pat.construct
     ~loc:(mk_loc start_pos p.prev_end_pos)
     ~attrs constr args
 
 and parse_variant_pattern_args p ident start_pos attrs =
-  let lparen = p.start_pos in
-  Parser.expect Lparen p;
-  let patterns =
-    parse_comma_delimited_region p ~grammar:Grammar.PatternList ~closing:Rparen
-      ~f:parse_constrained_pattern_region
-  in
-  let args =
-    match patterns with
-    | [] ->
-      let loc = mk_loc lparen p.prev_end_pos in
-      Some
-        (Ast_helper.Pat.construct ~loc
-           (Location.mkloc (Longident.Lident "()") loc)
-           None)
-    | [({ppat_desc = Ppat_tuple _} as pat)] as patterns ->
-      if p.mode = ParseForTypeChecker then
-        (* #ident(1, 2) for type-checker *)
-        Some pat
-      else
-        (* #ident((1, 2)) for printer *)
-        Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns)
-    | [pattern] -> Some pattern
-    | patterns ->
-      Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns)
-  in
-  Parser.expect Rparen p;
+  let args = parse_pattern_args p in
   Ast_helper.Pat.variant
     ~loc:(mk_loc start_pos p.prev_end_pos)
     ~attrs ident args
@@ -2020,7 +1994,7 @@ and parse_parameters p : fundef_type_param list * fundef_term_param list =
     let unit_pattern =
       Ast_helper.Pat.construct ~loc
         (Location.mkloc (Longident.Lident "()") loc)
-        None
+        (Location.mkloc [] loc)
     in
     {p_label = Asttypes.Nolabel; expr = None; pat = unit_pattern}
   in
@@ -2124,7 +2098,7 @@ and parse_atomic_expr p =
       let loc = mk_loc start_pos p.prev_end_pos in
       Ast_helper.Exp.construct ~loc
         (Location.mkloc (Longident.Lident (Token.to_string token)) loc)
-        None
+        (Location.mkloc [] loc)
     | Int _ | String _ | Float _ | Codepoint _ ->
       let c = parse_constant p in
       let loc = mk_loc start_pos p.prev_end_pos in
@@ -2142,7 +2116,7 @@ and parse_atomic_expr p =
         let loc = mk_loc start_pos p.prev_end_pos in
         Ast_helper.Exp.construct ~loc
           (Location.mkloc (Longident.Lident "()") loc)
-          None
+          (Location.mkloc [] loc)
       | _t -> (
         let expr = parse_constrained_or_coerced_expr p in
         match p.token with
@@ -2602,8 +2576,10 @@ and over_parse_constrained_or_coerced_or_arrow_expression p expr =
                  (Longident.flatten longident.txt |> String.concat ".")
                  longident.loc),
             false )
-        | Pexp_construct (({txt = Longident.Lident "()"} as lid), None) ->
-          (Ast_helper.Pat.construct ~loc:expr.pexp_loc lid None, true)
+        | Pexp_construct (({txt = Longident.Lident "()"} as lid), {txt = []}) ->
+          ( Ast_helper.Pat.construct ~loc:expr.pexp_loc lid
+              (Location.mkloc [] expr.pexp_loc),
+            true )
         (* TODO: can we convert more expressions to patterns?*)
         | _ ->
           ( Ast_helper.Pat.var ~loc:expr.pexp_loc
@@ -3627,7 +3603,7 @@ and parse_expr_block_item p =
         let loc = mk_loc p.start_pos p.end_pos in
         Ast_helper.Exp.construct ~loc
           (Location.mkloc (Longident.Lident "()") loc)
-          None
+          (Location.mkloc [] loc)
     in
     let loc = mk_loc start_pos p.prev_end_pos in
     Ast_helper.Exp.let_ ~loc rec_flag let_bindings next
@@ -3780,7 +3756,7 @@ and parse_if_let_expr start_pos p =
       let loc = mk_loc start_pos p.prev_end_pos in
       Ast_helper.Exp.construct ~loc
         (Location.mkloc (Longident.Lident "()") loc)
-        None
+        (Location.mkloc [] loc)
   in
   let loc = mk_loc start_pos p.prev_end_pos in
   Ast_helper.Exp.match_
@@ -3886,7 +3862,7 @@ and parse_for_expression p =
         let unit_pattern =
           let loc = mk_loc lparen p.prev_end_pos in
           let lid = Location.mkloc (Longident.Lident "()") loc in
-          Ast_helper.Pat.construct lid None
+          Ast_helper.Pat.construct lid {txt = []; loc}
         in
         parse_for_rest false ~await:false
           (parse_alias_pattern ~attrs:[] unit_pattern p)
@@ -3916,7 +3892,7 @@ and parse_for_expression p =
           let unit_pattern =
             let loc = mk_loc lparen p.prev_end_pos in
             let lid = Location.mkloc (Longident.Lident "()") loc in
-            Ast_helper.Pat.construct lid None
+            Ast_helper.Pat.construct lid {txt = []; loc}
           in
           parse_for_rest false ~await:true
             (parse_alias_pattern ~attrs:[] unit_pattern p)
@@ -4050,7 +4026,7 @@ and parse_argument p : argument option =
         let unit_expr =
           Ast_helper.Exp.construct
             (Location.mknoloc (Longident.Lident "()"))
-            None
+            (Location.mknoloc [])
         in
         Some {label = Asttypes.Nolabel; expr = unit_expr}
       | _ -> parse_argument2 p)
@@ -4182,7 +4158,7 @@ and parse_call_expr p fun_expr =
           expr =
             Ast_helper.Exp.construct ~loc
               (Location.mkloc (Longident.Lident "()") loc)
-              None;
+              (Location.mkloc [] loc);
         };
       ]
     | args -> args
@@ -4218,33 +4194,17 @@ and parse_value_or_constructor p =
         Parser.next p;
         aux p (ident :: acc)
       | Lparen when p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum ->
-        let lparen = p.start_pos in
         let args = parse_constructor_args p in
-        let rparen = p.prev_end_pos in
         let lident = build_longident (ident :: acc) in
-        let tail =
-          match args with
-          | [] -> None
-          | [({Parsetree.pexp_desc = Pexp_tuple _} as arg)] as args ->
-            let loc = mk_loc lparen rparen in
-            if p.mode = ParseForTypeChecker then
-              (* Some(1, 2) for type-checker *)
-              Some arg
-            else
-              (* Some((1, 2)) for printer *)
-              Some (Ast_helper.Exp.tuple ~loc args)
-          | [arg] -> Some arg
-          | args ->
-            let loc = mk_loc lparen rparen in
-            Some (Ast_helper.Exp.tuple ~loc args)
-        in
         let loc = mk_loc start_pos p.prev_end_pos in
         let ident_loc = mk_loc start_pos end_pos_lident in
-        Ast_helper.Exp.construct ~loc (Location.mkloc lident ident_loc) tail
+        Ast_helper.Exp.construct ~loc (Location.mkloc lident ident_loc) args
       | _ ->
         let loc = mk_loc start_pos p.prev_end_pos in
         let lident = build_longident (ident :: acc) in
-        Ast_helper.Exp.construct ~loc (Location.mkloc lident loc) None)
+        Ast_helper.Exp.construct ~loc
+          (Location.mkloc lident loc)
+          (Location.mkloc [] loc))
     | Lident ident ->
       Parser.next p;
       let loc = mk_loc start_pos p.prev_end_pos in
@@ -4268,30 +4228,12 @@ and parse_poly_variant_expr p =
   let ident, _loc = parse_hash_ident ~start_pos p in
   match p.Parser.token with
   | Lparen when p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum ->
-    let lparen = p.start_pos in
     let args = parse_constructor_args p in
-    let rparen = p.prev_end_pos in
-    let loc_paren = mk_loc lparen rparen in
-    let tail =
-      match args with
-      | [] -> None
-      | [({Parsetree.pexp_desc = Pexp_tuple _} as expr)] as args ->
-        if p.mode = ParseForTypeChecker then
-          (* #a(1, 2) for type-checker *)
-          Some expr
-        else
-          (* #a((1, 2)) for type-checker *)
-          Some (Ast_helper.Exp.tuple ~loc:loc_paren args)
-      | [arg] -> Some arg
-      | args ->
-        (* #a((1, 2)) for printer *)
-        Some (Ast_helper.Exp.tuple ~loc:loc_paren args)
-    in
     let loc = mk_loc start_pos p.prev_end_pos in
-    Ast_helper.Exp.variant ~loc ident tail
+    Ast_helper.Exp.variant ~loc ident args
   | _ ->
     let loc = mk_loc start_pos p.prev_end_pos in
-    Ast_helper.Exp.variant ~loc ident None
+    Ast_helper.Exp.variant ~loc ident (Location.mkloc [] loc)
 
 and parse_constructor_args p =
   let lparen = p.Parser.start_pos in
@@ -4301,15 +4243,18 @@ and parse_constructor_args p =
       ~f:parse_constrained_expr_region ~closing:Rparen p
   in
   Parser.expect Rparen p;
-  match args with
-  | [] ->
-    let loc = mk_loc lparen p.prev_end_pos in
-    [
-      Ast_helper.Exp.construct ~loc
-        (Location.mkloc (Longident.Lident "()") loc)
-        None;
-    ]
-  | args -> args
+  let loc = mk_loc lparen p.prev_end_pos in
+  let args =
+    match args with
+    | [] ->
+      [
+        Ast_helper.Exp.construct ~loc
+          (Location.mkloc (Longident.Lident "()") loc)
+          (Location.mkloc [] loc);
+      ]
+    | args -> args
+  in
+  Location.mkloc args loc
 
 and parse_tuple_expr ~first ~start_pos p =
   let exprs =
@@ -6304,14 +6249,7 @@ and parse_polymorphic_variant_type_args p =
       ~f:parse_typ_expr_region p
   in
   Parser.expect Rparen p;
-  let attrs = [] in
-  let loc = mk_loc start_pos p.prev_end_pos in
-  match args with
-  | [({ptyp_desc = Ptyp_tuple _} as typ)] as types ->
-    if p.mode = ParseForTypeChecker then typ
-    else Ast_helper.Typ.tuple ~loc ~attrs types
-  | [typ] -> typ
-  | types -> Ast_helper.Typ.tuple ~loc ~attrs types
+  Location.mkloc args (mk_loc start_pos p.prev_end_pos)
 
 and parse_type_equation_and_representation ?current_type_name_path
     ?inline_types_context p =
diff --git a/compiler/syntax/src/res_driver.ml b/compiler/syntax/src/res_driver.ml
index eddb55a1f2..fa5b2d230c 100644
--- a/compiler/syntax/src/res_driver.ml
+++ b/compiler/syntax/src/res_driver.ml
@@ -11,21 +11,13 @@ type ('ast, 'diagnostics) parse_result = {
 
 type 'diagnostics parsing_engine = {
   parse_implementation:
-    for_printer:bool ->
-    filename:string ->
-    (Parsetree.structure, 'diagnostics) parse_result;
+    filename:string -> (Parsetree.structure, 'diagnostics) parse_result;
   parse_implementation_from_source:
-    for_printer:bool ->
-    source:string ->
-    (Parsetree.structure, 'diagnostics) parse_result;
+    source:string -> (Parsetree.structure, 'diagnostics) parse_result;
   parse_interface:
-    for_printer:bool ->
-    filename:string ->
-    (Parsetree.signature, 'diagnostics) parse_result;
+    filename:string -> (Parsetree.signature, 'diagnostics) parse_result;
   parse_interface_from_source:
-    for_printer:bool ->
-    source:string ->
-    (Parsetree.signature, 'diagnostics) parse_result;
+    source:string -> (Parsetree.signature, 'diagnostics) parse_result;
   string_of_diagnostics:
     source:string -> filename:string -> 'diagnostics -> unit;
 }
@@ -57,20 +49,18 @@ type print_engine = {
     unit;
 }
 
-let setup ~filename ~for_printer () =
+let setup ~filename =
   let src = IO.read_file ~filename in
-  let mode = if for_printer then Res_parser.Default else ParseForTypeChecker in
-  Res_parser.make ~mode src filename
+  Res_parser.make src filename
 
-let setup_from_source ~display_filename ~source ~for_printer () =
-  let mode = if for_printer then Res_parser.Default else ParseForTypeChecker in
-  Res_parser.make ~mode source display_filename
+let setup_from_source ~display_filename ~source =
+  Res_parser.make source display_filename
 
 let parsing_engine =
   {
     parse_implementation =
-      (fun ~for_printer ~filename ->
-        let engine = setup ~filename ~for_printer () in
+      (fun ~filename ->
+        let engine = setup ~filename in
         let structure = Res_core.parse_implementation engine in
         let invalid, diagnostics =
           match engine.diagnostics with
@@ -86,10 +76,8 @@ let parsing_engine =
           comments = List.rev engine.comments;
         });
     parse_implementation_from_source =
-      (fun ~for_printer ~source ->
-        let engine =
-          setup_from_source ~source ~for_printer ~display_filename:"source" ()
-        in
+      (fun ~source ->
+        let engine = setup_from_source ~source ~display_filename:"source" in
         let structure = Res_core.parse_implementation engine in
         let invalid, diagnostics =
           match engine.diagnostics with
@@ -105,8 +93,8 @@ let parsing_engine =
           comments = List.rev engine.comments;
         });
     parse_interface =
-      (fun ~for_printer ~filename ->
-        let engine = setup ~filename ~for_printer () in
+      (fun ~filename ->
+        let engine = setup ~filename in
         let signature = Res_core.parse_specification engine in
         let invalid, diagnostics =
           match engine.diagnostics with
@@ -122,10 +110,8 @@ let parsing_engine =
           comments = List.rev engine.comments;
         });
     parse_interface_from_source =
-      (fun ~for_printer ~source ->
-        let engine =
-          setup_from_source ~source ~display_filename:"<source>" ~for_printer ()
-        in
+      (fun ~source ->
+        let engine = setup_from_source ~source ~display_filename:"<source>" in
         let signature = Res_core.parse_specification engine in
         let invalid, diagnostics =
           match engine.diagnostics with
@@ -145,8 +131,8 @@ let parsing_engine =
         Res_diagnostics.print_report diagnostics source);
   }
 
-let parse_implementation_from_source ~for_printer ~display_filename ~source =
-  let engine = setup_from_source ~display_filename ~source ~for_printer () in
+let parse_implementation_from_source ~display_filename ~source =
+  let engine = setup_from_source ~display_filename ~source in
   let structure = Res_core.parse_implementation engine in
   let invalid, diagnostics =
     match engine.diagnostics with
@@ -162,8 +148,8 @@ let parse_implementation_from_source ~for_printer ~display_filename ~source =
     comments = List.rev engine.comments;
   }
 
-let parse_interface_from_source ~for_printer ~display_filename ~source =
-  let engine = setup_from_source ~display_filename ~source ~for_printer () in
+let parse_interface_from_source ~display_filename ~source =
+  let engine = setup_from_source ~display_filename ~source in
   let signature = Res_core.parse_specification engine in
   let invalid, diagnostics =
     match engine.diagnostics with
@@ -199,9 +185,7 @@ let print_engine =
 
 let parse_implementation ?(ignore_parse_errors = false) sourcefile =
   Location.input_name := sourcefile;
-  let parse_result =
-    parsing_engine.parse_implementation ~for_printer:false ~filename:sourcefile
-  in
+  let parse_result = parsing_engine.parse_implementation ~filename:sourcefile in
   if parse_result.invalid then (
     Res_diagnostics.print_report parse_result.diagnostics parse_result.source;
     if not ignore_parse_errors then exit 1);
@@ -210,9 +194,7 @@ let parse_implementation ?(ignore_parse_errors = false) sourcefile =
 
 let parse_interface ?(ignore_parse_errors = false) sourcefile =
   Location.input_name := sourcefile;
-  let parse_result =
-    parsing_engine.parse_interface ~for_printer:false ~filename:sourcefile
-  in
+  let parse_result = parsing_engine.parse_interface ~filename:sourcefile in
   if parse_result.invalid then (
     Res_diagnostics.print_report parse_result.diagnostics parse_result.source;
     if not ignore_parse_errors then exit 1);
diff --git a/compiler/syntax/src/res_driver.mli b/compiler/syntax/src/res_driver.mli
index 4d6feb13de..6b2e0a12b2 100644
--- a/compiler/syntax/src/res_driver.mli
+++ b/compiler/syntax/src/res_driver.mli
@@ -9,34 +9,24 @@ type ('ast, 'diagnostics) parse_result = {
 
 type 'diagnostics parsing_engine = {
   parse_implementation:
-    for_printer:bool ->
-    filename:string ->
-    (Parsetree.structure, 'diagnostics) parse_result;
+    filename:string -> (Parsetree.structure, 'diagnostics) parse_result;
   parse_implementation_from_source:
-    for_printer:bool ->
-    source:string ->
-    (Parsetree.structure, 'diagnostics) parse_result;
+    source:string -> (Parsetree.structure, 'diagnostics) parse_result;
   parse_interface:
-    for_printer:bool ->
-    filename:string ->
-    (Parsetree.signature, 'diagnostics) parse_result;
+    filename:string -> (Parsetree.signature, 'diagnostics) parse_result;
   parse_interface_from_source:
-    for_printer:bool ->
-    source:string ->
-    (Parsetree.signature, 'diagnostics) parse_result;
+    source:string -> (Parsetree.signature, 'diagnostics) parse_result;
   string_of_diagnostics:
     source:string -> filename:string -> 'diagnostics -> unit;
 }
 
 val parse_implementation_from_source :
-  for_printer:bool ->
   display_filename:string ->
   source:string ->
   (Parsetree.structure, Res_diagnostics.t list) parse_result
 [@@live]
 
 val parse_interface_from_source :
-  for_printer:bool ->
   display_filename:string ->
   source:string ->
   (Parsetree.signature, Res_diagnostics.t list) parse_result
diff --git a/compiler/syntax/src/res_multi_printer.ml b/compiler/syntax/src/res_multi_printer.ml
index 711241ade5..43c405a31b 100644
--- a/compiler/syntax/src/res_multi_printer.ml
+++ b/compiler/syntax/src/res_multi_printer.ml
@@ -1,9 +1,7 @@
 (* print res files to res syntax *)
 let print_res ~ignore_parse_errors ~is_interface ~filename =
   if is_interface then (
-    let parse_result =
-      Res_driver.parsing_engine.parse_interface ~for_printer:true ~filename
-    in
+    let parse_result = Res_driver.parsing_engine.parse_interface ~filename in
     if parse_result.invalid then (
       Res_diagnostics.print_report parse_result.diagnostics parse_result.source;
       if not ignore_parse_errors then exit 1);
@@ -11,7 +9,7 @@ let print_res ~ignore_parse_errors ~is_interface ~filename =
       ~comments:parse_result.comments parse_result.parsetree)
   else
     let parse_result =
-      Res_driver.parsing_engine.parse_implementation ~for_printer:true ~filename
+      Res_driver.parsing_engine.parse_implementation ~filename
     in
     if parse_result.invalid then (
       Res_diagnostics.print_report parse_result.diagnostics parse_result.source;
diff --git a/compiler/syntax/src/res_parser.ml b/compiler/syntax/src/res_parser.ml
index 641a41ab24..6dc53174e6 100644
--- a/compiler/syntax/src/res_parser.ml
+++ b/compiler/syntax/src/res_parser.ml
@@ -6,12 +6,9 @@ module Reporting = Res_reporting
 
 module Comment = Res_comment
 
-type mode = ParseForTypeChecker | Default
-
 type region_status = Report | Silent
 
 type t = {
-  mode: mode;
   mutable scanner: Scanner.t;
   mutable token: Token.t;
   mutable start_pos: Lexing.position;
@@ -122,11 +119,10 @@ let next_regex_token p =
 let check_progress ~prev_end_pos ~result p =
   if p.end_pos == prev_end_pos then None else Some result
 
-let make ?(mode = ParseForTypeChecker) src filename =
+let make src filename =
   let scanner = Scanner.make ~filename src in
   let parser_state =
     {
-      mode;
       scanner;
       token = Token.Semicolon;
       start_pos = Lexing.dummy_pos;
diff --git a/compiler/syntax/src/res_parser.mli b/compiler/syntax/src/res_parser.mli
index 978cc18bdc..c55a0e3ec7 100644
--- a/compiler/syntax/src/res_parser.mli
+++ b/compiler/syntax/src/res_parser.mli
@@ -5,12 +5,9 @@ module Reporting = Res_reporting
 module Diagnostics = Res_diagnostics
 module Comment = Res_comment
 
-type mode = ParseForTypeChecker | Default
-
 type region_status = Report | Silent
 
 type t = {
-  mode: mode;
   mutable scanner: Scanner.t;
   mutable token: Token.t;
   mutable start_pos: Lexing.position;
@@ -23,7 +20,7 @@ type t = {
   mutable regions: region_status ref list;
 }
 
-val make : ?mode:mode -> string -> string -> t
+val make : string -> string -> t
 
 val expect : ?grammar:Grammar.t -> Token.t -> t -> unit
 val optional : t -> Token.t -> bool
diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml
index 87e2a4d803..3d462f2517 100644
--- a/compiler/syntax/src/res_parsetree_viewer.ml
+++ b/compiler/syntax/src/res_parsetree_viewer.ml
@@ -70,9 +70,10 @@ let collect_list_expressions expr =
   let rec collect acc expr =
     match expr.pexp_desc with
     | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> (List.rev acc, None)
+    | Pexp_construct ({txt = Longident.Lident "::"}, {txt = hd :: [tail]})
     | Pexp_construct
         ( {txt = Longident.Lident "::"},
-          Some {pexp_desc = Pexp_tuple (hd :: [tail])} ) ->
+          {txt = [{pexp_desc = Pexp_tuple [hd; tail]}]} ) ->
       collect (hd :: acc) tail
     | _ -> (List.rev acc, Some expr)
   in
@@ -644,9 +645,10 @@ let mod_expr_functor mod_expr =
 let rec collect_patterns_from_list_construct acc pattern =
   let open Parsetree in
   match pattern.ppat_desc with
+  | Ppat_construct ({txt = Longident.Lident "::"}, {txt = [pat; rest]})
   | Ppat_construct
-      ({txt = Longident.Lident "::"}, Some {ppat_desc = Ppat_tuple [pat; rest]})
-    ->
+      ( {txt = Longident.Lident "::"},
+        {txt = [{ppat_desc = Ppat_tuple [pat; rest]}]} ) ->
     collect_patterns_from_list_construct (pat :: acc) rest
   | _ -> (List.rev acc, pattern)
 
diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml
index 35b5087f2a..72a198041b 100644
--- a/compiler/syntax/src/res_printer.ml
+++ b/compiler/syntax/src/res_printer.ml
@@ -2128,19 +2128,21 @@ and print_typ_expr ?inline_record_definitions ~(state : State.t)
             if i > 0 || comment_attrs <> [] then Doc.text "| "
             else Doc.if_breaks (Doc.text "| ") Doc.nil
           in
-          let do_type t =
-            match t.Parsetree.ptyp_desc with
-            | Ptyp_tuple _ ->
-              print_typ_expr ?inline_record_definitions ~state t cmt_tbl
-            | _ ->
-              Doc.concat
-                [
-                  Doc.lparen;
-                  print_typ_expr ?inline_record_definitions ~state t cmt_tbl;
-                  Doc.rparen;
-                ]
+          let do_group {Location.txt = types} =
+            Doc.concat
+              [
+                Doc.lparen;
+                Doc.join
+                  ~sep:(Doc.concat [Doc.comma; Doc.line])
+                  (List.map
+                     (fun typ ->
+                       print_typ_expr ?inline_record_definitions ~state typ
+                         cmt_tbl)
+                     types);
+                Doc.rparen;
+              ]
           in
-          let printed_types = List.map do_type types in
+          let printed_types = List.map do_group types in
           let cases =
             Doc.join ~sep:(Doc.concat [Doc.line; Doc.text "& "]) printed_types
           in
@@ -2615,6 +2617,49 @@ 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 print_pattern_args ~state (patterns : Parsetree.pattern list) cmt_tbl =
+  match patterns with
+  | [] -> Doc.nil
+  | [{ppat_loc; ppat_desc = Ppat_construct ({txt = Longident.Lident "()"}, _)}]
+    ->
+    Doc.concat [Doc.lparen; print_comments_inside cmt_tbl ppat_loc; Doc.rparen]
+  | [{ppat_desc = Ppat_tuple []; ppat_loc = loc}] ->
+    Doc.concat [Doc.lparen; print_comments_inside cmt_tbl loc; Doc.rparen]
+  | _ :: _ :: _ ->
+    Doc.concat
+      [
+        Doc.lparen;
+        Doc.indent
+          (Doc.concat
+             [
+               Doc.soft_line;
+               Doc.join
+                 ~sep:(Doc.concat [Doc.comma; Doc.line])
+                 (List.map
+                    (fun pat -> print_pattern ~state pat cmt_tbl)
+                    patterns);
+             ]);
+        Doc.trailing_comma;
+        Doc.soft_line;
+        Doc.rparen;
+      ]
+  | [arg] ->
+    let arg_doc = print_pattern ~state arg cmt_tbl in
+    let should_hug = Parsetree_viewer.is_huggable_pattern arg in
+    Doc.concat
+      [
+        Doc.lparen;
+        (if should_hug then arg_doc
+         else
+           Doc.concat
+             [
+               Doc.indent (Doc.concat [Doc.soft_line; arg_doc]);
+               Doc.trailing_comma;
+               Doc.soft_line;
+             ]);
+        Doc.rparen;
+      ]
+
 and print_pattern ~state (p : Parsetree.pattern) cmt_tbl =
   let pattern_without_attributes =
     match p.ppat_desc with
@@ -2710,111 +2755,15 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl =
                   ]);
              Doc.rbrace;
            ])
-    | Ppat_construct (constr_name, constructor_args) ->
+    | Ppat_construct (constr_name, {txt = constructor_args}) ->
       let constr_name = print_longident_location constr_name cmt_tbl in
-      let args_doc =
-        match constructor_args with
-        | None -> Doc.nil
-        | Some
-            {
-              ppat_loc;
-              ppat_desc = Ppat_construct ({txt = Longident.Lident "()"}, _);
-            } ->
-          Doc.concat
-            [Doc.lparen; print_comments_inside cmt_tbl ppat_loc; Doc.rparen]
-        | Some {ppat_desc = Ppat_tuple []; ppat_loc = loc} ->
-          Doc.concat [Doc.lparen; print_comments_inside cmt_tbl loc; Doc.rparen]
-        (* Some((1, 2) *)
-        | Some {ppat_desc = Ppat_tuple [({ppat_desc = Ppat_tuple _} as arg)]} ->
-          Doc.concat [Doc.lparen; print_pattern ~state arg cmt_tbl; Doc.rparen]
-        | Some {ppat_desc = Ppat_tuple patterns} ->
-          Doc.concat
-            [
-              Doc.lparen;
-              Doc.indent
-                (Doc.concat
-                   [
-                     Doc.soft_line;
-                     Doc.join
-                       ~sep:(Doc.concat [Doc.comma; Doc.line])
-                       (List.map
-                          (fun pat -> print_pattern ~state pat cmt_tbl)
-                          patterns);
-                   ]);
-              Doc.trailing_comma;
-              Doc.soft_line;
-              Doc.rparen;
-            ]
-        | Some arg ->
-          let arg_doc = print_pattern ~state arg cmt_tbl in
-          let should_hug = Parsetree_viewer.is_huggable_pattern arg in
-          Doc.concat
-            [
-              Doc.lparen;
-              (if should_hug then arg_doc
-               else
-                 Doc.concat
-                   [
-                     Doc.indent (Doc.concat [Doc.soft_line; arg_doc]);
-                     Doc.trailing_comma;
-                     Doc.soft_line;
-                   ]);
-              Doc.rparen;
-            ]
-      in
+      let args_doc = print_pattern_args ~state constructor_args cmt_tbl in
       Doc.group (Doc.concat [constr_name; args_doc])
-    | Ppat_variant (label, None) ->
-      Doc.concat [Doc.text "#"; print_poly_var_ident label]
-    | Ppat_variant (label, variant_args) ->
+    | Ppat_variant (label, {txt = variant_args}) ->
       let variant_name =
         Doc.concat [Doc.text "#"; print_poly_var_ident label]
       in
-      let args_doc =
-        match variant_args with
-        | None -> Doc.nil
-        | Some {ppat_desc = Ppat_construct ({txt = Longident.Lident "()"}, _)}
-          ->
-          Doc.text "()"
-        | Some {ppat_desc = Ppat_tuple []; ppat_loc = loc} ->
-          Doc.concat [Doc.lparen; print_comments_inside cmt_tbl loc; Doc.rparen]
-        (* Some((1, 2) *)
-        | Some {ppat_desc = Ppat_tuple [({ppat_desc = Ppat_tuple _} as arg)]} ->
-          Doc.concat [Doc.lparen; print_pattern ~state arg cmt_tbl; Doc.rparen]
-        | Some {ppat_desc = Ppat_tuple patterns} ->
-          Doc.concat
-            [
-              Doc.lparen;
-              Doc.indent
-                (Doc.concat
-                   [
-                     Doc.soft_line;
-                     Doc.join
-                       ~sep:(Doc.concat [Doc.comma; Doc.line])
-                       (List.map
-                          (fun pat -> print_pattern ~state pat cmt_tbl)
-                          patterns);
-                   ]);
-              Doc.trailing_comma;
-              Doc.soft_line;
-              Doc.rparen;
-            ]
-        | Some arg ->
-          let arg_doc = print_pattern ~state arg cmt_tbl in
-          let should_hug = Parsetree_viewer.is_huggable_pattern arg in
-          Doc.concat
-            [
-              Doc.lparen;
-              (if should_hug then arg_doc
-               else
-                 Doc.concat
-                   [
-                     Doc.indent (Doc.concat [Doc.soft_line; arg_doc]);
-                     Doc.trailing_comma;
-                     Doc.soft_line;
-                   ]);
-              Doc.rparen;
-            ]
-      in
+      let args_doc = print_pattern_args ~state variant_args cmt_tbl in
       Doc.group (Doc.concat [variant_name; args_doc])
     | Ppat_type ident
       when Parsetree_viewer.has_res_pat_variant_spread_attribute
@@ -3060,6 +3009,51 @@ and print_expression_with_comments ~state expr cmt_tbl : Doc.t =
   let doc = print_expression ~state expr cmt_tbl in
   print_comments doc cmt_tbl expr.Parsetree.pexp_loc
 
+and print_expression_args ~state (args : Parsetree.expression list) cmt_tbl =
+  let print_arg expr =
+    let doc = print_expression_with_comments ~state expr cmt_tbl in
+    match Parens.expr expr with
+    | Parens.Parenthesized -> add_parens doc
+    | Braced braces -> print_braces doc expr braces
+    | Nothing -> doc
+  in
+  match args with
+  | [] -> Doc.nil
+  | [{pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _)}] ->
+    Doc.text "()"
+  | _ :: _ :: _ ->
+    Doc.concat
+      [
+        Doc.lparen;
+        Doc.indent
+          (Doc.concat
+             [
+               Doc.soft_line;
+               Doc.join
+                 ~sep:(Doc.concat [Doc.comma; Doc.line])
+                 (List.map print_arg args);
+             ]);
+        Doc.trailing_comma;
+        Doc.soft_line;
+        Doc.rparen;
+      ]
+  | [arg] ->
+    let arg_doc = print_arg arg in
+    let should_hug = Parsetree_viewer.is_huggable_expression arg in
+    Doc.concat
+      [
+        Doc.lparen;
+        (if should_hug then arg_doc
+         else
+           Doc.concat
+             [
+               Doc.indent (Doc.concat [Doc.soft_line; arg_doc]);
+               Doc.trailing_comma;
+               Doc.soft_line;
+             ]);
+        Doc.rparen;
+      ]
+
 and print_if_chain ~state pexp_attributes ifs else_expr cmt_tbl =
   let if_docs =
     Doc.join ~sep:Doc.space
@@ -3277,74 +3271,9 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl =
              Doc.soft_line;
              Doc.rbrace;
            ])
-    | Pexp_construct (longident_loc, args) ->
+    | Pexp_construct (longident_loc, {txt = args}) ->
       let constr = print_longident_location longident_loc cmt_tbl in
-      let args =
-        match args with
-        | None -> Doc.nil
-        | Some {pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _)}
-          ->
-          Doc.text "()"
-        (* Some((1, 2)) *)
-        | Some {pexp_desc = Pexp_tuple [({pexp_desc = Pexp_tuple _} as arg)]} ->
-          Doc.concat
-            [
-              Doc.lparen;
-              (let doc = print_expression_with_comments ~state arg cmt_tbl in
-               match Parens.expr arg with
-               | Parens.Parenthesized -> add_parens doc
-               | Braced braces -> print_braces doc arg braces
-               | Nothing -> doc);
-              Doc.rparen;
-            ]
-        | Some {pexp_desc = Pexp_tuple args} ->
-          Doc.concat
-            [
-              Doc.lparen;
-              Doc.indent
-                (Doc.concat
-                   [
-                     Doc.soft_line;
-                     Doc.join
-                       ~sep:(Doc.concat [Doc.comma; Doc.line])
-                       (List.map
-                          (fun expr ->
-                            let doc =
-                              print_expression_with_comments ~state expr cmt_tbl
-                            in
-                            match Parens.expr expr with
-                            | Parens.Parenthesized -> add_parens doc
-                            | Braced braces -> print_braces doc expr braces
-                            | Nothing -> doc)
-                          args);
-                   ]);
-              Doc.trailing_comma;
-              Doc.soft_line;
-              Doc.rparen;
-            ]
-        | Some arg ->
-          let arg_doc =
-            let doc = print_expression_with_comments ~state arg cmt_tbl in
-            match Parens.expr arg with
-            | Parens.Parenthesized -> add_parens doc
-            | Braced braces -> print_braces doc arg braces
-            | Nothing -> doc
-          in
-          let should_hug = Parsetree_viewer.is_huggable_expression arg in
-          Doc.concat
-            [
-              Doc.lparen;
-              (if should_hug then arg_doc
-               else
-                 Doc.concat
-                   [
-                     Doc.indent (Doc.concat [Doc.soft_line; arg_doc]);
-                     Doc.trailing_comma;
-                     Doc.soft_line;
-                   ]);
-              Doc.rparen;
-            ]
-      in
+      let args = print_expression_args ~state args cmt_tbl in
       Doc.group (Doc.concat [constr; args])
     | Pexp_ident path -> print_lident_path path cmt_tbl
     | Pexp_tuple exprs ->
@@ -3402,76 +3331,11 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl =
              Doc.soft_line;
              Doc.rbracket;
            ])
-    | Pexp_variant (label, args) ->
+    | Pexp_variant (label, {txt = args}) ->
       let variant_name =
         Doc.concat [Doc.text "#"; print_poly_var_ident label]
       in
-      let args =
-        match args with
-        | None -> Doc.nil
-        | Some {pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _)}
-          ->
-          Doc.text "()"
-        (* #poly((1, 2) *)
-        | Some {pexp_desc = Pexp_tuple [({pexp_desc = Pexp_tuple _} as arg)]} ->
-          Doc.concat
-            [
-              Doc.lparen;
-              (let doc = print_expression_with_comments ~state arg cmt_tbl in
-               match Parens.expr arg with
-               | Parens.Parenthesized -> add_parens doc
-               | Braced braces -> print_braces doc arg braces
-               | Nothing -> doc);
-              Doc.rparen;
-            ]
-        | Some {pexp_desc = Pexp_tuple args} ->
-          Doc.concat
-            [
-              Doc.lparen;
-              Doc.indent
-                (Doc.concat
-                   [
-                     Doc.soft_line;
-                     Doc.join
-                       ~sep:(Doc.concat [Doc.comma; Doc.line])
-                       (List.map
-                          (fun expr ->
-                            let doc =
-                              print_expression_with_comments ~state expr cmt_tbl
-                            in
-                            match Parens.expr expr with
-                            | Parens.Parenthesized -> add_parens doc
-                            | Braced braces -> print_braces doc expr braces
-                            | Nothing -> doc)
-                          args);
-                   ]);
-              Doc.trailing_comma;
-              Doc.soft_line;
-              Doc.rparen;
-            ]
-        | Some arg ->
-          let arg_doc =
-            let doc = print_expression_with_comments ~state arg cmt_tbl in
-            match Parens.expr arg with
-            | Parens.Parenthesized -> add_parens doc
-            | Braced braces -> print_braces doc arg braces
-            | Nothing -> doc
-          in
-          let should_hug = Parsetree_viewer.is_huggable_expression arg in
-          Doc.concat
-            [
-              Doc.lparen;
-              (if should_hug then arg_doc
-               else
-                 Doc.concat
-                   [
-                     Doc.indent (Doc.concat [Doc.soft_line; arg_doc]);
-                     Doc.trailing_comma;
-                     Doc.soft_line;
-                   ]);
-              Doc.rparen;
-            ]
-      in
+      let args = print_expression_args ~state args cmt_tbl in
       Doc.group (Doc.concat [variant_name; args])
     | Pexp_record (rows, spread_expr) ->
       if rows = [] then
@@ -3921,7 +3785,7 @@ and print_pexp_fun ~state ~in_callback e cmt_tbl =
       match (return_expr.pexp_desc, opt_braces) with
       | _, Some _ -> true
       | ( ( Pexp_array _ | Pexp_tuple _
-          | Pexp_construct (_, Some _)
+          | Pexp_construct (_, {txt = _ :: _})
           | Pexp_record _ ),
           _ ) ->
         true
@@ -5495,7 +5359,10 @@ and print_expr_fun_parameters ~state ~in_callback ~async ~has_constraint
        lbl = Nolabel;
        default_expr = None;
        pat =
-         {ppat_desc = Ppat_construct ({txt = Longident.Lident "()"; loc}, None)};
+         {
+           ppat_desc =
+             Ppat_construct ({txt = Longident.Lident "()"; loc}, {txt = []});
+         };
      };
   ] ->
     let doc =
diff --git a/tests/ERROR_VARIANTS.md b/tests/ERROR_VARIANTS.md
index 989f9b1207..2b376f2227 100644
--- a/tests/ERROR_VARIANTS.md
+++ b/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`, `arity_mismatch*.res` | Triggers in both expression (4028) and pattern (1426) paths. |
+| `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` | |
diff --git a/tests/analysis_tests/tests/src/CompletionConstructorTuple.res b/tests/analysis_tests/tests/src/CompletionConstructorTuple.res
new file mode 100644
index 0000000000..e84982917d
--- /dev/null
+++ b/tests/analysis_tests/tests/src/CompletionConstructorTuple.res
@@ -0,0 +1,56 @@
+type payload = {
+  name: string,
+  enabled: bool,
+}
+
+type t = Pair(int, payload) | Nested((int, payload), string)
+
+let consume = (value: t) => ignore(value)
+
+// consume(Pair((1, {})))
+//                    ^com
+
+let value = Pair(1, {name: "test", enabled: true})
+
+// switch value { | Pair((_, {}))}
+//                            ^com
+
+// consume(Nested((1, {}), ""))
+//                     ^com
+
+// switch value { | Nested((_, {}), _) => ()}
+//                              ^com
+
+// consume(Nested(((1, {}), "")))
+//                      ^com
+
+// switch value { | Nested(((_, {}), _)) => ()}
+//                               ^com
+
+type gap = Gap(bool, bool, bool) | TupleGap((bool, bool), bool)
+let consumeGap = (value: gap) => ignore(value)
+let gap = Gap(true, false, true)
+
+// consumeGap(Gap(true, , false))
+//                      ^com
+
+// consumeGap(Gap(true, false, ))
+//                             ^com
+
+// consumeGap(TupleGap((true, false), ))
+//                                    ^com
+
+// consumeGap(TupleGap((true, ), false))
+//                            ^com
+
+// switch gap { | Gap(true, , false) => ()}
+//                          ^com
+
+// switch gap { | Gap(true, false, ) => ()}
+//                                 ^com
+
+// switch gap { | TupleGap((true, false), ) => ()}
+//                                        ^com
+
+// switch gap { | TupleGap((true, ), _) => ()}
+//                                ^com
diff --git a/tests/analysis_tests/tests/src/CompletionPattern.res b/tests/analysis_tests/tests/src/CompletionPattern.res
index 5299aa887c..c52747a422 100644
--- a/tests/analysis_tests/tests/src/CompletionPattern.res
+++ b/tests/analysis_tests/tests/src/CompletionPattern.res
@@ -254,3 +254,12 @@ let callWithTwoParams = (fn: (firstParamVariant, secondParamVariant) => bool) =>
 // must be completed; the first parameter's comma recovery must not shadow it.
 // callWithTwoParams((One(x), Blah(a, )) => true)
 //                                    ^com
+
+type inlineRecord = Inline({enabled: bool, nested: nestedRecord})
+let inlineRecord = Inline({enabled: true, nested: {nested: false}})
+
+// switch inlineRecord { | Inline({}) => ()}
+//                                 ^com
+
+// switch inlineRecord { | Inline({nested: {}}) => ()}
+//                                          ^com
diff --git a/tests/analysis_tests/tests/src/SignatureHelpConstructorBoundaries.res b/tests/analysis_tests/tests/src/SignatureHelpConstructorBoundaries.res
new file mode 100644
index 0000000000..a30a5dc9ce
--- /dev/null
+++ b/tests/analysis_tests/tests/src/SignatureHelpConstructorBoundaries.res
@@ -0,0 +1,49 @@
+type t = Pair(int, int)
+
+// Before the opening parenthesis
+let _ = Pair  (1, 2)
+//            ^she
+
+// Whitespace after the constructor
+let _ = Pair  (1, 2)
+//           ^she
+
+// Comment before arguments
+let _ = Pair /* gap */ (1, 2)
+//                ^she
+
+// Just inside the opening parenthesis
+let _ = Pair /* gap */ (1, 2)
+//                      ^she
+
+// Between arguments
+let _ = Pair(1, 2)
+//             ^she
+
+// Just after the closing parenthesis
+let _ = Pair(1, 2)
+//                ^she
+
+// After the argument list
+let _ = Pair(1, 2) // after
+//                 ^she
+
+// Pattern whitespace before arguments
+let read = value => switch value { | Pair  (a, b) => a }
+//                                         ^she
+
+// Pattern comment before arguments
+let read = value => switch value { | Pair /* gap */ (a, b) => a }
+//                                             ^she
+
+// Pattern opening parenthesis
+let read = value => switch value { | Pair /* gap */ (a, b) => a }
+//                                                   ^she
+
+// Pattern between arguments
+let read = value => switch value { | Pair(a, b) => a }
+//                                          ^she
+
+// After the pattern argument list
+let read = value => switch value { | Pair(a, b) => a }
+//                                              ^she
diff --git a/tests/analysis_tests/tests/src/SignatureHelpConstructorGaps.res b/tests/analysis_tests/tests/src/SignatureHelpConstructorGaps.res
new file mode 100644
index 0000000000..8d1093d30c
--- /dev/null
+++ b/tests/analysis_tests/tests/src/SignatureHelpConstructorGaps.res
@@ -0,0 +1,34 @@
+type t = Three(string, array<int>) | Unary(string)
+
+let a = Three("", [])
+//               ^she
+let b = Three("", [])
+//                ^she
+let c = Three("", [])
+//                 ^she
+let d = Three( "", [])
+//            ^she
+let e = Unary( "")
+//            ^she
+
+let f = Three("",    [])
+//                  ^she
+let g = Three("" , [])
+//               ^she
+let h = Three(
+  "",
+  [],
+//^she
+)
+
+let i = Three("", [])
+//         ^she
+
+let read = value => switch value {
+| Three(a, []) => a
+//        ^she
+| Three(a, _) => a
+//         ^she
+| Unary( a) => a
+//      ^she
+}
diff --git a/tests/analysis_tests/tests/src/SignatureHelpConstructorTuple.res b/tests/analysis_tests/tests/src/SignatureHelpConstructorTuple.res
new file mode 100644
index 0000000000..d0f8be9881
--- /dev/null
+++ b/tests/analysis_tests/tests/src/SignatureHelpConstructorTuple.res
@@ -0,0 +1,9 @@
+type t = Pair(int, string)
+
+let value = Pair((1, "test"))
+//                     ^she
+
+let read = value => switch value {
+| Pair((first, second)) => second
+//             ^she
+}
diff --git a/tests/analysis_tests/tests/src/expected/CompletionConstructorTuple.res.txt b/tests/analysis_tests/tests/src/expected/CompletionConstructorTuple.res.txt
new file mode 100644
index 0000000000..18d2d1870d
--- /dev/null
+++ b/tests/analysis_tests/tests/src/expected/CompletionConstructorTuple.res.txt
@@ -0,0 +1,305 @@
+Complete src/CompletionConstructorTuple.res 9:22
+posCursor:[9:22] posNoWhite:[9:21] Found expr:[9:3->9:25]
+Pexp_apply ...[9:3->9:10] (...[9:11->9:24])
+Completable: Cexpression CArgument Value[consume]($0)->variantPayload::Pair($0), tuple($1), recordBody
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath CArgument Value[consume]($0)
+ContextPath Value[consume]
+Path consume
+[
+  {
+    "detail": "string",
+    "documentation": {
+      "kind": "markdown",
+      "value": "```rescript\nname: string\n```\n\n```rescript\ntype payload = {name: string, enabled: bool}\n```"
+    },
+    "kind": 5,
+    "label": "name",
+    "tags": []
+  },
+  {
+    "detail": "bool",
+    "documentation": {
+      "kind": "markdown",
+      "value": "```rescript\nenabled: bool\n```\n\n```rescript\ntype payload = {name: string, enabled: bool}\n```"
+    },
+    "kind": 5,
+    "label": "enabled",
+    "tags": []
+  }
+]
+
+Complete src/CompletionConstructorTuple.res 14:30
+posCursor:[14:30] posNoWhite:[14:29] Found pattern:[14:20->14:33]
+Ppat_construct Pair:[14:20->14:24]
+posCursor:[14:30] posNoWhite:[14:29] Found pattern:[14:25->14:32]
+posCursor:[14:30] posNoWhite:[14:29] Found pattern:[14:29->14:31]
+Completable: Cpattern Value[value]->variantPayload::Pair($0), tuple($1), recordBody
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath Value[value]
+Path value
+[
+  {
+    "detail": "string",
+    "documentation": {
+      "kind": "markdown",
+      "value": "```rescript\nname: string\n```\n\n```rescript\ntype payload = {name: string, enabled: bool}\n```"
+    },
+    "kind": 5,
+    "label": "name",
+    "tags": []
+  },
+  {
+    "detail": "bool",
+    "documentation": {
+      "kind": "markdown",
+      "value": "```rescript\nenabled: bool\n```\n\n```rescript\ntype payload = {name: string, enabled: bool}\n```"
+    },
+    "kind": 5,
+    "label": "enabled",
+    "tags": []
+  }
+]
+
+Complete src/CompletionConstructorTuple.res 17:23
+posCursor:[17:23] posNoWhite:[17:22] Found expr:[17:3->17:31]
+Pexp_apply ...[17:3->17:10] (...[17:11->17:30])
+Completable: Cexpression CArgument Value[consume]($0)->variantPayload::Nested($0), tuple($1), recordBody
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath CArgument Value[consume]($0)
+ContextPath Value[consume]
+Path consume
+[
+  {
+    "detail": "string",
+    "documentation": {
+      "kind": "markdown",
+      "value": "```rescript\nname: string\n```\n\n```rescript\ntype payload = {name: string, enabled: bool}\n```"
+    },
+    "kind": 5,
+    "label": "name",
+    "tags": []
+  },
+  {
+    "detail": "bool",
+    "documentation": {
+      "kind": "markdown",
+      "value": "```rescript\nenabled: bool\n```\n\n```rescript\ntype payload = {name: string, enabled: bool}\n```"
+    },
+    "kind": 5,
+    "label": "enabled",
+    "tags": []
+  }
+]
+
+Complete src/CompletionConstructorTuple.res 20:32
+posCursor:[20:32] posNoWhite:[20:31] Found pattern:[20:20->20:38]
+Ppat_construct Nested:[20:20->20:26]
+posCursor:[20:32] posNoWhite:[20:31] Found pattern:[20:27->20:34]
+posCursor:[20:32] posNoWhite:[20:31] Found pattern:[20:31->20:33]
+Completable: Cpattern Value[value]->variantPayload::Nested($0), tuple($1), recordBody
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath Value[value]
+Path value
+[
+  {
+    "detail": "string",
+    "documentation": {
+      "kind": "markdown",
+      "value": "```rescript\nname: string\n```\n\n```rescript\ntype payload = {name: string, enabled: bool}\n```"
+    },
+    "kind": 5,
+    "label": "name",
+    "tags": []
+  },
+  {
+    "detail": "bool",
+    "documentation": {
+      "kind": "markdown",
+      "value": "```rescript\nenabled: bool\n```\n\n```rescript\ntype payload = {name: string, enabled: bool}\n```"
+    },
+    "kind": 5,
+    "label": "enabled",
+    "tags": []
+  }
+]
+
+Complete src/CompletionConstructorTuple.res 23:24
+posCursor:[23:24] posNoWhite:[23:23] Found expr:[23:3->23:33]
+Pexp_apply ...[23:3->23:10] (...[23:11->23:32])
+Completable: Cexpression CArgument Value[consume]($0)->variantPayload::Nested($0), tuple($0), tuple($1), recordBody
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath CArgument Value[consume]($0)
+ContextPath Value[consume]
+Path consume
+[
+  {
+    "detail": "string",
+    "documentation": {
+      "kind": "markdown",
+      "value": "```rescript\nname: string\n```\n\n```rescript\ntype payload = {name: string, enabled: bool}\n```"
+    },
+    "kind": 5,
+    "label": "name",
+    "tags": []
+  },
+  {
+    "detail": "bool",
+    "documentation": {
+      "kind": "markdown",
+      "value": "```rescript\nenabled: bool\n```\n\n```rescript\ntype payload = {name: string, enabled: bool}\n```"
+    },
+    "kind": 5,
+    "label": "enabled",
+    "tags": []
+  }
+]
+
+Complete src/CompletionConstructorTuple.res 26:33
+posCursor:[26:33] posNoWhite:[26:32] Found pattern:[26:20->26:40]
+Ppat_construct Nested:[26:20->26:26]
+posCursor:[26:33] posNoWhite:[26:32] Found pattern:[26:27->26:39]
+posCursor:[26:33] posNoWhite:[26:32] Found pattern:[26:28->26:35]
+posCursor:[26:33] posNoWhite:[26:32] Found pattern:[26:32->26:34]
+Completable: Cpattern Value[value]->variantPayload::Nested($0), tuple($0), tuple($1), recordBody
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath Value[value]
+Path value
+[
+  {
+    "detail": "string",
+    "documentation": {
+      "kind": "markdown",
+      "value": "```rescript\nname: string\n```\n\n```rescript\ntype payload = {name: string, enabled: bool}\n```"
+    },
+    "kind": 5,
+    "label": "name",
+    "tags": []
+  },
+  {
+    "detail": "bool",
+    "documentation": {
+      "kind": "markdown",
+      "value": "```rescript\nenabled: bool\n```\n\n```rescript\ntype payload = {name: string, enabled: bool}\n```"
+    },
+    "kind": 5,
+    "label": "enabled",
+    "tags": []
+  }
+]
+
+Complete src/CompletionConstructorTuple.res 33:24
+posCursor:[33:24] posNoWhite:[33:22] Found expr:[33:3->33:33]
+Pexp_apply ...[33:3->33:13] (...[33:14->33:32])
+Completable: Cexpression CArgument Value[consumeGap]($0)->variantPayload::Gap($1)
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath CArgument Value[consumeGap]($0)
+ContextPath Value[consumeGap]
+Path consumeGap
+[
+  { "detail": "bool", "kind": 4, "label": "true", "tags": [] },
+  { "detail": "bool", "kind": 4, "label": "false", "tags": [] }
+]
+
+Complete src/CompletionConstructorTuple.res 36:31
+posCursor:[36:31] posNoWhite:[36:29] Found expr:[36:3->36:33]
+Pexp_apply ...[36:3->36:13] (...[36:14->36:32])
+Completable: Cexpression CArgument Value[consumeGap]($0)->variantPayload::Gap($2)
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath CArgument Value[consumeGap]($0)
+ContextPath Value[consumeGap]
+Path consumeGap
+[
+  { "detail": "bool", "kind": 4, "label": "true", "tags": [] },
+  { "detail": "bool", "kind": 4, "label": "false", "tags": [] }
+]
+
+Complete src/CompletionConstructorTuple.res 39:38
+posCursor:[39:38] posNoWhite:[39:36] Found expr:[39:3->39:40]
+Pexp_apply ...[39:3->39:13] (...[39:14->39:39])
+Completable: Cexpression CArgument Value[consumeGap]($0)->variantPayload::TupleGap($1)
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath CArgument Value[consumeGap]($0)
+ContextPath Value[consumeGap]
+Path consumeGap
+[
+  { "detail": "bool", "kind": 4, "label": "true", "tags": [] },
+  { "detail": "bool", "kind": 4, "label": "false", "tags": [] }
+]
+
+Complete src/CompletionConstructorTuple.res 42:30
+posCursor:[42:30] posNoWhite:[42:28] Found expr:[42:3->42:40]
+Pexp_apply ...[42:3->42:13] (...[42:14->42:39])
+Completable: Cexpression CArgument Value[consumeGap]($0)->variantPayload::TupleGap($0), tuple($1)
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath CArgument Value[consumeGap]($0)
+ContextPath Value[consumeGap]
+Path consumeGap
+[
+  { "detail": "bool", "kind": 4, "label": "true", "tags": [] },
+  { "detail": "bool", "kind": 4, "label": "false", "tags": [] }
+]
+
+Complete src/CompletionConstructorTuple.res 45:28
+posCursor:[45:28] posNoWhite:[45:26] Found pattern:[45:18->45:36]
+Ppat_construct Gap:[45:18->45:21]
+Completable: Cpattern Value[gap]->variantPayload::Gap($1)
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath Value[gap]
+Path gap
+[
+  { "detail": "bool", "kind": 4, "label": "true", "tags": [] },
+  { "detail": "bool", "kind": 4, "label": "false", "tags": [] }
+]
+
+Complete src/CompletionConstructorTuple.res 48:35
+posCursor:[48:35] posNoWhite:[48:33] Found pattern:[48:18->48:36]
+Ppat_construct Gap:[48:18->48:21]
+Completable: Cpattern Value[gap]->variantPayload::Gap($2)
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath Value[gap]
+Path gap
+[
+  { "detail": "bool", "kind": 4, "label": "true", "tags": [] },
+  { "detail": "bool", "kind": 4, "label": "false", "tags": [] }
+]
+
+Complete src/CompletionConstructorTuple.res 51:42
+posCursor:[51:42] posNoWhite:[51:40] Found pattern:[51:18->51:43]
+Ppat_construct TupleGap:[51:18->51:26]
+Completable: Cpattern Value[gap]->variantPayload::TupleGap($1)
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath Value[gap]
+Path gap
+[
+  { "detail": "bool", "kind": 4, "label": "true", "tags": [] },
+  { "detail": "bool", "kind": 4, "label": "false", "tags": [] }
+]
+
+Complete src/CompletionConstructorTuple.res 54:34
+posCursor:[54:34] posNoWhite:[54:32] Found pattern:[54:18->54:39]
+Ppat_construct TupleGap:[54:18->54:26]
+posCursor:[54:34] posNoWhite:[54:32] Found pattern:[54:27->54:35]
+Completable: Cpattern Value[gap]->variantPayload::TupleGap($0), tuple($1)
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath Value[gap]
+Path gap
+[
+  { "detail": "bool", "kind": 4, "label": "true", "tags": [] },
+  { "detail": "bool", "kind": 4, "label": "false", "tags": [] }
+]
+
diff --git a/tests/analysis_tests/tests/src/expected/CompletionPattern.res.txt b/tests/analysis_tests/tests/src/expected/CompletionPattern.res.txt
index fef158f633..60be7aaf82 100644
--- a/tests/analysis_tests/tests/src/expected/CompletionPattern.res.txt
+++ b/tests/analysis_tests/tests/src/expected/CompletionPattern.res.txt
@@ -427,7 +427,6 @@ Path z
 Complete src/CompletionPattern.res 96:27
 posCursor:[96:27] posNoWhite:[96:26] Found pattern:[96:16->96:28]
 Ppat_construct Three:[96:16->96:21]
-posCursor:[96:27] posNoWhite:[96:26] Found pattern:[96:21->96:29]
 posCursor:[96:27] posNoWhite:[96:26] Found pattern:[96:26->96:27]
 Completable: Cpattern Value[z]=t->variantPayload::Three($1)
 Package opens Stdlib.place holder Pervasives.JsxModules.place holder
@@ -438,8 +437,8 @@ Path z
 
 Complete src/CompletionPattern.res 103:21
 posCursor:[103:21] posNoWhite:[103:20] Found pattern:[103:16->103:22]
-posCursor:[103:21] posNoWhite:[103:20] Found pattern:[103:20->103:21]
-Ppat_construct ():[103:20->103:21]
+posCursor:[103:21] posNoWhite:[103:20] Found pattern:[103:20->103:22]
+Ppat_construct ():[103:20->103:22]
 Completable: Cpattern Value[b]->polyvariantPayload::two($0)
 Package opens Stdlib.place holder Pervasives.JsxModules.place holder
 Resolved opens 1 Stdlib
@@ -513,7 +512,6 @@ Path b
 
 Complete src/CompletionPattern.res 112:28
 posCursor:[112:28] posNoWhite:[112:27] Found pattern:[112:16->112:29]
-posCursor:[112:28] posNoWhite:[112:27] Found pattern:[112:22->112:29]
 posCursor:[112:28] posNoWhite:[112:27] Found pattern:[112:27->112:28]
 Completable: Cpattern Value[b]=t->polyvariantPayload::three($1)
 Package opens Stdlib.place holder Pervasives.JsxModules.place holder
@@ -584,7 +582,6 @@ Path p
 Complete src/CompletionPattern.res 137:29
 posCursor:[137:29] posNoWhite:[137:28] Found pattern:[137:16->137:31]
 Ppat_construct Test:[137:16->137:20]
-posCursor:[137:29] posNoWhite:[137:28] Found pattern:[137:20->137:32]
 Completable: Cpattern Value[p]->variantPayload::Test($2)
 Package opens Stdlib.place holder Pervasives.JsxModules.place holder
 Resolved opens 1 Stdlib
@@ -607,7 +604,6 @@ Path p
 Complete src/CompletionPattern.res 140:23
 posCursor:[140:23] posNoWhite:[140:22] Found pattern:[140:16->140:31]
 Ppat_construct Test:[140:16->140:20]
-posCursor:[140:23] posNoWhite:[140:22] Found pattern:[140:20->140:32]
 Completable: Cpattern Value[p]->variantPayload::Test($1)
 Package opens Stdlib.place holder Pervasives.JsxModules.place holder
 Resolved opens 1 Stdlib
@@ -621,7 +617,6 @@ Path p
 Complete src/CompletionPattern.res 143:35
 posCursor:[143:35] posNoWhite:[143:34] Found pattern:[143:16->143:37]
 Ppat_construct Test:[143:16->143:20]
-posCursor:[143:35] posNoWhite:[143:34] Found pattern:[143:20->143:38]
 Completable: Cpattern Value[p]->variantPayload::Test($3)
 Package opens Stdlib.place holder Pervasives.JsxModules.place holder
 Resolved opens 1 Stdlib
@@ -653,7 +648,6 @@ Path v
 
 Complete src/CompletionPattern.res 153:30
 posCursor:[153:30] posNoWhite:[153:29] Found pattern:[153:16->153:32]
-posCursor:[153:30] posNoWhite:[153:29] Found pattern:[153:21->153:32]
 Completable: Cpattern Value[v]->polyvariantPayload::test($2)
 Package opens Stdlib.place holder Pervasives.JsxModules.place holder
 Resolved opens 1 Stdlib
@@ -675,7 +669,6 @@ Path v
 
 Complete src/CompletionPattern.res 156:24
 posCursor:[156:24] posNoWhite:[156:23] Found pattern:[156:16->156:32]
-posCursor:[156:24] posNoWhite:[156:23] Found pattern:[156:21->156:32]
 Completable: Cpattern Value[v]->polyvariantPayload::test($1)
 Package opens Stdlib.place holder Pervasives.JsxModules.place holder
 Resolved opens 1 Stdlib
@@ -688,7 +681,6 @@ Path v
 
 Complete src/CompletionPattern.res 159:36
 posCursor:[159:36] posNoWhite:[159:35] Found pattern:[159:16->159:38]
-posCursor:[159:36] posNoWhite:[159:35] Found pattern:[159:21->159:38]
 Completable: Cpattern Value[v]->polyvariantPayload::test($3)
 Package opens Stdlib.place holder Pervasives.JsxModules.place holder
 Resolved opens 1 Stdlib
@@ -864,7 +856,6 @@ Complete src/CompletionPattern.res 185:48
 posCursor:[185:48] posNoWhite:[185:47] Found pattern:[185:16->185:50]
 posCursor:[185:48] posNoWhite:[185:47] Found pattern:[185:22->185:50]
 Ppat_construct Three:[185:22->185:27]
-posCursor:[185:48] posNoWhite:[185:47] Found pattern:[185:27->185:53]
 Completable: Cpattern Value[z]->variantPayload::Three($1)
 Package opens Stdlib.place holder Pervasives.JsxModules.place holder
 Resolved opens 1 Stdlib
@@ -891,7 +882,6 @@ Path b
 Complete src/CompletionPattern.res 191:50
 posCursor:[191:50] posNoWhite:[191:49] Found pattern:[191:16->191:52]
 posCursor:[191:50] posNoWhite:[191:49] Found pattern:[191:23->191:52]
-posCursor:[191:50] posNoWhite:[191:49] Found pattern:[191:29->191:52]
 Completable: Cpattern Value[b]->polyvariantPayload::three($1)
 Package opens Stdlib.place holder Pervasives.JsxModules.place holder
 Resolved opens 1 Stdlib
@@ -1183,3 +1173,58 @@ Path callWithTwoParams
   { "detail": "bool", "kind": 4, "label": "false", "tags": [] }
 ]
 
+Complete src/CompletionPattern.res 260:35
+posCursor:[260:35] posNoWhite:[260:34] Found pattern:[260:27->260:37]
+Ppat_construct Inline:[260:27->260:33]
+posCursor:[260:35] posNoWhite:[260:34] Found pattern:[260:34->260:36]
+Completable: Cpattern Value[inlineRecord]->variantPayload::Inline($0), recordBody
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath Value[inlineRecord]
+Path inlineRecord
+[
+  {
+    "detail": "bool",
+    "documentation": {
+      "kind": "markdown",
+      "value": "```rescript\nenabled: bool\n```\n\n```rescript\n{enabled: bool, nested: nestedRecord}\n```"
+    },
+    "kind": 5,
+    "label": "enabled",
+    "tags": []
+  },
+  {
+    "detail": "nestedRecord",
+    "documentation": {
+      "kind": "markdown",
+      "value": "```rescript\nnested: nestedRecord\n```\n\n```rescript\n{enabled: bool, nested: nestedRecord}\n```"
+    },
+    "kind": 5,
+    "label": "nested",
+    "tags": []
+  }
+]
+
+Complete src/CompletionPattern.res 263:44
+posCursor:[263:44] posNoWhite:[263:43] Found pattern:[263:27->263:47]
+Ppat_construct Inline:[263:27->263:33]
+posCursor:[263:44] posNoWhite:[263:43] Found pattern:[263:34->263:46]
+posCursor:[263:44] posNoWhite:[263:43] Found pattern:[263:43->263:45]
+Completable: Cpattern Value[inlineRecord]->variantPayload::Inline($0), recordField(nested), recordBody
+Package opens Stdlib.place holder Pervasives.JsxModules.place holder
+Resolved opens 1 Stdlib
+ContextPath Value[inlineRecord]
+Path inlineRecord
+[
+  {
+    "detail": "bool",
+    "documentation": {
+      "kind": "markdown",
+      "value": "```rescript\nnested: bool\n```\n\n```rescript\ntype nestedRecord = {nested: bool}\n```"
+    },
+    "kind": 5,
+    "label": "nested",
+    "tags": []
+  }
+]
+
diff --git a/tests/analysis_tests/tests/src/expected/SignatureHelpConstructorBoundaries.res.txt b/tests/analysis_tests/tests/src/expected/SignatureHelpConstructorBoundaries.res.txt
new file mode 100644
index 0000000000..65e66f73bb
--- /dev/null
+++ b/tests/analysis_tests/tests/src/expected/SignatureHelpConstructorBoundaries.res.txt
@@ -0,0 +1,131 @@
+Signature help src/SignatureHelpConstructorBoundaries.res 3:14
+null
+
+Signature help src/SignatureHelpConstructorBoundaries.res 7:13
+null
+
+Signature help src/SignatureHelpConstructorBoundaries.res 11:18
+null
+
+Signature help src/SignatureHelpConstructorBoundaries.res 15:24
+{
+  "activeParameter": 0,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 0,
+      "label": "Pair(int, int)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 5, 8 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 10, 13 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorBoundaries.res 19:15
+{
+  "activeParameter": 1,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 1,
+      "label": "Pair(int, int)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 5, 8 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 10, 13 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorBoundaries.res 23:18
+{
+  "activeParameter": 1,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 1,
+      "label": "Pair(int, int)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 5, 8 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 10, 13 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorBoundaries.res 27:19
+null
+
+Signature help src/SignatureHelpConstructorBoundaries.res 31:43
+null
+
+Signature help src/SignatureHelpConstructorBoundaries.res 35:47
+null
+
+Signature help src/SignatureHelpConstructorBoundaries.res 39:53
+{
+  "activeParameter": 0,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 0,
+      "label": "Pair(int, int)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 5, 8 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 10, 13 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorBoundaries.res 43:44
+{
+  "activeParameter": 1,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 1,
+      "label": "Pair(int, int)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 5, 8 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 10, 13 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorBoundaries.res 47:48
+null
+
diff --git a/tests/analysis_tests/tests/src/expected/SignatureHelpConstructorGaps.res.txt b/tests/analysis_tests/tests/src/expected/SignatureHelpConstructorGaps.res.txt
new file mode 100644
index 0000000000..8915f21ec0
--- /dev/null
+++ b/tests/analysis_tests/tests/src/expected/SignatureHelpConstructorGaps.res.txt
@@ -0,0 +1,237 @@
+Signature help src/SignatureHelpConstructorGaps.res 2:17
+{
+  "activeParameter": 1,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 1,
+      "label": "Three(string, array<int>)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 6, 12 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 14, 24 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorGaps.res 4:18
+{
+  "activeParameter": 1,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 1,
+      "label": "Three(string, array<int>)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 6, 12 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 14, 24 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorGaps.res 6:19
+{
+  "activeParameter": 1,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 1,
+      "label": "Three(string, array<int>)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 6, 12 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 14, 24 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorGaps.res 8:14
+{
+  "activeParameter": 0,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 0,
+      "label": "Three(string, array<int>)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 6, 12 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 14, 24 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorGaps.res 10:14
+{
+  "activeParameter": 0,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 0,
+      "label": "Unary(string)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 6, 12 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorGaps.res 13:20
+{
+  "activeParameter": 1,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 1,
+      "label": "Three(string, array<int>)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 6, 12 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 14, 24 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorGaps.res 15:17
+{
+  "activeParameter": 0,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 0,
+      "label": "Three(string, array<int>)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 6, 12 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 14, 24 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorGaps.res 19:2
+{
+  "activeParameter": 1,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 1,
+      "label": "Three(string, array<int>)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 6, 12 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 14, 24 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorGaps.res 23:11
+null
+
+Signature help src/SignatureHelpConstructorGaps.res 27:10
+{
+  "activeParameter": 1,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 1,
+      "label": "Three(string, array<int>)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 6, 12 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 14, 24 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorGaps.res 29:11
+{
+  "activeParameter": 1,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 1,
+      "label": "Three(string, array<int>)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 6, 12 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 14, 24 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorGaps.res 31:8
+{
+  "activeParameter": 0,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 0,
+      "label": "Unary(string)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 6, 12 ]
+        }
+      ]
+    }
+  ]
+}
+
diff --git a/tests/analysis_tests/tests/src/expected/SignatureHelpConstructorTuple.res.txt b/tests/analysis_tests/tests/src/expected/SignatureHelpConstructorTuple.res.txt
new file mode 100644
index 0000000000..cf1d5b53e0
--- /dev/null
+++ b/tests/analysis_tests/tests/src/expected/SignatureHelpConstructorTuple.res.txt
@@ -0,0 +1,44 @@
+Signature help src/SignatureHelpConstructorTuple.res 2:23
+{
+  "activeParameter": 1,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 1,
+      "label": "Pair(int, string)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 5, 8 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 10, 16 ]
+        }
+      ]
+    }
+  ]
+}
+
+Signature help src/SignatureHelpConstructorTuple.res 6:15
+{
+  "activeParameter": 1,
+  "activeSignature": 0,
+  "signatures": [
+    {
+      "activeParameter": 1,
+      "label": "Pair(int, string)",
+      "parameters": [
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 5, 8 ]
+        },
+        {
+          "documentation": { "kind": "markdown", "value": "" },
+          "label": [ 10, 16 ]
+        }
+      ]
+    }
+  ]
+}
+
diff --git a/tests/analysis_tests/tests/src/expected/TypeAtPosCompletion.res.txt b/tests/analysis_tests/tests/src/expected/TypeAtPosCompletion.res.txt
index d79b5b50ed..f18c6358f8 100644
--- a/tests/analysis_tests/tests/src/expected/TypeAtPosCompletion.res.txt
+++ b/tests/analysis_tests/tests/src/expected/TypeAtPosCompletion.res.txt
@@ -29,8 +29,7 @@ ContextPath CTypeAtPos()
 
 Complete src/TypeAtPosCompletion.res 16:18
 posCursor:[16:18] posNoWhite:[16:16] Found expr:[13:8->19:1]
-Pexp_construct One:[13:8->13:11] [13:11->19:1]
-posCursor:[16:18] posNoWhite:[16:16] Found expr:[15:2->18:3]
+Pexp_construct One:[13:8->13:11] [14:2->14:3], [15:2->18:3]
 Completable: Cexpression CTypeAtPos()->variantPayload::One($1), recordBody
 Package opens Stdlib.place holder Pervasives.JsxModules.place holder
 Resolved opens 1 Stdlib
diff --git a/tests/build_tests/super_errors/expected/constructor_tuple_arity_mismatch.res.expected b/tests/build_tests/super_errors/expected/constructor_tuple_arity_mismatch.res.expected
new file mode 100644
index 0000000000..a74292b9c7
--- /dev/null
+++ b/tests/build_tests/super_errors/expected/constructor_tuple_arity_mismatch.res.expected
@@ -0,0 +1,10 @@
+
+  We've found a bug for you!
+  /.../fixtures/constructor_tuple_arity_mismatch.res:3:15-31
+
+  1 │ type binary = Binary(int, int)
+  2 │ 
+  3 │ let invalid = Binary((1, 2, 3))
+  4 │ 
+
+  This variant constructor Binary expects 2 arguments, but it's being passed 3.
\ No newline at end of file
diff --git a/tests/build_tests/super_errors/expected/constructor_tuple_arity_mismatch_pattern.res.expected b/tests/build_tests/super_errors/expected/constructor_tuple_arity_mismatch_pattern.res.expected
new file mode 100644
index 0000000000..3fab3c019e
--- /dev/null
+++ b/tests/build_tests/super_errors/expected/constructor_tuple_arity_mismatch_pattern.res.expected
@@ -0,0 +1,11 @@
+
+  We've found a bug for you!
+  /.../fixtures/constructor_tuple_arity_mismatch_pattern.res:5:5-21
+
+  3 │ let read = value =>
+  4 │   switch value {
+  5 │   | Binary((x, y, z)) => x + y + z
+  6 │   }
+  7 │ 
+
+  This variant constructor Binary expects 2 arguments, but it's being passed 3.
\ No newline at end of file
diff --git a/tests/build_tests/super_errors/fixtures/constructor_tuple_arity_mismatch.res b/tests/build_tests/super_errors/fixtures/constructor_tuple_arity_mismatch.res
new file mode 100644
index 0000000000..8853d5c437
--- /dev/null
+++ b/tests/build_tests/super_errors/fixtures/constructor_tuple_arity_mismatch.res
@@ -0,0 +1,3 @@
+type binary = Binary(int, int)
+
+let invalid = Binary((1, 2, 3))
diff --git a/tests/build_tests/super_errors/fixtures/constructor_tuple_arity_mismatch_pattern.res b/tests/build_tests/super_errors/fixtures/constructor_tuple_arity_mismatch_pattern.res
new file mode 100644
index 0000000000..13aa5b245d
--- /dev/null
+++ b/tests/build_tests/super_errors/fixtures/constructor_tuple_arity_mismatch_pattern.res
@@ -0,0 +1,6 @@
+type binary = Binary(int, int)
+
+let read = value =>
+  switch value {
+  | Binary((x, y, z)) => x + y + z
+  }
diff --git a/tests/ounit_tests/ounit_ast_mapper0_tests.ml b/tests/ounit_tests/ounit_ast_mapper0_tests.ml
index 32e2564b04..cea42e419e 100644
--- a/tests/ounit_tests/ounit_ast_mapper0_tests.ml
+++ b/tests/ounit_tests/ounit_ast_mapper0_tests.ml
@@ -187,8 +187,465 @@ let test_function_cases_desugar_to_fun_match _ =
 let map_expr_to0 e =
   Ast_mapper_to0.default_mapper.expr Ast_mapper_to0.default_mapper e
 
+let map_pat_to0 p =
+  Ast_mapper_to0.default_mapper.pat Ast_mapper_to0.default_mapper p
+
 let attr_names attrs = List.map (fun ({Location.txt}, _) -> txt) attrs
 
+let test_list_constructor_wire_shape _ =
+  let lid name = Location.mknoloc (Longident.Lident name) in
+  List.iter
+    (fun (attrs, payload_attrs) ->
+      let expr0 =
+        List.fold_right
+          (fun value tail ->
+            Ast_helper0.Exp.construct ~loc ~attrs (lid "::")
+              (Some
+                 (Ast_helper0.Exp.tuple ~loc ~attrs:payload_attrs
+                    [
+                      Ast_helper0.Exp.constant ~loc
+                        (Parsetree0.Pconst_integer (value, None));
+                      tail;
+                    ])))
+          ["1"; "2"]
+          (Ast_helper0.Exp.construct ~loc (lid "[]") None)
+      in
+      let pat0 =
+        List.fold_right
+          (fun name tail ->
+            Ast_helper0.Pat.construct ~loc ~attrs (lid "::")
+              (Some
+                 (Ast_helper0.Pat.tuple ~loc ~attrs:payload_attrs
+                    [Ast_helper0.Pat.var ~loc (Location.mknoloc name); tail])))
+          ["head"; "next"]
+          (Ast_helper0.Pat.construct ~loc (lid "[]") None)
+      in
+      let expr = map_expr0 expr0 in
+      let pat = map_pat0 pat0 in
+      (match (payload_attrs, expr.pexp_desc, pat.ppat_desc) with
+      | ( [],
+          Pexp_construct (_, {txt = [_; _]}),
+          Ppat_construct (_, {txt = [_; _]}) ) ->
+        ()
+      | ( _ :: _,
+          Pexp_construct (_, {txt = [{pexp_desc = Pexp_tuple [_; _]}]}),
+          Ppat_construct (_, {txt = [{ppat_desc = Ppat_tuple [_; _]}]}) ) ->
+        ()
+      | _ ->
+        assert_failure "Attributed cons payloads must retain their tuple node");
+      OUnit.assert_equal ~msg:"list expression wire shape and attributes" expr0
+        (map_expr_to0 expr);
+      OUnit.assert_equal ~msg:"list pattern wire shape and attributes" pat0
+        (map_pat_to0 pat);
+      let structure =
+        [
+          Ast_helper.Str.value ~loc Nonrecursive [Ast_helper.Vb.mk ~loc pat expr];
+        ]
+      in
+      ignore (Typemod.type_structure Env.initial_safe_string structure loc);
+      let printed =
+        Res_printer.print_implementation structure ~comments:[] ~width:80
+      in
+      let parsed =
+        Res_driver.parse_implementation_from_source
+          ~display_filename:"ListPayloadAttributes.res" ~source:printed
+      in
+      OUnit.assert_bool "attributed list payloads remain printable"
+        (not parsed.invalid);
+      ignore (Format.asprintf "%a" Pprintast.structure structure))
+    (let attrs = [attr "public_attr" (Parsetree0.PStr [])] in
+     [([], []); (attrs, []); ([], attrs); (attrs, attrs)])
+
+let test_constructor_args_roundtrip_through_ast0 _ =
+  let int_expr value =
+    Ast_helper.Exp.constant ~loc (Parsetree.Pconst_integer (value, None))
+  in
+  let int_pat value =
+    Ast_helper.Pat.constant ~loc (Parsetree.Pconst_integer (value, None))
+  in
+  let lid = Location.mknoloc (Longident.Lident "Pair") in
+  let expr =
+    Ast_helper.Exp.construct ~loc lid
+      (Location.mkloc [int_expr "1"; int_expr "2"] loc)
+  in
+  let expr0 = map_expr_to0 expr in
+  (match expr0.pexp_desc with
+  | Parsetree0.Pexp_construct (_, Some {pexp_desc = Pexp_tuple [_; _]}) ->
+    OUnit.assert_bool "multiple arguments carry bridge metadata"
+      (has_attr "_res.constructor_args" expr0.pexp_attributes)
+  | _ -> assert_failure "Expected a tuple-encoded v0 constructor payload");
+  let expr = map_expr0 expr0 in
+  (match expr.pexp_desc with
+  | Parsetree.Pexp_construct (_, {txt = [_; _]}) ->
+    OUnit.assert_bool "bridge metadata is removed"
+      (not (has_attr "_res.constructor_args" expr.pexp_attributes))
+  | _ -> assert_failure "Expected two constructor arguments after roundtrip");
+  let tuple_expr = Ast_helper.Exp.tuple ~loc [int_expr "1"; int_expr "2"] in
+  let expr =
+    Ast_helper.Exp.construct ~loc lid (Location.mkloc [tuple_expr] loc)
+  in
+  let expr0 = map_expr_to0 expr in
+  OUnit.assert_equal
+    ~msg:"a single tuple argument does not carry bridge metadata" []
+    expr0.pexp_attributes;
+  let expr = map_expr0 expr0 in
+  OUnit.assert_equal ~msg:"tuple roundtrip preserves empty attributes" []
+    expr.pexp_attributes;
+  (match expr.pexp_desc with
+  | Parsetree.Pexp_construct (_, {txt = [{pexp_desc = Pexp_tuple [_; _]}]}) ->
+    ()
+  | _ -> assert_failure "Expected one tuple argument after roundtrip");
+  let pat =
+    Ast_helper.Pat.construct ~loc lid
+      (Location.mkloc [int_pat "1"; int_pat "2"] loc)
+  in
+  let pat0 = map_pat_to0 pat in
+  (match pat0.ppat_desc with
+  | Parsetree0.Ppat_construct (_, Some {ppat_desc = Ppat_tuple [_; _]}) ->
+    OUnit.assert_bool "pattern arguments carry bridge metadata"
+      (has_attr "_res.constructor_args" pat0.ppat_attributes)
+  | _ -> assert_failure "Expected a tuple-encoded v0 constructor pattern");
+  match (map_pat0 pat0).ppat_desc with
+  | Parsetree.Ppat_construct (_, {txt = [_; _]}) -> ()
+  | _ -> assert_failure "Expected two pattern arguments after roundtrip"
+
+let check_args_keep_parentheses_location_in_ast0 sources =
+  List.iter
+    (fun source ->
+      let parsed =
+        Res_driver.parse_implementation_from_source
+          ~display_filename:"VariantArgsLocation.res" ~source
+      in
+      let pat, expr =
+        match parsed.parsetree with
+        | [{pstr_desc = Pstr_value (_, [{pvb_pat; pvb_expr}])}] ->
+          (pvb_pat, pvb_expr)
+        | _ -> assert_failure "Expected one constructor binding"
+      in
+      let pattern_start = String.index source '(' in
+      let pattern_end = 1 + String.index_from source pattern_start ')' in
+      let expression_start = String.index_from source pattern_end '(' in
+      let expression_end = 1 + String.index_from source expression_start ')' in
+      OUnit.assert_equal [] pat.ppat_attributes;
+      OUnit.assert_equal [] expr.pexp_attributes;
+      let check ?(offset = 0) (pat : Parsetree0.pattern)
+          (expr : Parsetree0.expression) =
+        let assert_loc start finish {Location.loc_start; loc_end} =
+          OUnit.assert_equal (start + offset) loc_start.pos_cnum;
+          OUnit.assert_equal (finish + offset) loc_end.pos_cnum
+        in
+        (match pat.ppat_desc with
+        | Ppat_construct (_, Some {ppat_desc = Ppat_tuple _; ppat_loc})
+        | Ppat_variant (_, Some {ppat_desc = Ppat_tuple _; ppat_loc}) ->
+          assert_loc pattern_start pattern_end ppat_loc
+        | _ -> assert_failure "Expected v0 constructor pattern tuple");
+        match expr.pexp_desc with
+        | Pexp_construct (_, Some {pexp_desc = Pexp_tuple _; pexp_loc})
+        | Pexp_variant (_, Some {pexp_desc = Pexp_tuple _; pexp_loc}) ->
+          assert_loc expression_start expression_end pexp_loc
+        | _ -> assert_failure "Expected v0 constructor expression tuple"
+      in
+      let pat0 = map_pat_to0 pat in
+      let expr0 = map_expr_to0 expr in
+      check pat0 expr0;
+      check (map_pat_to0 (map_pat0 pat0)) (map_expr_to0 (map_expr0 expr0));
+      let shift_loc _ (loc : Location.t) =
+        {
+          loc with
+          loc_start =
+            {loc.loc_start with pos_cnum = loc.loc_start.pos_cnum + 100};
+          loc_end = {loc.loc_end with pos_cnum = loc.loc_end.pos_cnum + 100};
+        }
+      in
+      let to0 = {Ast_mapper_to0.default_mapper with location = shift_loc} in
+      check ~offset:100 (to0.pat to0 pat) (to0.expr to0 expr);
+      let from0 = {Ast_mapper_from0.default_mapper with location = shift_loc} in
+      check ~offset:100
+        (map_pat_to0 (from0.pat from0 pat0))
+        (map_expr_to0 (from0.expr from0 expr0)))
+    sources
+
+let test_constructor_args_keep_parentheses_location_in_ast0 _ =
+  check_args_keep_parentheses_location_in_ast0
+    [
+      "let Pair(a, b) = Pair(1, 2)";
+      "let Pair  (a, b) = Pair  (1, 2)";
+      "let Pair /* pattern */ (a, b) = Pair /* expression */ (1, 2)";
+      "let Module.Pair(a,\n b) = Module.Pair(1,\n 2)";
+    ]
+
+let test_polyvariant_args_keep_parentheses_location_in_ast0 _ =
+  check_args_keep_parentheses_location_in_ast0
+    [
+      "let #Pair(a, b) = #Pair(1, 2)";
+      "let #Pair /* pattern */ (a, b) = #Pair /* expression */ (1, 2)";
+      "let #\"quoted label\"(a,\n b) = #\"quoted label\"(1,\n 2)";
+    ]
+
+let test_constructor_argument_locations_through_ast0 _ =
+  let pattern_args_loc (pat : Parsetree.pattern) =
+    match pat.ppat_desc with
+    | Ppat_construct (_, {loc}) | Ppat_variant (_, {loc}) -> loc
+    | _ -> assert_failure "Expected a constructor pattern"
+  in
+  let expression_args_loc (expr : Parsetree.expression) =
+    match expr.pexp_desc with
+    | Pexp_construct (_, {loc}) | Pexp_variant (_, {loc}) -> loc
+    | _ -> assert_failure "Expected a constructor expression"
+  in
+  List.iter
+    (fun source ->
+      let parsed =
+        Res_driver.parse_implementation_from_source
+          ~display_filename:"ArgumentLocations.res" ~source
+      in
+      OUnit.assert_bool "source parses" (not parsed.invalid);
+      let pat, expr =
+        match parsed.parsetree with
+        | [{pstr_desc = Pstr_value (_, [{pvb_pat; pvb_expr}])}] ->
+          (pvb_pat, pvb_expr)
+        | _ -> assert_failure "Expected a constructor binding"
+      in
+      let pat_loc = pattern_args_loc pat in
+      let expr_loc = expression_args_loc expr in
+      let expected_pat_bridge_loc =
+        match pat.ppat_desc with
+        | Ppat_construct (_, {txt = [arg]}) | Ppat_variant (_, {txt = [arg]}) ->
+          arg.ppat_loc
+        | _ -> pat_loc
+      in
+      let expected_expr_bridge_loc =
+        match expr.pexp_desc with
+        | Pexp_construct (_, {txt = [arg]}) | Pexp_variant (_, {txt = [arg]}) ->
+          arg.pexp_loc
+        | _ -> expr_loc
+      in
+      OUnit.assert_equal ~msg:"v0 uses the payload span for a single argument"
+        expected_pat_bridge_loc
+        (pattern_args_loc (map_pat0 (map_pat_to0 pat)));
+      OUnit.assert_equal ~msg:"v0 uses the payload span for a single argument"
+        expected_expr_bridge_loc
+        (expression_args_loc (map_expr0 (map_expr_to0 expr))))
+    [
+      "let Pair /* pattern */ (a, b) = Pair /* expression */ (1, 2)";
+      "let Pair((a, b)) = Pair((1, 2))";
+      "let Single(a) = Single(1)";
+      "let Unit() = Unit()";
+      "let Empty = Empty";
+      "let #Pair /* pattern */ (a, b) = #Pair /* expression */ (1, 2)";
+      "let #Pair((a, b)) = #Pair((1, 2))";
+      "let #Single(a) = #Single(1)";
+      "let #Unit() = #Unit()";
+      "let #Empty = #Empty";
+    ]
+
+let test_fresh_ast0_constructor_tuple_reprints_without_internal_metadata _ =
+  let int_expr value =
+    Ast_helper0.Exp.constant ~loc (Parsetree0.Pconst_integer (value, None))
+  in
+  let expr =
+    map_expr0
+      (Ast_helper0.Exp.construct ~loc
+         (Location.mknoloc (Longident.Lident "Pair"))
+         (Some (Ast_helper0.Exp.tuple ~loc [int_expr "1"; int_expr "2"])))
+  in
+  let pat =
+    map_pat0
+      (Ast_helper0.Pat.construct ~loc
+         (Location.mknoloc (Longident.Lident "Pair"))
+         (Some
+            (Ast_helper0.Pat.tuple ~loc
+               [
+                 Ast_helper0.Pat.var ~loc (Location.mknoloc "a");
+                 Ast_helper0.Pat.var ~loc (Location.mknoloc "b");
+               ])))
+  in
+  OUnit.assert_equal ~msg:"fresh v0 expression needs no internal metadata" []
+    expr.pexp_attributes;
+  OUnit.assert_equal ~msg:"fresh v0 pattern needs no internal metadata" []
+    pat.ppat_attributes;
+  List.iter
+    (fun width ->
+      let printed =
+        Res_printer.print_implementation
+          [
+            Ast_helper.Str.value ~loc Nonrecursive
+              [Ast_helper.Vb.mk ~loc pat expr];
+          ]
+          ~comments:[] ~width
+      in
+      let parsed =
+        Res_driver.parse_implementation_from_source
+          ~display_filename:"FreshAst0Constructor.res" ~source:printed
+      in
+      match parsed.parsetree with
+      | [
+       {
+         pstr_desc =
+           Pstr_value
+             ( _,
+               [
+                 {
+                   pvb_pat =
+                     {
+                       ppat_desc =
+                         Ppat_construct
+                           (_, {txt = [{ppat_desc = Ppat_tuple [_; _]}]});
+                     };
+                   pvb_expr =
+                     {
+                       pexp_desc =
+                         Pexp_construct
+                           (_, {txt = [{pexp_desc = Pexp_tuple [_; _]}]});
+                     };
+                 };
+               ] );
+       };
+      ] ->
+        ()
+      | _ -> assert_failure "Expected a printed tuple payload")
+    [10; 80]
+
+let test_ast0_explicit_arity_becomes_constructor_args _ =
+  let arg value =
+    Ast_helper0.Exp.constant ~loc (Parsetree0.Pconst_integer (value, None))
+  in
+  let expr0 =
+    Ast_helper0.Exp.construct ~loc
+      ~attrs:[attr "ocaml.explicit_arity" (Parsetree0.PStr [])]
+      (Location.mknoloc (Longident.Lident "Pair"))
+      (Some (Ast_helper0.Exp.tuple ~loc [arg "1"; arg "2"]))
+  in
+  match (map_expr0 expr0).pexp_desc with
+  | Parsetree.Pexp_construct (_, {txt = [_; _]}) -> ()
+  | _ -> assert_failure "Expected explicit-arity v0 payload to become arguments"
+
+let test_fresh_ast0_constructor_tuple_defers_arity_to_typechecker _ =
+  let int_expr value =
+    Ast_helper0.Exp.constant ~loc (Parsetree0.Pconst_integer (value, None))
+  in
+  let int_pat value =
+    Ast_helper0.Pat.constant ~loc (Parsetree0.Pconst_integer (value, None))
+  in
+  let lid = Location.mknoloc (Longident.Lident "FreshPairForAst0") in
+  let expr =
+    map_expr0
+      (Ast_helper0.Exp.construct ~loc lid
+         (Some (Ast_helper0.Exp.tuple ~loc [int_expr "1"; int_expr "2"])))
+  in
+  let pat =
+    map_pat0
+      (Ast_helper0.Pat.construct ~loc lid
+         (Some (Ast_helper0.Pat.tuple ~loc [int_pat "1"; int_pat "2"])))
+  in
+  OUnit.assert_equal [] expr.pexp_attributes;
+  OUnit.assert_equal [] pat.ppat_attributes;
+  List.iter
+    (fun payload_type ->
+      let parsed =
+        Res_driver.parse_implementation_from_source
+          ~display_filename:"Ast0ConstructorArgsTest.res"
+          ~source:
+            (Printf.sprintf
+               "type freshPairForAst0 = FreshPairForAst0(%s)\n\
+                let value = FreshPairForAst0(1, 2)\n\
+                let FreshPairForAst0(a, b) = value"
+               payload_type)
+      in
+      let structure =
+        match parsed.parsetree with
+        | [type_item; value_item; pattern_item] ->
+          let value_item =
+            match value_item.pstr_desc with
+            | Pstr_value (rec_flag, [binding]) ->
+              {
+                value_item with
+                pstr_desc =
+                  Pstr_value (rec_flag, [{binding with pvb_expr = expr}]);
+              }
+            | _ -> assert_failure "Expected value binding"
+          in
+          let pattern_item =
+            match pattern_item.pstr_desc with
+            | Pstr_value (rec_flag, [binding]) ->
+              {
+                pattern_item with
+                pstr_desc = Pstr_value (rec_flag, [{binding with pvb_pat = pat}]);
+              }
+            | _ -> assert_failure "Expected pattern binding"
+          in
+          [type_item; value_item; pattern_item]
+        | _ -> assert_failure "Expected type declaration and two value bindings"
+      in
+      ignore (Typemod.type_structure Env.initial_safe_string structure loc))
+    ["int, int"; "(int, int)"]
+
+let test_polyvariant_args_roundtrip_through_ast0 _ =
+  let int_expr value =
+    Ast_helper.Exp.constant ~loc (Parsetree.Pconst_integer (value, None))
+  in
+  let int_pat value =
+    Ast_helper.Pat.constant ~loc (Parsetree.Pconst_integer (value, None))
+  in
+  let expr =
+    Ast_helper.Exp.variant ~loc "Pair"
+      (Location.mkloc [int_expr "1"; int_expr "2"] loc)
+  in
+  let expr0 = map_expr_to0 expr in
+  (match expr0.pexp_desc with
+  | Parsetree0.Pexp_variant ("Pair", Some {pexp_desc = Pexp_tuple [_; _]}) ->
+    OUnit.assert_bool "polymorphic variant arguments carry bridge metadata"
+      (has_attr "_res.constructor_args" expr0.pexp_attributes)
+  | _ -> assert_failure "Expected tuple-encoded v0 polymorphic variant payload");
+  (match (map_expr0 expr0).pexp_desc with
+  | Parsetree.Pexp_variant ("Pair", {txt = [_; _]}) -> ()
+  | _ -> assert_failure "Expected two polymorphic variant arguments");
+  let pat =
+    Ast_helper.Pat.variant ~loc "Pair"
+      (Location.mkloc [int_pat "1"; int_pat "2"] loc)
+  in
+  let pat0 = map_pat_to0 pat in
+  (match pat0.ppat_desc with
+  | Parsetree0.Ppat_variant ("Pair", Some {ppat_desc = Ppat_tuple [_; _]}) ->
+    OUnit.assert_bool "polymorphic variant pattern arguments carry metadata"
+      (has_attr "_res.constructor_args" pat0.ppat_attributes)
+  | _ -> assert_failure "Expected tuple-encoded v0 polymorphic variant pattern");
+  (match (map_pat0 pat0).ppat_desc with
+  | Parsetree.Ppat_variant ("Pair", {txt = [_; _]}) -> ()
+  | _ -> assert_failure "Expected two polymorphic variant pattern arguments");
+  let int_type =
+    Ast_helper.Typ.constr ~loc (Location.mknoloc (Longident.Lident "int")) []
+  in
+  let typ =
+    Ast_helper.Typ.variant ~loc
+      [
+        Parsetree.Rtag
+          ( Location.mknoloc "Pair",
+            [],
+            false,
+            [Location.mkloc [int_type; int_type] loc] );
+      ]
+      Closed None
+  in
+  let typ0 =
+    Ast_mapper_to0.default_mapper.typ Ast_mapper_to0.default_mapper typ
+  in
+  (match typ0.ptyp_desc with
+  | Parsetree0.Ptyp_variant
+      ( [Rtag ({txt = "Pair"}, _, false, [{ptyp_desc = Ptyp_tuple [_; _]}])],
+        _,
+        _ ) ->
+    ()
+  | _ -> assert_failure "Expected tuple-encoded v0 polymorphic variant type");
+  let typ =
+    Ast_mapper_from0.default_mapper.typ Ast_mapper_from0.default_mapper typ0
+  in
+  match typ.ptyp_desc with
+  | Parsetree.Ptyp_variant
+      ([Rtag ({txt = "Pair"}, _, false, [{txt = [_; _]}])], _, _) ->
+    ()
+  | _ -> assert_failure "Expected two polymorphic variant type arguments"
+
 let assert_string_expr ~expected_source ~expected_semantic expr =
   match expr.Parsetree.pexp_desc with
   | Pexp_constant (Pconst_string payload) ->
@@ -567,7 +1024,7 @@ let quote = "\""
 let slash = "\\"|}
   in
   let parsed =
-    Res_driver.parse_implementation_from_source ~for_printer:false
+    Res_driver.parse_implementation_from_source
       ~display_filename:"StringReprintTest.res" ~source
   in
   OUnit.assert_bool "expected valid ReScript source" (not parsed.invalid);
@@ -587,7 +1044,7 @@ let slash = "\\"|}
 let test_invalid_utf8_doc_comment_roundtrips_through_ast0 _ =
   let source = "/** doc " ^ "\xff" ^ " byte */\nlet value = 1" in
   let parsed =
-    Res_driver.parse_implementation_from_source ~for_printer:false
+    Res_driver.parse_implementation_from_source
       ~display_filename:"InvalidDocComment.res" ~source
   in
   OUnit.assert_bool "expected invalid UTF-8 to be diagnosed" parsed.invalid;
@@ -703,6 +1160,23 @@ let suites =
          >:: test_malformed_internal_record_rest_attr_fails;
          "record_rest_roundtrips_through_ast0"
          >:: test_record_rest_roundtrips_through_ast0;
+         "constructor_args_roundtrip_through_ast0"
+         >:: test_constructor_args_roundtrip_through_ast0;
+         "list_constructor_wire_shape" >:: test_list_constructor_wire_shape;
+         "constructor_args_keep_parentheses_location_in_ast0"
+         >:: test_constructor_args_keep_parentheses_location_in_ast0;
+         "constructor_argument_locations_through_ast0"
+         >:: test_constructor_argument_locations_through_ast0;
+         "fresh_ast0_constructor_tuple_reprints_without_internal_metadata"
+         >:: test_fresh_ast0_constructor_tuple_reprints_without_internal_metadata;
+         "ast0_explicit_arity_becomes_constructor_args"
+         >:: test_ast0_explicit_arity_becomes_constructor_args;
+         "fresh_ast0_constructor_tuple_defers_arity_to_typechecker"
+         >:: test_fresh_ast0_constructor_tuple_defers_arity_to_typechecker;
+         "polyvariant_args_roundtrip_through_ast0"
+         >:: test_polyvariant_args_roundtrip_through_ast0;
+         "polyvariant_args_keep_parentheses_location_in_ast0"
+         >:: test_polyvariant_args_keep_parentheses_location_in_ast0;
          "value_constraint_roundtrips_through_ast0"
          >:: test_value_constraint_roundtrips_through_ast0;
          "function_cases_desugar_to_fun_match"
diff --git a/tests/ounit_tests/ounit_constructor_arguments_tests.ml b/tests/ounit_tests/ounit_constructor_arguments_tests.ml
new file mode 100644
index 0000000000..e770846c1f
--- /dev/null
+++ b/tests/ounit_tests/ounit_constructor_arguments_tests.ml
@@ -0,0 +1,209 @@
+let ( >:: ), ( >::: ) = OUnit.(( >:: ), ( >::: ))
+let assert_failure = OUnit.assert_failure
+
+let test_constructor_argument_locations _ =
+  let pattern_args_loc (pat : Parsetree.pattern) =
+    match pat.ppat_desc with
+    | Ppat_construct (_, {loc}) | Ppat_variant (_, {loc}) -> loc
+    | _ -> assert_failure "Expected a constructor pattern"
+  in
+  let expression_args_loc (expr : Parsetree.expression) =
+    match expr.pexp_desc with
+    | Pexp_construct (_, {loc}) | Pexp_variant (_, {loc}) -> loc
+    | _ -> assert_failure "Expected a constructor expression"
+  in
+  let shift_loc _ (loc : Location.t) =
+    {
+      loc with
+      loc_start = {loc.loc_start with pos_cnum = loc.loc_start.pos_cnum + 100};
+      loc_end = {loc.loc_end with pos_cnum = loc.loc_end.pos_cnum + 100};
+    }
+  in
+  List.iter
+    (fun source ->
+      let parsed =
+        Res_driver.parse_implementation_from_source
+          ~display_filename:"ArgumentLocations.res" ~source
+      in
+      OUnit.assert_bool "source parses" (not parsed.invalid);
+      let pat, expr =
+        match parsed.parsetree with
+        | [{pstr_desc = Pstr_value (_, [{pvb_pat; pvb_expr}])}] ->
+          (pvb_pat, pvb_expr)
+        | _ -> assert_failure "Expected a constructor binding"
+      in
+      let pat_loc = pattern_args_loc pat in
+      let expr_loc = expression_args_loc expr in
+      let equals = String.index source '=' in
+      let assert_span start finish (loc : Location.t) =
+        OUnit.assert_equal start loc.loc_start.pos_cnum;
+        OUnit.assert_equal finish loc.loc_end.pos_cnum
+      in
+      if String.contains source '(' then (
+        assert_span (String.index source '(')
+          (1 + String.rindex_from source equals ')')
+          pat_loc;
+        assert_span
+          (String.index_from source equals '(')
+          (1 + String.rindex source ')')
+          expr_loc)
+      else (
+        OUnit.assert_equal pat.ppat_loc pat_loc;
+        OUnit.assert_equal expr.pexp_loc expr_loc);
+      let mapper = Ast_mapper.default_mapper in
+      OUnit.assert_equal pat (mapper.pat mapper pat);
+      OUnit.assert_equal expr (mapper.expr mapper expr);
+      let mapper = {mapper with location = shift_loc} in
+      OUnit.assert_equal (shift_loc () pat_loc)
+        (pattern_args_loc (mapper.pat mapper pat));
+      OUnit.assert_equal (shift_loc () expr_loc)
+        (expression_args_loc (mapper.expr mapper expr));
+      let visited = ref [] in
+      let iterator =
+        {
+          Ast_iterator.default_iterator with
+          location = (fun _ loc -> visited := loc :: !visited);
+        }
+      in
+      iterator.pat iterator pat;
+      OUnit.assert_bool "iterator visits pattern argument span"
+        (List.mem pat_loc !visited);
+      visited := [];
+      iterator.expr iterator expr;
+      OUnit.assert_bool "iterator visits expression argument span"
+        (List.mem expr_loc !visited))
+    [
+      "let Pair /* pattern */ (a, b) = Pair /* expression */ (1, 2)";
+      "let Pair((a, b)) = Pair((1, 2))";
+      "let Single(a) = Single(1)";
+      "let Unit() = Unit()";
+      "let Empty = Empty";
+      "let #Pair /* pattern */ (a, b) = #Pair /* expression */ (1, 2)";
+      "let #Pair((a, b)) = #Pair((1, 2))";
+      "let #Single(a) = #Single(1)";
+      "let #Unit() = #Unit()";
+      "let #Empty = #Empty";
+    ]
+
+let test_incomplete_constructor_argument_locations _ =
+  List.iter
+    (fun source ->
+      let parsed =
+        Res_driver.parse_implementation_from_source
+          ~display_filename:"IncompleteConstructor.res" ~source
+      in
+      let args_loc =
+        match parsed.parsetree with
+        | [
+         {
+           pstr_desc =
+             Pstr_value
+               (_, [{pvb_expr = {pexp_desc = Pexp_construct (_, {loc})}}]);
+         };
+        ] ->
+          loc
+        | [
+         {
+           pstr_desc =
+             Pstr_value
+               ( _,
+                 [
+                   {
+                     pvb_expr =
+                       {
+                         pexp_desc =
+                           Pexp_fun
+                             {
+                               body =
+                                 {
+                                   pexp_desc =
+                                     Pexp_match
+                                       ( _,
+                                         [
+                                           {
+                                             pc_lhs =
+                                               {
+                                                 ppat_desc =
+                                                   Ppat_construct (_, {loc});
+                                               };
+                                           };
+                                         ] );
+                                 };
+                             };
+                       };
+                   };
+                 ] );
+         };
+        ] ->
+          loc
+        | _ -> assert_failure "Expected an incomplete constructor argument list"
+      in
+      let cursor = String.length source - 1 in
+      OUnit.assert_equal (String.index source '(') args_loc.loc_start.pos_cnum;
+      OUnit.assert_bool "recovery span includes the character before the cursor"
+        (args_loc.loc_start.pos_cnum <= cursor
+        && cursor < args_loc.loc_end.pos_cnum))
+    [
+      "let value = Pair(";
+      "let value = Pair(1,";
+      "let read = value => switch value { | Pair(";
+      "let read = value => switch value { | Pair(a,";
+    ]
+
+let test_constructor_normalization_keeps_argument_locations _ =
+  List.iter
+    (fun source ->
+      let parsed =
+        Res_driver.parse_implementation_from_source
+          ~display_filename:"NormalizedArgumentLocations.res" ~source
+      in
+      OUnit.assert_bool "source parses" (not parsed.invalid);
+      let pat, expr =
+        match (Ext_list.last parsed.parsetree).pstr_desc with
+        | Pstr_value (_, [{pvb_pat; pvb_expr}]) -> (pvb_pat, pvb_expr)
+        | _ -> assert_failure "Expected a constructor binding"
+      in
+      let expected_pat_loc =
+        match pat.ppat_desc with
+        | Ppat_construct (_, {loc}) | Ppat_variant (_, {loc}) -> loc
+        | _ -> assert_failure "Expected a constructor pattern"
+      in
+      let expected_expr_loc =
+        match expr.pexp_desc with
+        | Pexp_construct (_, {loc}) | Pexp_variant (_, {loc}) -> loc
+        | _ -> assert_failure "Expected a constructor expression"
+      in
+      let typed, _, _ =
+        Typemod.type_structure Env.initial_safe_string parsed.parsetree
+          Location.none
+      in
+      let pat, expr =
+        match (Ext_list.last typed.str_items).str_desc with
+        | Tstr_value (_, [{vb_pat; vb_expr}]) -> (vb_pat, vb_expr)
+        | _ -> assert_failure "Expected a typed constructor binding"
+      in
+      (match pat.pat_desc with
+      | Tpat_construct (_, _, [{pat_desc = Tpat_tuple [_; _]; pat_loc}])
+      | Tpat_variant (_, Some {pat_desc = Tpat_tuple [_; _]; pat_loc}, _) ->
+        OUnit.assert_equal expected_pat_loc pat_loc
+      | _ -> assert_failure "Expected a typed tuple payload pattern");
+      match expr.exp_desc with
+      | Texp_construct (_, _, [{exp_desc = Texp_tuple [_; _]; exp_loc}])
+      | Texp_variant (_, Some {exp_desc = Texp_tuple [_; _]; exp_loc}) ->
+        OUnit.assert_equal expected_expr_loc exp_loc
+      | _ -> assert_failure "Expected a typed tuple payload expression")
+    [
+      "type t = Pair((int, int))\n\
+       let Pair /* pattern */ (a, b) = Pair /* expression */ (1, 2)";
+      "let #Pair /* pattern */ (a, b) = #Pair /* expression */ (1, 2)";
+    ]
+
+let suites =
+  __FILE__
+  >::: [
+         "constructor_argument_locations" >:: test_constructor_argument_locations;
+         "constructor_normalization_keeps_argument_locations"
+         >:: test_constructor_normalization_keeps_argument_locations;
+         "incomplete_constructor_argument_locations"
+         >:: test_incomplete_constructor_argument_locations;
+       ]
diff --git a/tests/ounit_tests/ounit_jsx_loc_tests.ml b/tests/ounit_tests/ounit_jsx_loc_tests.ml
index 09f667f162..f05165d044 100644
--- a/tests/ounit_tests/ounit_jsx_loc_tests.ml
+++ b/tests/ounit_tests/ounit_jsx_loc_tests.ml
@@ -3,8 +3,8 @@ let assert_equal = OUnit.assert_equal
 let assert_failure = OUnit.assert_failure
 
 let parse_structure source =
-  Res_driver.parse_implementation_from_source ~for_printer:false
-    ~display_filename:"JsxLocTest.res" ~source
+  Res_driver.parse_implementation_from_source ~display_filename:"JsxLocTest.res"
+    ~source
   |> fun result -> result.parsetree
 
 let roundtrip_structure source =
diff --git a/tests/ounit_tests/ounit_string_literal_tests.ml b/tests/ounit_tests/ounit_string_literal_tests.ml
index a8fdb3e542..5474c0f5d7 100644
--- a/tests/ounit_tests/ounit_string_literal_tests.ml
+++ b/tests/ounit_tests/ounit_string_literal_tests.ml
@@ -22,7 +22,7 @@ let assert_encoded ~semantic ~expected =
 let assert_invalid_backquoted_pattern encoded =
   let source = "let f = value => switch value { | `" ^ encoded ^ "` => 1 }" in
   let result =
-    Res_driver.parse_implementation_from_source ~for_printer:false
+    Res_driver.parse_implementation_from_source
       ~display_filename:"StringLiteralTest.res" ~source
   in
   OUnit.assert_bool "expected an invalid string escape" result.invalid
@@ -35,7 +35,7 @@ let f = value => switch value { | `\uD800` => 1 }
 |}
   in
   let result =
-    Res_driver.parse_implementation_from_source ~for_printer:false
+    Res_driver.parse_implementation_from_source
       ~display_filename:"StringLiteralTest.res" ~source
   in
   OUnit.assert_equal ~printer:string_of_int 2 (List.length result.diagnostics)
@@ -45,14 +45,14 @@ let assert_invalid_tagged_template_pattern tag =
     "let f = value => switch value { | " ^ tag ^ "`literal` => 1 }"
   in
   let result =
-    Res_driver.parse_implementation_from_source ~for_printer:false
+    Res_driver.parse_implementation_from_source
       ~display_filename:"StringLiteralTest.res" ~source
   in
   OUnit.assert_bool "expected a tagged template pattern error" result.invalid
 
 let assert_invalid_string encoded =
   let result =
-    Res_driver.parse_implementation_from_source ~for_printer:false
+    Res_driver.parse_implementation_from_source
       ~display_filename:"StringLiteralTest.res"
       ~source:("let value = \"" ^ encoded ^ "\"")
   in
@@ -60,7 +60,7 @@ let assert_invalid_string encoded =
 
 let assert_invalid_template_expression source =
   let result =
-    Res_driver.parse_implementation_from_source ~for_printer:false
+    Res_driver.parse_implementation_from_source
       ~display_filename:"StringLiteralTest.res"
       ~source:("let value = `" ^ source ^ "`")
   in
@@ -68,7 +68,7 @@ let assert_invalid_template_expression source =
 
 let assert_parsed_string ~source ~expected_semantic =
   let result =
-    Res_driver.parse_implementation_from_source ~for_printer:false
+    Res_driver.parse_implementation_from_source
       ~display_filename:"StringLiteralTest.res"
       ~source:("let value = \"" ^ source ^ "\"")
   in
@@ -89,7 +89,7 @@ let assert_parsed_string ~source ~expected_semantic =
 let assert_invalid_utf8_after_diagnostic () =
   let source = "let x = (1,\nlet value = \"bad " ^ "\xff" ^ " byte\"" in
   let result =
-    Res_driver.parse_implementation_from_source ~for_printer:false
+    Res_driver.parse_implementation_from_source
       ~display_filename:"StringLiteralTest.res" ~source
   in
   OUnit.assert_equal ~printer:string_of_int 2 (List.length result.diagnostics);
@@ -99,9 +99,9 @@ let assert_invalid_utf8_after_diagnostic () =
          Res_diagnostics.explain diagnostic = "Invalid code point")
        result.diagnostics)
 
-let assert_parsed_char ~for_printer ~source ~expected_semantic =
+let assert_parsed_char ~source ~expected_semantic =
   let result =
-    Res_driver.parse_implementation_from_source ~for_printer
+    Res_driver.parse_implementation_from_source
       ~display_filename:"StringLiteralTest.res"
       ~source:("let value = '" ^ source ^ "'")
   in
@@ -129,7 +129,7 @@ let assert_parsed_char ~for_printer ~source ~expected_semantic =
 
 let assert_parsed_template_literal ~source =
   let result =
-    Res_driver.parse_implementation_from_source ~for_printer:false
+    Res_driver.parse_implementation_from_source
       ~display_filename:"StringLiteralTest.res"
       ~source:("let value = `" ^ source ^ "`")
   in
@@ -156,7 +156,7 @@ let assert_parsed_template_literal ~source =
 
 let assert_parsed_template_pattern ~source ~expected_semantic =
   let result =
-    Res_driver.parse_implementation_from_source ~for_printer:false
+    Res_driver.parse_implementation_from_source
       ~display_filename:"StringLiteralTest.res"
       ~source:("let f = value => switch value { | `" ^ source ^ "` => 1 }")
   in
@@ -188,7 +188,7 @@ let assert_parsed_template_pattern ~source ~expected_semantic =
 
 let assert_parsed_template () =
   let result =
-    Res_driver.parse_implementation_from_source ~for_printer:false
+    Res_driver.parse_implementation_from_source
       ~display_filename:"StringLiteralTest.res"
       ~source:"let value = `head\\n${item}tail`"
   in
@@ -227,7 +227,7 @@ let assert_tagged_template_location () =
   let prefix = "let value = " in
   let source = prefix ^ "tag`head${item}tail`" in
   let result =
-    Res_driver.parse_implementation_from_source ~for_printer:false
+    Res_driver.parse_implementation_from_source
       ~display_filename:"StringLiteralTest.res" ~source
   in
   match result.parsetree with
@@ -246,7 +246,7 @@ let assert_tagged_template_location () =
 
 let assert_invalid_json_interpolation () =
   let result =
-    Res_driver.parse_implementation_from_source ~for_printer:false
+    Res_driver.parse_implementation_from_source
       ~display_filename:"StringLiteralTest.res"
       ~source:{|let value = json`head${item}tail`|}
   in
@@ -485,10 +485,7 @@ let suites =
          ( "invalid backquoted pattern after an earlier diagnostic" >:: fun _ ->
            assert_invalid_backquoted_pattern_after_diagnostic () );
          ( "character literals retain source and semantic forms" >:: fun _ ->
-           assert_parsed_char ~for_printer:false ~source:{|\u{61}|}
-             ~expected_semantic:0x61;
-           assert_parsed_char ~for_printer:true ~source:{|\u{61}|}
-             ~expected_semantic:0x61;
+           assert_parsed_char ~source:{|\u{61}|} ~expected_semantic:0x61;
            OUnit.assert_equal ~printer:(Printf.sprintf "%S") {e|\x00|e}
              (String_literal.encode_char_source 0x00);
            OUnit.assert_equal ~printer:(Printf.sprintf "%S") "😀"
diff --git a/tests/ounit_tests/ounit_tests_main.ml b/tests/ounit_tests/ounit_tests_main.ml
index 260c75e348..a5ac0ba336 100644
--- a/tests/ounit_tests/ounit_tests_main.ml
+++ b/tests/ounit_tests/ounit_tests_main.ml
@@ -21,6 +21,7 @@ let suites =
       Ounit_rec_check_tests.suites;
       Ounit_lambda_constant_tests.suites;
       Ounit_ast_mapper0_tests.suites;
+      Ounit_constructor_arguments_tests.suites;
       Ounit_object_mutability_tests.suites;
       Ounit_pattern_printer_tests.suites;
       Ounit_js_analyzer_tests.suites;
diff --git a/tests/syntax_tests/data/ast-mapping/ConstructorArguments.res b/tests/syntax_tests/data/ast-mapping/ConstructorArguments.res
new file mode 100644
index 0000000000..b47c22e489
--- /dev/null
+++ b/tests/syntax_tests/data/ast-mapping/ConstructorArguments.res
@@ -0,0 +1,38 @@
+type unary = Unary((int, int))
+type binary = Binary(int, int)
+
+let unary = Unary((1, 2))
+let binary = Binary(1, 2)
+
+let unaryUnparenthesized = Unary(1, 2)
+let binaryParenthesized = Binary((1, 2))
+
+let readUnaryUnparenthesized = value =>
+  switch value {
+  | Unary(x, y) => x + y
+  }
+
+let readBinaryParenthesized = value =>
+  switch value {
+  | Binary((x, y)) => x + y
+  }
+
+let readUnary = value =>
+  switch value {
+  | Unary((x, y)) => x + y
+  }
+
+let readBinary = value =>
+  switch value {
+  | Binary(x, y) => x + y
+  }
+
+type poly = [#UnaryTuple((int, int)) | #BinaryArgs(int, int)]
+
+let polyUnary: poly = #UnaryTuple((1, 2))
+let polyBinary: poly = #BinaryArgs(1, 2)
+
+let readPoly = value =>
+  switch value {
+  | #UnaryTuple((x, y)) | #BinaryArgs(x, y) => x + y
+  }
diff --git a/tests/syntax_tests/data/ast-mapping/ConstructorPayloadLocation.res b/tests/syntax_tests/data/ast-mapping/ConstructorPayloadLocation.res
new file mode 100644
index 0000000000..f90d324272
--- /dev/null
+++ b/tests/syntax_tests/data/ast-mapping/ConstructorPayloadLocation.res
@@ -0,0 +1,5 @@
+let pair = Pair /* payload */ (1, 2)
+
+let read = value => switch value {
+| Module.Pair /* payload */ (a, b) => (a, b)
+}
diff --git a/tests/syntax_tests/data/ast-mapping/PolyVariantPayloadLocation.res b/tests/syntax_tests/data/ast-mapping/PolyVariantPayloadLocation.res
new file mode 100644
index 0000000000..e09a35df31
--- /dev/null
+++ b/tests/syntax_tests/data/ast-mapping/PolyVariantPayloadLocation.res
@@ -0,0 +1,5 @@
+let pair = #Pair /* payload */ (1, 2)
+
+let read = value => switch value {
+| #"quoted label" /* payload */ (a, b) => (a, b)
+}
diff --git a/tests/syntax_tests/data/ast-mapping/expected/ConstructorArguments.res.txt b/tests/syntax_tests/data/ast-mapping/expected/ConstructorArguments.res.txt
new file mode 100644
index 0000000000..b47c22e489
--- /dev/null
+++ b/tests/syntax_tests/data/ast-mapping/expected/ConstructorArguments.res.txt
@@ -0,0 +1,38 @@
+type unary = Unary((int, int))
+type binary = Binary(int, int)
+
+let unary = Unary((1, 2))
+let binary = Binary(1, 2)
+
+let unaryUnparenthesized = Unary(1, 2)
+let binaryParenthesized = Binary((1, 2))
+
+let readUnaryUnparenthesized = value =>
+  switch value {
+  | Unary(x, y) => x + y
+  }
+
+let readBinaryParenthesized = value =>
+  switch value {
+  | Binary((x, y)) => x + y
+  }
+
+let readUnary = value =>
+  switch value {
+  | Unary((x, y)) => x + y
+  }
+
+let readBinary = value =>
+  switch value {
+  | Binary(x, y) => x + y
+  }
+
+type poly = [#UnaryTuple((int, int)) | #BinaryArgs(int, int)]
+
+let polyUnary: poly = #UnaryTuple((1, 2))
+let polyBinary: poly = #BinaryArgs(1, 2)
+
+let readPoly = value =>
+  switch value {
+  | #UnaryTuple((x, y)) | #BinaryArgs(x, y) => x + y
+  }
diff --git a/tests/syntax_tests/data/ast-mapping/expected/ConstructorPayloadLocation.res.txt b/tests/syntax_tests/data/ast-mapping/expected/ConstructorPayloadLocation.res.txt
new file mode 100644
index 0000000000..c7e17f7892
--- /dev/null
+++ b/tests/syntax_tests/data/ast-mapping/expected/ConstructorPayloadLocation.res.txt
@@ -0,0 +1,6 @@
+let pair = Pair /* payload */(1, 2)
+
+let read = value =>
+  switch value {
+  | Module.Pair /* payload */(a, b) => (a, b)
+  }
diff --git a/tests/syntax_tests/data/ast-mapping/expected/PolyVariantPayloadLocation.res.txt b/tests/syntax_tests/data/ast-mapping/expected/PolyVariantPayloadLocation.res.txt
new file mode 100644
index 0000000000..a9bd62fbdd
--- /dev/null
+++ b/tests/syntax_tests/data/ast-mapping/expected/PolyVariantPayloadLocation.res.txt
@@ -0,0 +1,6 @@
+let pair = #Pair(/* payload */ 1, 2)
+
+let read = value =>
+  switch value {
+  | #"quoted label"(/* payload */ a, b) => (a, b)
+  }
diff --git a/tests/syntax_tests/data/printer/comments/expected/polyVariant.res.txt b/tests/syntax_tests/data/printer/comments/expected/polyVariant.res.txt
new file mode 100644
index 0000000000..9942e00123
--- /dev/null
+++ b/tests/syntax_tests/data/printer/comments/expected/polyVariant.res.txt
@@ -0,0 +1,6 @@
+let value = #Pair(a, /* between */ b)
+
+let read = value =>
+  switch value {
+  | #Pair(a, /* between pattern */ b) => (a, b)
+  }
diff --git a/tests/syntax_tests/data/printer/comments/polyVariant.res b/tests/syntax_tests/data/printer/comments/polyVariant.res
new file mode 100644
index 0000000000..9942e00123
--- /dev/null
+++ b/tests/syntax_tests/data/printer/comments/polyVariant.res
@@ -0,0 +1,6 @@
+let value = #Pair(a, /* between */ b)
+
+let read = value =>
+  switch value {
+  | #Pair(a, /* between pattern */ b) => (a, b)
+  }
diff --git a/tests/syntax_tests/res_test.ml b/tests/syntax_tests/res_test.ml
index 47810416ed..2e4afd2031 100644
--- a/tests/syntax_tests/res_test.ml
+++ b/tests/syntax_tests/res_test.ml
@@ -71,10 +71,7 @@ module Outcome_printer_tests = struct
    * and stored in a snapshot `tests/oprint/expected/oprint.resi.txt` *)
   let run () =
     let filename = Filename.concat data_dir "oprint/oprint.res" in
-    let result =
-      Res_driver.parsing_engine.parse_implementation ~for_printer:false
-        ~filename
-    in
+    let result = Res_driver.parsing_engine.parse_implementation ~filename in
     let signature =
       if result.Res_driver.invalid then (
         Res_driver.parsing_engine.string_of_diagnostics ~source:result.source
diff --git a/tests/tests/src/constructor_arguments.mjs b/tests/tests/src/constructor_arguments.mjs
new file mode 100644
index 0000000000..6c74dbf055
--- /dev/null
+++ b/tests/tests/src/constructor_arguments.mjs
@@ -0,0 +1,98 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+
+function readUnary(value) {
+  let match = value._0;
+  return match[0] + match[1] | 0;
+}
+
+function readBinary(value) {
+  return value._0 + value._1 | 0;
+}
+
+function readUnaryUnparenthesized(value) {
+  let match = value._0;
+  return match[0] + match[1] | 0;
+}
+
+function readBinaryParenthesized(value) {
+  return value._0 + value._1 | 0;
+}
+
+function readOptionUnparenthesized(value) {
+  if (value !== undefined) {
+    return value[0] + value[1] | 0;
+  } else {
+    return 0;
+  }
+}
+
+function readPoly(value) {
+  return value.VAL[0] + value.VAL[1] | 0;
+}
+
+let unary = {
+  TAG: "Unary",
+  _0: [
+    1,
+    2
+  ]
+};
+
+let binary = {
+  TAG: "Binary",
+  _0: 1,
+  _1: 2
+};
+
+let unaryUnparenthesized = {
+  TAG: "Unary",
+  _0: [
+    1,
+    2
+  ]
+};
+
+let binaryParenthesized = {
+  TAG: "Binary",
+  _0: 1,
+  _1: 2
+};
+
+let optionUnparenthesized = [
+  1,
+  2
+];
+
+let polyUnary = {
+  NAME: "UnaryTuple",
+  VAL: [
+    1,
+    2
+  ]
+};
+
+let polyBinary = {
+  NAME: "BinaryArgs",
+  VAL: [
+    1,
+    2
+  ]
+};
+
+export {
+  unary,
+  binary,
+  unaryUnparenthesized,
+  binaryParenthesized,
+  optionUnparenthesized,
+  readUnary,
+  readBinary,
+  readUnaryUnparenthesized,
+  readBinaryParenthesized,
+  readOptionUnparenthesized,
+  polyUnary,
+  polyBinary,
+  readPoly,
+}
+/* No side effect */
diff --git a/tests/tests/src/constructor_arguments.res b/tests/tests/src/constructor_arguments.res
new file mode 100644
index 0000000000..c783421b2c
--- /dev/null
+++ b/tests/tests/src/constructor_arguments.res
@@ -0,0 +1,45 @@
+type unary = Unary((int, int))
+type binary = Binary(int, int)
+
+let unary = Unary((1, 2))
+let binary = Binary(1, 2)
+
+let unaryUnparenthesized = Unary(1, 2)
+let binaryParenthesized = Binary((1, 2))
+let optionUnparenthesized = Some(1, 2)
+
+let readUnary = value =>
+  switch value {
+  | Unary((x, y)) => x + y
+  }
+
+let readBinary = value =>
+  switch value {
+  | Binary(x, y) => x + y
+  }
+
+let readUnaryUnparenthesized = value =>
+  switch value {
+  | Unary(x, y) => x + y
+  }
+
+let readBinaryParenthesized = value =>
+  switch value {
+  | Binary((x, y)) => x + y
+  }
+
+let readOptionUnparenthesized = value =>
+  switch value {
+  | Some(x, y) => x + y
+  | None => 0
+  }
+
+type poly = [#UnaryTuple((int, int)) | #BinaryArgs(int, int)]
+
+let polyUnary: poly = #UnaryTuple((1, 2))
+let polyBinary: poly = #BinaryArgs(1, 2)
+
+let readPoly = value =>
+  switch value {
+  | #UnaryTuple((x, y)) | #BinaryArgs(x, y) => x + y
+  }
diff --git a/tests/tests/src/constructor_payload_compatibility_test.mjs b/tests/tests/src/constructor_payload_compatibility_test.mjs
new file mode 100644
index 0000000000..f0512a15f6
--- /dev/null
+++ b/tests/tests/src/constructor_payload_compatibility_test.mjs
@@ -0,0 +1,29 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as Mocha from "mocha";
+import * as Test_utils from "./test_utils.mjs";
+import * as Constructor_arguments from "./constructor_arguments.mjs";
+
+Mocha.describe("constructor payload compatibility", () => {
+  Mocha.test("accepts both unary tuple spellings", () => {
+    Test_utils.eq("File \"constructor_payload_compatibility_test.res\", line 7, characters 7-14", Constructor_arguments.readUnary(Constructor_arguments.unary), 3);
+    Test_utils.eq("File \"constructor_payload_compatibility_test.res\", line 8, characters 7-14", Constructor_arguments.readUnary(Constructor_arguments.unaryUnparenthesized), 3);
+    Test_utils.eq("File \"constructor_payload_compatibility_test.res\", line 9, characters 7-14", Constructor_arguments.readUnaryUnparenthesized(Constructor_arguments.unary), 3);
+    Test_utils.eq("File \"constructor_payload_compatibility_test.res\", line 10, characters 7-14", Constructor_arguments.readUnaryUnparenthesized(Constructor_arguments.unaryUnparenthesized), 3);
+  });
+  Mocha.test("accepts both binary constructor spellings", () => {
+    Test_utils.eq("File \"constructor_payload_compatibility_test.res\", line 13, characters 7-14", Constructor_arguments.readBinary(Constructor_arguments.binary), 3);
+    Test_utils.eq("File \"constructor_payload_compatibility_test.res\", line 14, characters 7-14", Constructor_arguments.readBinary(Constructor_arguments.binaryParenthesized), 3);
+    Test_utils.eq("File \"constructor_payload_compatibility_test.res\", line 15, characters 7-14", Constructor_arguments.readBinaryParenthesized(Constructor_arguments.binary), 3);
+    Test_utils.eq("File \"constructor_payload_compatibility_test.res\", line 16, characters 7-14", Constructor_arguments.readBinaryParenthesized(Constructor_arguments.binaryParenthesized), 3);
+  });
+  Mocha.test("accepts unparenthesized option tuple payloads", () => {
+    Test_utils.eq("File \"constructor_payload_compatibility_test.res\", line 19, characters 7-14", Constructor_arguments.readOptionUnparenthesized(Constructor_arguments.optionUnparenthesized), 3);
+    Test_utils.eq("File \"constructor_payload_compatibility_test.res\", line 20, characters 7-14", Constructor_arguments.readOptionUnparenthesized([
+      1,
+      2
+    ]), 3);
+  });
+});
+
+/*  Not a pure module */
diff --git a/tests/tests/src/constructor_payload_compatibility_test.res b/tests/tests/src/constructor_payload_compatibility_test.res
new file mode 100644
index 0000000000..5a1aa49467
--- /dev/null
+++ b/tests/tests/src/constructor_payload_compatibility_test.res
@@ -0,0 +1,22 @@
+open Mocha
+open Test_utils
+open Constructor_arguments
+
+describe("constructor payload compatibility", () => {
+  test("accepts both unary tuple spellings", () => {
+    eq(__LOC__, readUnary(unary), 3)
+    eq(__LOC__, readUnary(unaryUnparenthesized), 3)
+    eq(__LOC__, readUnaryUnparenthesized(unary), 3)
+    eq(__LOC__, readUnaryUnparenthesized(unaryUnparenthesized), 3)
+  })
+  test("accepts both binary constructor spellings", () => {
+    eq(__LOC__, readBinary(binary), 3)
+    eq(__LOC__, readBinary(binaryParenthesized), 3)
+    eq(__LOC__, readBinaryParenthesized(binary), 3)
+    eq(__LOC__, readBinaryParenthesized(binaryParenthesized), 3)
+  })
+  test("accepts unparenthesized option tuple payloads", () => {
+    eq(__LOC__, readOptionUnparenthesized(optionUnparenthesized), 3)
+    eq(__LOC__, readOptionUnparenthesized(Some((1, 2))), 3)
+  })
+})
diff --git a/tests/tests/src/tramp_fib.mjs b/tests/tests/src/tramp_fib.mjs
index 67c841d559..5dd085d7b2 100644
--- a/tests/tests/src/tramp_fib.mjs
+++ b/tests/tests/src/tramp_fib.mjs
@@ -70,8 +70,8 @@ function isOdd(n) {
 }
 
 Mocha.describe("Tramp_fib", () => {
-  Mocha.test("fibonacci trampoline", () => Test_utils.eq("File \"tramp_fib.res\", line 55, characters 7-14", iter(u), 89));
-  Mocha.test("even/odd trampoline", () => Test_utils.eq("File \"tramp_fib.res\", line 59, characters 7-14", iter(isEven(20000)), true));
+  Mocha.test("fibonacci trampoline", () => Test_utils.eq("File \"tramp_fib.res\", line 54, characters 7-14", iter(u), 89));
+  Mocha.test("even/odd trampoline", () => Test_utils.eq("File \"tramp_fib.res\", line 58, characters 7-14", iter(isEven(20000)), true));
 });
 
 export {
diff --git a/tests/tests/src/tramp_fib.res b/tests/tests/src/tramp_fib.res
index 452c070470..f3a6d06ec3 100644
--- a/tests/tests/src/tramp_fib.res
+++ b/tests/tests/src/tramp_fib.res
@@ -16,14 +16,13 @@ let rec fib = (n, k) =>
     k(1)
   | _ =>
     Suspend(
-      () =>
-        fib(n - 1, v0 => fib(n - 2, v1 => k(v0 + v1))),
-        /* match v0,v1 with
-         | Continue v0, Continue v1 -> */
-        /* k (Continue (v0 + v1)) [@bs] */
-        /* Suspend (fun [@bs]() -> k (Continue (v0 + v1)) [@bs]) */
-        /* | _ -> assert false */
-        /* FIXME: this branch completly gone */
+      () => fib(n - 1, v0 => fib(n - 2, v1 => k(v0 + v1))),
+      /* match v0,v1 with
+       | Continue v0, Continue v1 -> */
+      /* k (Continue (v0 + v1)) [@bs] */
+      /* Suspend (fun [@bs]() -> k (Continue (v0 + v1)) [@bs]) */
+      /* | _ -> assert false */
+      /* FIXME: this branch completly gone */
     )
   }
 
diff --git a/tools/src/migrate.ml b/tools/src/migrate.ml
index bbb88c286b..8aea503f08 100644
--- a/tools/src/migrate.ml
+++ b/tools/src/migrate.ml
@@ -8,7 +8,7 @@ module Int_set = Set.Make (Int)
 
 let is_unit_expr (e : Parsetree.expression) =
   match e.pexp_desc with
-  | Pexp_construct ({txt = Lident "()"}, None) -> true
+  | Pexp_construct ({txt = Lident "()"}, {txt = []}) -> true
   | _ -> false
 
 module Insert_ext = struct
@@ -54,7 +54,7 @@ module Expr_utils = struct
     match e.pexp_desc with
     | Pexp_apply {funct = {pexp_desc = Pexp_ident {txt = Lident "->"}}; _} ->
       true
-    | Pexp_construct (_, Some e)
+    | Pexp_construct (_, {txt = [e]})
     | Pexp_constraint (e, _)
     | Pexp_coerce (e, _, _)
     | Pexp_let (_, _, e)
@@ -677,7 +677,12 @@ let make_mapper (deprecated_used : Cmt_utils.deprecated_used list) =
           | {pexp_desc = Pexp_construct (lid, arg); pexp_loc} -> (
             match find_constructor_target ~loc:pexp_loc ~lid_loc:lid.loc with
             | Some {Constructor_replace.lid; attrs} ->
-              let arg = Option.map (mapper.expr mapper) arg in
+              let arg =
+                {
+                  Location.txt = List.map (mapper.expr mapper) arg.txt;
+                  loc = mapper.location mapper arg.loc;
+                }
+              in
               let replaced = {exp with pexp_desc = Pexp_construct (lid, arg)} in
               Mapper_utils.Apply_transforms.attach_to_replacement ~attrs
                 replaced
@@ -723,7 +728,12 @@ let make_mapper (deprecated_used : Cmt_utils.deprecated_used list) =
           | {ppat_desc = Ppat_construct (lid, arg); ppat_loc} -> (
             match find_constructor_target ~loc:ppat_loc ~lid_loc:lid.loc with
             | Some {Constructor_replace.lid; attrs} ->
-              let arg = Option.map (mapper.pat mapper) arg in
+              let arg =
+                {
+                  Location.txt = List.map (mapper.pat mapper) arg.txt;
+                  loc = mapper.location mapper arg.loc;
+                }
+              in
               let replaced = {pat with ppat_desc = Ppat_construct (lid, arg)} in
               Mapper_utils.Apply_transforms.attach_attrs_to_pat ~attrs replaced
             | None -> Ast_mapper.default_mapper.pat mapper pat)
@@ -741,9 +751,7 @@ let migrate ~entry_point_file ~output_mode =
   let state = Shared_types.create_state () in
   let result =
     if Filename.check_suffix path ".res" then
-      let parser =
-        Res_driver.parsing_engine.parse_implementation ~for_printer:true
-      in
+      let parser = Res_driver.parsing_engine.parse_implementation in
       let {Res_driver.parsetree; comments; source} = parser ~filename:path in
       match Cmt.load_cmt_infos_from_path ~state ~path with
       | None ->
@@ -771,9 +779,7 @@ let migrate ~entry_point_file ~output_mode =
               ~width:Res_printer.default_print_width ast_transformed ~comments,
             source )
     else if Filename.check_suffix path ".resi" then
-      let parser =
-        Res_driver.parsing_engine.parse_interface ~for_printer:true
-      in
+      let parser = Res_driver.parsing_engine.parse_interface in
       let {Res_driver.parsetree = signature; comments; source} =
         parser ~filename:path
       in
diff --git a/tools/src/tools.ml b/tools/src/tools.ml
index 3ae00bff14..3cf3d052dd 100644
--- a/tools/src/tools.ml
+++ b/tools/src/tools.ml
@@ -623,7 +623,7 @@ let extract_docs ~entry_point_file ~debug =
 
 let extract_embedded ~extension_points ~filename =
   let {Res_driver.parsetree = structure} =
-    Res_driver.parsing_engine.parse_implementation ~for_printer:false ~filename
+    Res_driver.parsing_engine.parse_implementation ~filename
   in
   let content = ref [] in
   let append item = content := item :: !content in
@@ -801,8 +801,8 @@ module Format_codeblocks = struct
           let formatted_code =
             if lang |> String.split_on_char ' ' |> List.hd = "resi" then
               let {Res_driver.parsetree; comments; invalid; diagnostics} =
-                Res_driver.parse_interface_from_source ~for_printer:true
-                  ~display_filename ~source:code_with_offset
+                Res_driver.parse_interface_from_source ~display_filename
+                  ~source:code_with_offset
               in
               if invalid then (
                 report_parse_error diagnostics;
@@ -812,8 +812,8 @@ module Format_codeblocks = struct
                 |> String.trim |> Cmarkit.Block_line.list_of_string
             else
               let {Res_driver.parsetree; comments; invalid; diagnostics} =
-                Res_driver.parse_implementation_from_source ~for_printer:true
-                  ~display_filename ~source:code_with_offset
+                Res_driver.parse_implementation_from_source ~display_filename
+                  ~source:code_with_offset
               in
               if invalid then (
                 report_parse_error diagnostics;
@@ -898,9 +898,7 @@ module Format_codeblocks = struct
           Ok (formatted_contents, content)
         else Ok (content, content)
       else if Filename.check_suffix path ".res" then
-        let parser =
-          Res_driver.parsing_engine.parse_implementation ~for_printer:true
-        in
+        let parser = Res_driver.parsing_engine.parse_implementation in
         let {Res_driver.parsetree = structure; comments; source; filename} =
           parser ~filename:path
         in
@@ -911,9 +909,7 @@ module Format_codeblocks = struct
         let ast_mapped = mapper.structure mapper structure in
         Ok (Res_printer.print_implementation ast_mapped ~comments, source)
       else if Filename.check_suffix path ".resi" then
-        let parser =
-          Res_driver.parsing_engine.parse_interface ~for_printer:true
-        in
+        let parser = Res_driver.parsing_engine.parse_interface in
         let {Res_driver.parsetree = signature; comments; source; filename} =
           parser ~filename:path
         in
@@ -1157,8 +1153,8 @@ module Extract_codeblocks = struct
           let mapped_code =
             if lang |> String.split_on_char ' ' |> List.hd = "resi" then
               let {Res_driver.parsetree; comments; invalid; diagnostics} =
-                Res_driver.parse_interface_from_source ~for_printer:true
-                  ~display_filename ~source:code_with_offset
+                Res_driver.parse_interface_from_source ~display_filename
+                  ~source:code_with_offset
               in
               if invalid then (
                 report_parse_error diagnostics;
@@ -1167,8 +1163,8 @@ module Extract_codeblocks = struct
                 Res_printer.print_interface parsetree ~comments |> String.trim
             else
               let {Res_driver.parsetree; comments; invalid; diagnostics} =
-                Res_driver.parse_implementation_from_source ~for_printer:true
-                  ~display_filename ~source:code_with_offset
+                Res_driver.parse_implementation_from_source ~display_filename
+                  ~source:code_with_offset
               in
               if invalid then (
                 report_parse_error diagnostics;
diff --git a/tools/src/transforms.ml b/tools/src/transforms.ml
index da3e07f94a..087927500f 100644
--- a/tools/src/transforms.ml
+++ b/tools/src/transforms.ml
@@ -42,7 +42,7 @@ let drop_unit_arguments_in_apply (e : Parsetree.expression) :
   (* Drop only unlabelled unit arguments from an application expression. *)
   let is_unit_expr (e : Parsetree.expression) =
     match e.pexp_desc with
-    | Pexp_construct ({txt = Lident "()"}, None) -> true
+    | Pexp_construct ({txt = Lident "()"}, {txt = []}) -> true
     | _ -> false
   in
   match e.pexp_desc with