diff --git a/lib/Ast.ml b/lib/Ast.ml
index 9500c173d3..6ec4765d66 100644
--- a/lib/Ast.ml
+++ b/lib/Ast.ml
@@ -960,7 +960,8 @@ end = struct
       | Ptyp_alias (t1, _) | Ptyp_poly (_, t1) -> assert (typ == t1)
       | Ptyp_arrow (t, t2) ->
           assert (List.exists t ~f:(fun x -> typ == x.pap_type) || typ == t2)
-      | Ptyp_tuple t1N | Ptyp_constr (_, t1N) -> assert (List.exists t1N ~f)
+      | Ptyp_tuple t1N -> assert (List.exists t1N ~f:(fun (_, t) -> f t))
+      | Ptyp_constr (_, t1N) -> assert (List.exists t1N ~f)
       | Ptyp_variant (r1N, _, _) ->
           assert (
             List.exists r1N ~f:(function
@@ -1317,8 +1318,10 @@ end = struct
         Pat.maybe_extension ctx check_extension
         @@ fun () ->
         match ctx.ppat_desc with
-        | Ppat_array p1N | Ppat_list p1N | Ppat_tuple p1N | Ppat_cons p1N ->
+        | Ppat_array p1N | Ppat_list p1N | Ppat_cons p1N ->
             assert (List.exists p1N ~f)
+        | Ppat_tuple (p1N, _) ->
+            assert (List.exists p1N ~f:(fun (_, p) -> f p))
         | Ppat_record (p1N, _) ->
             assert (List.exists p1N ~f:(fun (_, _, x) -> Option.exists x ~f))
         | Ppat_or l -> assert (List.exists ~f:(fun p -> p == pat) l)
@@ -1484,7 +1487,8 @@ end = struct
         | Pexp_apply (e0, e1N) ->
             (* FAIL *)
             assert (e0 == exp || List.exists e1N ~f:snd_f)
-        | Pexp_tuple e1N | Pexp_array e1N | Pexp_list e1N | Pexp_cons e1N ->
+        | Pexp_tuple e1N -> assert (List.exists e1N ~f:(fun (_, e) -> f e))
+        | Pexp_array e1N | Pexp_list e1N | Pexp_cons e1N ->
             assert (List.exists e1N ~f)
         | Pexp_construct (_, e) | Pexp_variant (_, e) ->
             assert (Option.exists e ~f)
@@ -1609,8 +1613,11 @@ end = struct
         && fit_margin c (width xexp)
     | Pexp_construct (_, Some e0) | Pexp_variant (_, Some e0) ->
         Exp.is_trivial e0
-    | Pexp_array e1N | Pexp_list e1N | Pexp_tuple e1N ->
+    | Pexp_array e1N | Pexp_list e1N ->
         List.for_all e1N ~f:Exp.is_trivial && fit_margin c (width xexp)
+    | Pexp_tuple e1N ->
+        List.for_all e1N ~f:(fun (_, e) -> Exp.is_trivial e)
+        && fit_margin c (width xexp)
     | Pexp_record (e1N, e0) ->
         Option.for_all e0 ~f:Exp.is_trivial
         && List.for_all e1N ~f:(fun (_, c, eo) ->
@@ -1731,8 +1738,19 @@ end = struct
         Exp.maybe_extension ctx prec_ctx_extension
         @@ fun () ->
         match pexp_desc with
-        | Pexp_tuple (e0 :: _) ->
-            Some (Comma, if exp == e0 then Left else Right)
+        | Pexp_tuple ((_, e0) :: _ as exps) ->
+            (* Jane Street: Here we pretend tuple elements with labels have
+               the same precedence as function arguments, because they need
+               to be parenthesized in the same cases. *)
+            let lr = if exp == e0 then Left else Right in
+            let prec =
+              List.find_map exps ~f:(fun (l, e) ->
+                  if exp == e then
+                    match l with Some _ -> Some Apply | None -> Some Comma
+                  else None )
+            in
+            let prec = match prec with Some p -> p | None -> Comma in
+            Some (prec, lr)
         | Pexp_cons l ->
             Some (ColonColon, if exp == List.last_exn l then Right else Left)
         | Pexp_construct
@@ -1953,6 +1971,10 @@ end = struct
         true
     | {ast= {ptyp_desc= Ptyp_var (_, l); _}; ctx= _} when Option.is_some l ->
         true
+    | { ast= {ptyp_desc= Ptyp_tuple ((Some _, _) :: _); _}
+      ; ctx= Typ {ptyp_desc= Ptyp_arrow (args, _); _} }
+      when List.exists args ~f:(fun arg -> arg.pap_type == typ) ->
+        true
     | _ -> (
       match ambig_prec (sub_ast ~ctx (Typ typ)) with
       | `Ambiguous -> true
@@ -2171,7 +2193,7 @@ end = struct
           when match cls with Then -> true | _ -> false ->
             true
         | Pexp_apply (_, args) -> continue (snd (List.last_exn args))
-        | Pexp_tuple es -> continue (List.last_exn es)
+        | Pexp_tuple es -> continue (snd (List.last_exn es))
         | Pexp_array _ | Pexp_list _ | Pexp_coerce _ | Pexp_constant _
          |Pexp_constraint _
          |Pexp_construct (_, None)
@@ -2260,7 +2282,7 @@ end = struct
       | Pexp_indexop_access {pia_rhs= rhs; _} -> (
         match rhs with Some e -> continue e | None -> false )
       | Pexp_apply (_, args) -> continue (snd (List.last_exn args))
-      | Pexp_tuple es -> continue (List.last_exn es)
+      | Pexp_tuple es -> continue (snd (List.last_exn es))
       | Pexp_array _ | Pexp_list _ | Pexp_coerce _ | Pexp_constant _
        |Pexp_constraint _
        |Pexp_construct (_, None)
@@ -2286,7 +2308,7 @@ end = struct
                && Option.value_map ~default:false (prec_ast ctx) ~f:(fun p ->
                       Prec.compare p Apply < 0 ) ->
             true
-        | Pexp_tuple e1N -> List.last_exn e1N == xexp.ast
+        | Pexp_tuple e1N -> snd (List.last_exn e1N) == xexp.ast
         | _ -> false
       in
       match ambig_prec (sub_ast ~ctx (Exp exp)) with
diff --git a/lib/Exposed.ml b/lib/Exposed.ml
index 60cba319f9..48078e9f33 100644
--- a/lib/Exposed.ml
+++ b/lib/Exposed.ml
@@ -15,7 +15,10 @@ module Left = struct
   let rec core_type typ =
     match typ.ptyp_desc with
     | Ptyp_arrow (t :: _, _) -> core_type t.pap_type
-    | Ptyp_tuple l -> core_type (List.hd_exn l)
+    | Ptyp_tuple l -> (
+      match List.hd_exn l with
+      | Some _, _ -> false
+      | None, typ -> core_type typ )
     | Ptyp_object _ -> true
     | Ptyp_alias (typ, _) -> core_type typ
     | _ -> false
@@ -29,7 +32,10 @@ module Right = struct
     | {ptyp_desc; _} -> (
       match ptyp_desc with
       | Ptyp_arrow (_, t) -> core_type t
-      | Ptyp_tuple l -> core_type (List.last_exn l)
+      | Ptyp_tuple l -> (
+        match List.last_exn l with
+        | Some _, _ -> false
+        | None, typ -> core_type typ )
       | Ptyp_object _ -> true
       | _ -> false )
 
diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index 774ab73f56..43c8e026e7 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -934,7 +934,9 @@ and fmt_core_type c ?(box = true) ?pro ?(pro_space = true) ?constraint_ctx
       hvbox 0
         (wrap_if parenze_constraint_ctx "(" ")"
            (wrap_fits_breaks_if ~space:false c.conf parens "(" ")"
-              (list typs "@ * " (sub_typ ~ctx >> fmt_core_type c)) ) )
+              (list typs "@ * " (fun (lbl, typ) ->
+                   let typ = sub_typ ~ctx typ in
+                   fmt_labeled_tuple_type c lbl typ ) ) ) )
   | Ptyp_var s -> fmt_type_var ~have_tick:true c s
   | Ptyp_variant (rfs, flag, lbls) ->
       let row_fields rfs =
@@ -1031,6 +1033,12 @@ and fmt_core_type c ?(box = true) ?pro ?(pro_space = true) ?constraint_ctx
            (sub_typ ~ctx >> fmt_core_type c) )
       $ fmt "@ " $ fmt_longident_loc c lid $ char '#'
 
+and fmt_labeled_tuple_type c lbl xtyp =
+  match lbl with
+  | None -> fmt_core_type c xtyp
+  | Some s ->
+      hvbox 0 (Cmts.fmt c s.loc (str s.txt) $ str ":" $ fmt_core_type c xtyp)
+
 and fmt_package_type c ctx cnstrs =
   let fmt_cstr ~first ~last:_ (lid, typ) =
     fmt_or first "@;<1 0>" "@;<1 1>"
@@ -1126,14 +1134,48 @@ and fmt_pattern ?ext c ?pro ?parens ?(box = false)
                      "( " " )" (str txt) ) ) ) )
   | Ppat_constant const -> fmt_constant c const
   | Ppat_interval (l, u) -> fmt_constant c l $ str " .. " $ fmt_constant c u
-  | Ppat_tuple pats ->
+  | Ppat_tuple (pats, oc) ->
       let parens =
         parens || Poly.(c.conf.fmt_opts.parens_tuple_patterns.v = `Always)
       in
+      let fmt_lt_pat_element (lbl, pat) =
+        let pat = sub_pat ~ctx pat in
+        match lbl with
+        | None -> fmt_pattern c pat
+        | Some lbl ->
+            let punned =
+              match pat.ast.ppat_desc with
+              | Ppat_var var ->
+                  String.equal var.txt lbl.txt
+                  && List.is_empty pat.ast.ppat_attributes
+              | _ -> false
+            in
+            let punned_with_constraint =
+              match pat.ast.ppat_desc with
+              | Ppat_constraint ({ppat_desc= Ppat_var var; _}, _) ->
+                  String.equal var.txt lbl.txt
+                  && List.is_empty pat.ast.ppat_attributes
+              | _ -> false
+            in
+            if punned then
+              Cmts.fmt c lbl.loc
+              @@ Cmts.fmt c pat.ast.ppat_loc
+              @@ hovbox 0 (str "~" $ str lbl.txt)
+            else if punned_with_constraint then
+              Cmts.fmt c lbl.loc @@ (str "~" $ fmt_pattern c pat)
+            else str "~" $ str lbl.txt $ str ":" $ fmt_pattern c pat
+      in
+      let fmt_elements =
+        list pats (Params.comma_sep c.conf) fmt_lt_pat_element
+      in
+      let fmt_oc =
+        match oc with
+        | Closed -> noop
+        | Open -> fmt (Params.comma_sep c.conf) $ str ".."
+      in
       hvbox 0
         (Params.wrap_tuple ~parens ~no_parens_if_break:false c.conf
-           (list pats (Params.comma_sep c.conf)
-              (sub_pat ~ctx >> fmt_pattern c) ) )
+           (fmt_elements $ fmt_oc) )
   | Ppat_construct ({txt= Lident (("()" | "[]") as txt); loc}, None) ->
       let opn = txt.[0] and cls = txt.[1] in
       Cmts.fmt c loc
@@ -2768,14 +2810,41 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
       in
       let outer_wrap = has_attr && parens in
       let inner_wrap = has_attr || parens in
+      let fmt_lt_exp_element (lbl, exp) =
+        let exp = sub_exp ~ctx exp in
+        match lbl with
+        | None -> fmt_expression c exp
+        | Some lbl ->
+            let punned =
+              match exp.ast.pexp_desc with
+              | Pexp_ident {txt= Lident var; _} ->
+                  String.equal lbl.txt var
+                  && List.is_empty exp.ast.pexp_attributes
+              | _ -> false
+            in
+            let punned_with_constraint =
+              match exp.ast.pexp_desc with
+              | Pexp_constraint
+                  ({pexp_desc= Pexp_ident {txt= Lident var; _}; _}, _) ->
+                  String.equal var lbl.txt
+                  && List.is_empty exp.ast.pexp_attributes
+              | _ -> false
+            in
+            if punned then
+              Cmts.fmt c lbl.loc
+              @@ Cmts.fmt c exp.ast.pexp_loc
+              @@ hovbox 0 (str "~" $ str lbl.txt)
+            else if punned_with_constraint then
+              Cmts.fmt c lbl.loc @@ (str "~" $ fmt_expression c exp)
+            else str "~" $ str lbl.txt $ str ":" $ fmt_expression c exp
+      in
       pro
       $ hvbox_if outer_wrap 0
           (Params.parens_if outer_wrap c.conf
              ( hvbox 0
                  (Params.wrap_tuple ~parens:inner_wrap ~no_parens_if_break
                     c.conf
-                    (list es (Params.comma_sep c.conf)
-                       (sub_exp ~ctx >> fmt_expression c) ) )
+                    (list es (Params.comma_sep c.conf) fmt_lt_exp_element) )
              $ fmt_atrs ) )
   | Pexp_lazy e ->
       pro
diff --git a/test/passing/dune.inc b/test/passing/dune.inc
index 3beda3fa42..24096b1ca0 100644
--- a/test/passing/dune.inc
+++ b/test/passing/dune.inc
@@ -3356,6 +3356,78 @@
  (package ocamlformat)
  (action (diff tests/label_option_default_args.ml.err label_option_default_args.ml.stderr)))
 
+(rule
+ (deps tests/.ocamlformat )
+ (package ocamlformat)
+ (action
+  (with-stdout-to labeled_tuple_patterns.ml.stdout
+   (with-stderr-to labeled_tuple_patterns.ml.stderr
+     (run %{bin:ocamlformat} --margin-check --profile=janestreet --max-iters=3 %{dep:tests/labeled_tuple_patterns.ml})))))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/labeled_tuple_patterns.ml labeled_tuple_patterns.ml.stdout)))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/labeled_tuple_patterns.ml.err labeled_tuple_patterns.ml.stderr)))
+
+(rule
+ (deps tests/.ocamlformat )
+ (package ocamlformat)
+ (action
+  (with-stdout-to labeled_tuples.ml.stdout
+   (with-stderr-to labeled_tuples.ml.stderr
+     (run %{bin:ocamlformat} --margin-check --profile=janestreet --max-iters=3 %{dep:tests/labeled_tuples.ml})))))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/labeled_tuples.ml labeled_tuples.ml.stdout)))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/labeled_tuples.ml.err labeled_tuples.ml.stderr)))
+
+(rule
+ (deps tests/.ocamlformat )
+ (package ocamlformat)
+ (action
+  (with-stdout-to labeled_tuples_cmts_attrs.ml.stdout
+   (with-stderr-to labeled_tuples_cmts_attrs.ml.stderr
+     (run %{bin:ocamlformat} --margin-check --profile=janestreet --max-iters=3 %{dep:tests/labeled_tuples_cmts_attrs.ml})))))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/labeled_tuples_cmts_attrs.ml labeled_tuples_cmts_attrs.ml.stdout)))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/labeled_tuples_cmts_attrs.ml.err labeled_tuples_cmts_attrs.ml.stderr)))
+
+(rule
+ (deps tests/.ocamlformat )
+ (package ocamlformat)
+ (action
+  (with-stdout-to labeled_tuples_cmts_attrs_move.ml.stdout
+   (with-stderr-to labeled_tuples_cmts_attrs_move.ml.stderr
+     (run %{bin:ocamlformat} --margin-check --profile=janestreet --max-iters=3 %{dep:tests/labeled_tuples_cmts_attrs_move.ml})))))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/labeled_tuples_cmts_attrs_move.ml.ref labeled_tuples_cmts_attrs_move.ml.stdout)))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/labeled_tuples_cmts_attrs_move.ml.err labeled_tuples_cmts_attrs_move.ml.stderr)))
+
 (rule
  (deps tests/.ocamlformat )
  (package ocamlformat)
diff --git a/test/passing/tests/labeled_tuple_patterns.ml b/test/passing/tests/labeled_tuple_patterns.ml
new file mode 100644
index 0000000000..780d3ff356
--- /dev/null
+++ b/test/passing/tests/labeled_tuple_patterns.ml
@@ -0,0 +1,291 @@
+(* This file is a copy of a labeled tuples test from the compiler.  Not everything here
+   typechecks, but everything should parse. *)
+
+(* Test match statements with exception patterns *)
+
+exception Odd
+
+let x_must_be_even (~x, y) = if x mod 2 = 1 then raise Odd else ~x, y
+
+let foo xy k_good k_bad =
+  match x_must_be_even xy with
+  | ~x, y -> k_good ()
+  | exception Odd -> k_bad ()
+;;
+
+(* Test correctness *)
+let _ = foo (~x:2, 5) (fun () -> true) (fun () -> false)
+let _ = foo (~x:3, 5) (fun () -> false) (fun () -> true)
+
+(* Test that the actions occur outside of the exception handler *)
+let _ =
+  try foo (~x:2, 5) (fun () -> raise Odd) (fun () -> false) with
+  | Odd -> true
+;;
+
+let _ =
+  try foo (~x:3, 5) (fun () -> false) (fun () -> raise Odd) with
+  | Odd -> true
+;;
+
+(* Labeled tuple pattern *)
+let ~x:x0, ~y:y0, _ = ~x:1, ~y:2, "ignore me"
+
+(* Pattern with punning and type annotation *)
+let ~(x : int), ~y, _ = ~x:1, ~y:2, "ignore me"
+
+(* Patterns in functions *)
+let f (~foo, ~bar) = (foo * 10) + bar
+let bar = 5
+let _ = f (~foo:1, ~bar)
+
+(* Correct annotation *)
+let f : (foo:int * bar:int) -> int = fun (~foo, ~bar) -> (foo * 10) + bar
+let f (~foo, ~bar) : foo:int * bar:int = (foo * 10) + bar
+
+(* Missing label *)
+let f : int * bar:int -> int = fun (~foo, ~bar) -> (foo * 10) + bar
+let f (~foo, ~bar) : foo:int * int = (foo * 10) + bar
+
+(* Wrong label *)
+let f : (foo:int * foo:int) -> int = fun (~foo, ~bar) -> (foo * 10) + bar
+
+(* Wrong type *)
+let f : (foo:float * foo:int) -> int = fun (~foo, ~bar) -> (foo * 10) + bar
+
+(* Annotated pattern *)
+let f ((~x, y) : x:int * int) : int = x + y
+
+(* Misannotated pattern *)
+let f ((~x, y) : int * int) : int = x + y
+let f ((~x, y) : int * x:int) : int = x + y
+
+(* Annotation within pattern *)
+let f ((~(x : int), y) : x:int * int) : int = x + y
+let f (~(x : int), y) = x + y
+let f (~x:(x0 : int), y) = x0 + y
+
+(* Misannotation within pattern *)
+let f (~(x : float), y) = x + y
+
+(* Reordering in functions *)
+type xy = x:int * y:int
+type yx = y:int * x:int
+
+let xy_id (pt : xy) = pt
+let yx_id (pt : yx) = pt
+let xy_id (~y, ~x) : xy = ~x, ~y
+let swap (~x, ~y) = ~y, ~x
+let swap ((~y, ~x) : xy) = ~y, ~x
+let swap (~x, ~y) : yx = ~x, ~y
+let swap (pt : xy) : yx = pt
+let swap : xy -> yx = Fun.id
+let swap : xy -> yx = xy_id
+let swap : xy -> yx = yx_id
+
+(* Reordering and partial matches *)
+let lt = ~x:1, ~y:2, ~x:3, 4
+
+(* Full match, in order *)
+let matches =
+  let ~x, ~y, ~x:x2, z = lt in
+  x, y, x2, z
+;;
+
+(* Full match, over-bound *)
+let matches =
+  let ~x, ~y, ~x, z = lt in
+  x, y, z
+;;
+
+(* Full match, missing label *)
+let matches =
+  let ~x, ~y, z = lt in
+  x, y, z
+;;
+
+(* Full match, wrong label *)
+let matches =
+  let ~x, ~y, ~w, z = lt in
+  x, y, z
+;;
+
+(* Full match, extra label *)
+let matches =
+  let ~x, ~y, ~x, ~y, z = lt in
+  x, y, z
+;;
+
+(* Full match, extra unlabeled label *)
+let matches =
+  let ~x, ~y, ~x, z, w = lt in
+  x, y, z
+;;
+
+(* Partial match *)
+let matches =
+  let ~x, ~y, .. = lt in
+  x, y
+;;
+
+(* Partial match, reordered *)
+let matches =
+  let ~y, ~x, .. = lt in
+  x, y
+;;
+
+(* Partial match, reordered, over-bound *)
+let matches =
+  let ~y:x, ~x, .. = lt in
+  x
+;;
+
+(* Partial match one *)
+let matches =
+  let ~x, .. = lt in
+  x
+;;
+
+(* Partial match all *)
+let matches =
+  let ~x, ~y, ~x:x2, z, .. = lt in
+  x, y, x2, z
+;;
+
+(* Partial match too many of a name *)
+let matches =
+  let ~y, ~y:y2, ~x, .. = lt in
+  x, y
+;;
+
+(* Partial match bad name *)
+let matches =
+  let ~w, ~y, ~x, .. = lt in
+  x, y, x2, z
+;;
+
+(* Nested pattern *)
+let f (z, (~y, ~x)) = x, y, z
+
+(* Non-principally known patterns *)
+
+let f (z, (~y, ~x, ..)) = x, y, z
+let f (~x, ~y, ..) = x, y
+
+(* Labeled tuples nested in records *)
+
+let x = ref (~x:1, ~y:2, ~x:3, 4)
+
+(* Good match *)
+let _1234 =
+  match x with
+  | { contents = ~x:x0, ~y, ~x, z } -> x0, y, x, z
+;;
+
+(* Good partial match *)
+let _1 =
+  match x with
+  | { contents = ~x, .. } -> x
+;;
+
+(* Wrong label *)
+let () =
+  match x with
+  | { contents = ~w, .. } -> w
+;;
+
+(* Missing unordered label *)
+let () =
+  match x with
+  | { contents = ~x:x0, ~y, ~x } -> y
+;;
+
+(* Extra unordered label *)
+let () =
+  match x with
+  | { contents = ~x:x0, ~y, ~x, w1, w2 } -> y
+;;
+
+(* Extra unordered label, open *)
+let () =
+  match x with
+  | { contents = ~x:x0, ~y, ~x, w1, w2, .. } -> y
+;;
+
+(* Missing label *)
+let () =
+  match x with
+  | { contents = ~x:x0, ~y, x } -> y
+;;
+
+(* Extra label *)
+let () =
+  match x with
+  | { contents = ~y:y0, ~y, ~x } -> y
+;;
+
+(* Behavior w.r.t whether types are principally known *)
+
+let f (z : x:_ * y:_) =
+  match z with
+  | ~y, ~x -> x + y
+;;
+
+let f = function
+  | ~x, ~y -> x + y
+;;
+
+let g z =
+  ( f z
+  , match z with
+    | ~y, ~x -> x + y )
+;;
+
+let f = function
+  | ~x, ~y -> x + y
+;;
+
+let g z =
+  match z with
+  | ~y, ~x -> x + y, f z
+;;
+
+(* More re-ordering stress tests *)
+type t = x:int * y:int * int * x:int * x:int * y:int * y:int * int * int * y:int * x:int
+
+let t : t = ~x:1, ~y:2, 3, ~x:4, ~x:5, ~y:6, ~y:7, 8, 9, ~y:10, ~x:11
+
+let _ =
+  let ~y, ~y:y2, ~y:y3, .. = t in
+  y, y2, y3
+;;
+
+let _ =
+  let a, b, c, .. = t in
+  a, b, c
+;;
+
+let _ =
+  let n3, ~y:n2, ~y, ~x:n1, .. = t in
+  n1, n2, n3, y
+;;
+
+let _ =
+  let ~x:x1, ~x:x2, ~x:x3, ~x, .. = t in
+  x1, x2, x3, x
+;;
+
+let _ =
+  let ~y:n2, ~y:n6, n3, ~x:n1, ~y:n7, n8, ~y:n10, ~x:n4, ~x:n5, ~x:n11, n9 = t in
+  n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11
+;;
+
+let _ =
+  let n3, n8, n9, ~y:n2, ~y:n6, ~y:n7, ~y:n10, ~x:n1, ~x:n4, ~x:n5, ~x:n11 = t in
+  n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11
+;;
+
+let _ =
+  let ~x:n1, ~y:n2, n3, ~x:n4, ~x:n5, ~y:n6, ~y:n7, n8, n9, ~y:n10, ~x:n11 = t in
+  n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11
+;;
diff --git a/test/passing/tests/labeled_tuple_patterns.ml.opts b/test/passing/tests/labeled_tuple_patterns.ml.opts
new file mode 100644
index 0000000000..1be40ffecb
--- /dev/null
+++ b/test/passing/tests/labeled_tuple_patterns.ml.opts
@@ -0,0 +1,2 @@
+--profile=janestreet
+--max-iters=3
diff --git a/test/passing/tests/labeled_tuples.ml b/test/passing/tests/labeled_tuples.ml
new file mode 100644
index 0000000000..cd94542c96
--- /dev/null
+++ b/test/passing/tests/labeled_tuples.ml
@@ -0,0 +1,271 @@
+(* This test file is just a copy of some of the compiler's labeled tuple tests as a
+   convenient source of examples.  It include:
+   - labeledtuples.ml
+   - labeled_tuples_dsource.ml
+   - labeld_tuples_and_constructors.ml
+   Not everything here is expected to typecheck, but it should all parse.
+*)
+
+(* Basic expressions *)
+let x = ~x:1, ~y:2
+let z = 5
+let punned = 2
+let _ = ~x:5, 2, ~z, ~(punned : int)
+
+(* Basic annotations *)
+let (x : x:int * y:int) = ~x:1, ~y:2
+let (x : x:int * int) = ~x:1, 2
+
+(* Incorrect annotations *)
+let (x : int * int) = ~x:1, 2
+let (x : x:string * int) = ~x:1, 2
+let (x : int * y:int) = ~x:1, 2
+
+(* Happy case *)
+let foo b = if b then ~a:"s", 10, ~c:"hi" else ~a:"5", 10, ~c:"hi"
+
+(* Missing label (the type vars in the error aren't ideal, but the same thing
+   happens when unifying normal tuples of different lengths) *)
+let foo b = if b then ~a:"s", 10, "hi" else ~a:"5", 10, ~c:"hi"
+
+(* Missing labeled component *)
+let foo b = if b then ~a:"s", 10 else ~a:"5", 10, ~c:"hi"
+
+(* Wrong label *)
+let foo b = if b then ~a:"s", 10, ~a:"hi" else ~a:"5", 10, ~c:"hi"
+
+(* Types in function argument/return *)
+let default = ~x:1, ~y:2
+let choose_pt replace_with_default pt = if replace_with_default then default else pt
+
+(* Application happy case *)
+let a = choose_pt true (~x:5, ~y:6)
+
+(* Wrong order *)
+let a = choose_pt true (~y:6, ~x:5)
+
+(* Mutually-recursive definitions *)
+let rec a = 1, ~lbl:b
+and b = 2, ~lbl:a
+
+let rec l = (~lbl:5, ~lbl2:10) :: l
+
+(* Tuple containing labeled tuples *)
+let tup = (~a:1, ~b:2), (~b:3, ~a:4), 5
+
+(* Polymorphic variant containing labeled tuple *)
+let a = `Some (~a:1, ~b:2, 3)
+
+(* List of labeled tuples *)
+let lst = (~a:1, ~b:2) :: []
+
+(* Ref of labeled tuple *)
+let x = ref (~x:"hello", 5)
+
+(* Polymorphic record containing a labeled tuple *)
+type 'a box = { thing : 'a }
+
+let boxed = { thing = "hello", ~x:5 }
+
+(* Punned tuple components with type annotations. *)
+let x = 42
+let y = "hi"
+let z = ~x, ~(y : string)
+let z = ~(x : int), ~y:"baz"
+let z = ~(x : string), ~y:"baz"
+
+(* Take a [a:'a * b:'a] and an int, and returns a
+   [swapped:[a:'a * b:'a] * same:bool].
+   The swapped component is the input with the [a] and [b] components swapped
+   as many times as the input int. The second component is whether the first
+   equals the input. *)
+let rec swap (~a, ~b) = function
+  | 0 -> ~swapped:(~a, ~b), ~same:true
+  | n -> swap' (~a:b, ~b:a) (n - 1)
+
+and swap' (~a, ~b) = function
+  | 0 -> ~swapped:(~a, ~b), ~same:false
+  | n -> swap (~a:b, ~b:a) (n - 1)
+;;
+
+let foobar = swap (~a:"foo", ~b:"bar") 86
+let barfoo = swap (~a:"foo", ~b:"bar") 87
+
+(* Labeled tuple type annotations *)
+(* Bad type *)
+let x : string * a:int * int = ~lbl:5, "hi"
+
+(* Well-typed *)
+let x : string * a:int * int = "hi", ~a:1, 2
+
+(* Function type *)
+let mk_x : (foo:unit * bar:unit) -> string * a:int * int = fun _ -> x
+let x = mk_x (~foo:(), ~bar:())
+
+(* Labeled tuples in records *)
+
+type bad_t = { x : lbl:bad_type * int }
+type tx = { x : foo:int * bar:int }
+type tx_unlabeled = { x : int * int }
+
+let _ = { x = ~foo:1, ~bar:2 }
+let _ : tx = { x = ~foo:1, ~bar:2 }
+let _ : tx = { x = 1, ~bar:2 }
+let _ : tx = { x = ~foo:1, 2 }
+let _ : tx = { x = 1, 2 }
+let _ = { x = 1, 2 }
+
+(* Module inclusion *)
+
+module IntString : sig
+  type t
+
+  val mk : (x:int * string) -> t
+  val unwrap : t -> x:int * string
+end = struct
+  type t = string * x:int
+
+  let mk (~x, s) = s, ~x
+  let unwrap (s, ~x) = ~x, s
+end
+
+module Stringable = struct
+  module type Has_unwrap = sig
+    type t
+
+    val unwrap : t -> x:int * string
+  end
+
+  module type Has_to_string = sig
+    include Has_unwrap
+
+    val to_string : t -> string
+  end
+
+  module Make (M : Has_unwrap) : Has_to_string with type t := M.t = struct
+    include M
+
+    let to_string int_string =
+      let ~x, s = unwrap int_string in
+      Int.to_string x ^ " " ^ s
+    ;;
+  end
+end
+
+module StringableIntString = struct
+  include IntString
+  include functor Stringable.Make
+end
+
+let _ = StringableIntString.to_string (StringableIntString.mk (~x:1, "hi"))
+
+module M : sig
+  val f : (x:int * string) -> x:int * string
+  val mk : unit -> x:bool * y:string
+end = struct
+  let f x = x
+  let mk () = ~x:false, ~y:"hi"
+end
+
+(* Module inclusion failure *)
+module X_int_int = struct
+  type t = x:int * int
+end
+
+module Y_int_int : sig
+  type t = y:int * int
+end = struct
+  include X_int_int
+end
+
+module Int_int : sig
+  type t = int * int
+end =
+  X_int_int
+
+(* Recursive modules *)
+module rec Tree : sig
+  type t =
+    | Leaf of string
+    | Branch of string * TwoTrees.t
+
+  val in_order : t -> string list
+end = struct
+  type t =
+    | Leaf of string
+    | Branch of string * TwoTrees.t
+
+  let rec in_order = function
+    | Leaf s -> [ s ]
+    | Branch (s, (~left, ~right)) -> in_order left @ [ s ] @ in_order right
+  ;;
+end
+
+and TwoTrees : sig
+  type t = left:Tree.t * right:Tree.t
+end = struct
+  type t = left:Tree.t * right:Tree.t
+end
+
+let leaf s = Tree.Leaf s
+let tree_abc = Tree.Branch ("b", (~left:(leaf "a"), ~right:(leaf "c")))
+let tree_abcde = Tree.Branch ("d", (~left:tree_abc, ~right:(leaf "e")))
+let _ = Tree.in_order tree_abcde
+
+(* Motivating example *)
+let two_kinds_of_sums ints =
+  let init = ~normal_sum:0, ~absolute_value_sum:0 in
+  List.fold_left
+    (fun (~normal_sum, ~absolute_value_sum) elem ->
+      let normal_sum = elem + normal_sum in
+      let absolute_value_sum = abs elem + absolute_value_sum in
+      ~normal_sum, ~absolute_value_sum)
+    init
+    ints
+;;
+
+let _ = two_kinds_of_sums [ 1; 2; 3; 4 ]
+let _ = two_kinds_of_sums [ 1; 2; -3; 42; -17 ]
+let x = ~x:1, ~y:2
+
+(* Attribute should prevent punning *)
+let z = 5
+let y = ~z, ~z, ~z:(z [@attr])
+
+let (~x:x0, ~s, ~(y : int), ..) : x:int * s:string * y:int * string =
+  ~x:1, ~s:"a", ~y:2, "ignore me"
+;;
+
+(* Constructor with labeled arguments (disallowed) *)
+
+type ('a, 'b) pair = Pair of 'a * 'b
+
+let x = Pair (~x:5, 2)
+
+(* Labeled tuple pattern in constructor pattern, with the same arity as the
+   constructor. This is intentionally disallowed. *)
+let f = function
+  | Pair (~x:5, 2) -> true
+  | _ -> false
+;;
+
+(* Labeled tuple patterns in constructor patterns with that can union with the
+   constructor pattern type. *)
+let f = function
+  | Some (~x:5, 2) -> true
+  | _ -> false
+;;
+
+type t = Foo of (x:int * int)
+
+let f = function
+  | Foo (~x:5, 2) -> true
+  | _ -> false
+;;
+
+let _ = f (Foo (~x:5, 2))
+let _ = f (Foo (~x:4, 2))
+let _ = f (Foo (~x:5, 1))
+let _ = f (Foo (5, 1))
+let _ = f (Foo (5, ~x:1))
+let _ = f (Foo (5, ~y:1))
diff --git a/test/passing/tests/labeled_tuples.ml.opts b/test/passing/tests/labeled_tuples.ml.opts
new file mode 100644
index 0000000000..1be40ffecb
--- /dev/null
+++ b/test/passing/tests/labeled_tuples.ml.opts
@@ -0,0 +1,2 @@
+--profile=janestreet
+--max-iters=3
diff --git a/test/passing/tests/labeled_tuples_cmts_attrs.ml b/test/passing/tests/labeled_tuples_cmts_attrs.ml
new file mode 100644
index 0000000000..b9fe81f614
--- /dev/null
+++ b/test/passing/tests/labeled_tuples_cmts_attrs.ml
@@ -0,0 +1,58 @@
+(* Tests making sure comments and attributes are handled reasonably by labeled tuple
+   printing.  This test has examples where the comments stay in exactly the same place -
+   see [labeled_tuples_cmts_attrs_move.ml] for examples where we allow ourselves to
+   slightly shift a comment or add a pun.  *)
+
+(* Attrs around expressions *)
+let y = ~z, ~z:(z [@attr])
+let y = ~z, (z [@attr])
+let y = ~z, ~z [@@attr]
+let y = ~z:((42 [@attr]) : int), 42
+
+(* Comments around expressions *)
+let _ = (* baz *) ~z:42, ~y
+let _ = ~z:(* baz *) 42, ~y
+let _ = ~z:42 (* baz *), ~y
+let _ = ~z:42, (* baz *) ~y
+let _ = ~z:42, ~y (* baz *)
+let _ = (* baz *) ~z, ~(y : int)
+let _ = ~z (* baz *), ~(y : int)
+let _ = ~z, ~(* baz *) (y : int)
+let _ = ~z, ~((* baz *) y : int)
+let _ = ~z, ~(y : (* baz *) int)
+let _ = ~z, ~(y : int (* baz *))
+let _ = ~z, ~(y : int) (* baz *)
+
+(* Attrs around types *)
+type t = z:(int[@attr]) * y:bool
+type t = (z:int * y:bool[@attr])
+type t = z:int * y:(bool[@attr])
+type t = z:int * y:bool [@@attr]
+
+(* Comments around types *)
+type t = (* baz *) z:int * y:bool
+type t = z (* baz *):int * y:bool
+type t = z:(* baz *) int * y:bool
+type t = z:int (* baz *) * y:bool
+type t = z:int * (* baz *) y:bool
+type t = z:int * y (* baz *):bool
+type t = z:int * y:(* baz *) bool
+type t = z:int * y:bool (* baz *)
+
+(* Attrs around patterns *)
+let ~z:(z [@attr]), ~y = ()
+let ~z, ~y:(42 [@attr]) = ()
+let ((~z, ~y:42) [@attr]) = ()
+
+(* Comments around patterns *)
+let (* baz *) ~z, ~y = ()
+let ~z (* baz *), ~y = ()
+let ~z, (* baz *) ~y = ()
+let ~z, ~y (* baz *) = ()
+let (* baz *) ~z:42, ~(y : int) = ()
+let ~z:(* baz *) 42, ~(y : int) = ()
+let ~z:42 (* baz *), ~(y : int) = ()
+let ~z:42, ~((* baz *) y : int) = ()
+let ~z:42, ~(y : (* baz *) int) = ()
+let ~z:42, ~(y : int (* baz *)) = ()
+let ~z:42, ~(y : int) (* baz *) = ()
diff --git a/test/passing/tests/labeled_tuples_cmts_attrs.ml.opts b/test/passing/tests/labeled_tuples_cmts_attrs.ml.opts
new file mode 100644
index 0000000000..1be40ffecb
--- /dev/null
+++ b/test/passing/tests/labeled_tuples_cmts_attrs.ml.opts
@@ -0,0 +1,2 @@
+--profile=janestreet
+--max-iters=3
diff --git a/test/passing/tests/labeled_tuples_cmts_attrs_move.ml b/test/passing/tests/labeled_tuples_cmts_attrs_move.ml
new file mode 100644
index 0000000000..ba9858cf2e
--- /dev/null
+++ b/test/passing/tests/labeled_tuples_cmts_attrs_move.ml
@@ -0,0 +1,26 @@
+(* Tests making sure comments and attributes are handled reasonably by labeled tuple
+   printing.  This test has where we allow ourselves to slightly move a comment or add a
+   pun or parens that aren't strictly necessary.  These examples are all analagous to
+   similar cases with other forms (e.g., labeled arguments).  See
+   [labeled_tuples_cmts_attrs.ml] for examples that stay exactly the same after
+   formatting. *)
+
+(* Attrs around expressions *)
+let y = ~z, z [@attr]
+let y = ~z, ~z:z [@@attr]
+let y = ~z:(42[@attr]:int), 42
+
+(* Comments around expressions *)
+let _ = ~(* baz *)z, ~(y : int)
+let _ = ~z, (* baz *)~(y : int)
+let _ = ~z, ~(y(* baz *) : int)
+
+(* Attrs around types *)
+type t = z:int * y:bool[@attr]
+
+(* Comments around patterns *)
+let ~(* baz *)z, ~y = ()
+let ~z, ~(* baz *)y = ()
+let ~z:42, (* baz *)~(y : int) = ()
+let ~z:42, ~(* baz *)(y : int) = ()
+let ~z:42, ~(y(* baz *) : int) = ()
diff --git a/test/passing/tests/labeled_tuples_cmts_attrs_move.ml.opts b/test/passing/tests/labeled_tuples_cmts_attrs_move.ml.opts
new file mode 100644
index 0000000000..1be40ffecb
--- /dev/null
+++ b/test/passing/tests/labeled_tuples_cmts_attrs_move.ml.opts
@@ -0,0 +1,2 @@
+--profile=janestreet
+--max-iters=3
diff --git a/test/passing/tests/labeled_tuples_cmts_attrs_move.ml.ref b/test/passing/tests/labeled_tuples_cmts_attrs_move.ml.ref
new file mode 100644
index 0000000000..f80dfcb2f6
--- /dev/null
+++ b/test/passing/tests/labeled_tuples_cmts_attrs_move.ml.ref
@@ -0,0 +1,26 @@
+(* Tests making sure comments and attributes are handled reasonably by labeled tuple
+   printing.  This test has where we allow ourselves to slightly move a comment or add a
+   pun or parens that aren't strictly necessary.  These examples are all analagous to
+   similar cases with other forms (e.g., labeled arguments).  See
+   [labeled_tuples_cmts_attrs.ml] for examples that stay exactly the same after
+   formatting. *)
+
+(* Attrs around expressions *)
+let y = ~z, (z [@attr])
+let y = ~z, ~z [@@attr]
+let y = ~z:((42 [@attr]) : int), 42
+
+(* Comments around expressions *)
+let _ = (* baz *) ~z, ~(y : int)
+let _ = ~z, ~(* baz *) (y : int)
+let _ = ~z, ~(y : int) (* baz *)
+
+(* Attrs around types *)
+type t = (z:int * y:bool[@attr])
+
+(* Comments around patterns *)
+let (* baz *) ~z, ~y = ()
+let ~z, (* baz *) ~y = ()
+let ~z:42, ~((* baz *) y : int) = ()
+let ~z:42, ~((* baz *) y : int) = ()
+let ~z:42, ~(y : int) (* baz *) = ()
diff --git a/vendor/parser-extended/ast_helper.ml b/vendor/parser-extended/ast_helper.ml
index 1104d92da4..ef0bec57e9 100644
--- a/vendor/parser-extended/ast_helper.ml
+++ b/vendor/parser-extended/ast_helper.ml
@@ -98,7 +98,7 @@ module Pat = struct
   let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b))
   let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a)
   let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b))
-  let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a)
+  let tuple ?loc ?attrs a b = mk ?loc ?attrs (Ppat_tuple (a, b))
   let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b))
   let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b))
   let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b))
diff --git a/vendor/parser-extended/ast_mapper.ml b/vendor/parser-extended/ast_mapper.ml
index 61ea76d353..6d102f902e 100644
--- a/vendor/parser-extended/ast_mapper.ml
+++ b/vendor/parser-extended/ast_mapper.ml
@@ -204,7 +204,8 @@ module T = struct
     | Ptyp_arrow (params, t2) ->
         arrow ~loc ~attrs (List.map (map_arrow_param sub) params)
           (sub.typ sub t2)
-    | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl)
+    | Ptyp_tuple tyl ->
+        tuple ~loc ~attrs (List.map (fun (lbl, t) -> map_opt (map_loc sub) lbl, sub.typ sub t) tyl)
     | Ptyp_constr (lid, tl) ->
         constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
     | Ptyp_object (l, o) ->
@@ -535,7 +536,8 @@ module E = struct
     | Pexp_match (e, pel) ->
         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_tuple el ->
+        tuple ~loc ~attrs (List.map (fun (lbl, e) -> map_opt (map_loc sub) lbl, sub.expr sub e) el)
     | Pexp_construct (lid, arg) ->
         construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg)
     | Pexp_variant (lab, eo) ->
@@ -657,7 +659,8 @@ module P = struct
     | Ppat_constant c -> constant ~loc ~attrs (sub.constant sub c)
     | Ppat_interval (c1, c2) ->
         interval ~loc ~attrs (sub.constant sub c1) (sub.constant sub c2)
-    | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl)
+    | Ppat_tuple (pl, oc) ->
+        tuple ~loc ~attrs (List.map (fun (lbl, p) -> map_opt (map_loc sub) lbl, sub.pat sub p) pl) oc
     | Ppat_construct (l, p) ->
         construct ~loc ~attrs (map_loc sub l)
           (map_opt
diff --git a/vendor/parser-extended/extensions.ml b/vendor/parser-extended/extensions.ml
index b24277acd0..3113e0fcf1 100644
--- a/vendor/parser-extended/extensions.ml
+++ b/vendor/parser-extended/extensions.ml
@@ -106,7 +106,7 @@ module Comprehensions = struct
           ; match direction with
             | Upto   -> "upto"
             | Downto -> "downto" ]
-          (Ast_helper.Exp.tuple [start; stop])
+          (Ast_helper.Exp.tuple [None, start; None, stop])
     | In seq ->
         comprehension_expr ~loc ["for"; "in"] seq
 
@@ -219,10 +219,10 @@ module Comprehensions = struct
   let iterator_of_expr expr =
     match expand_comprehension_extension_expr expr with
     | ["for"; "range"; "upto"],
-      { pexp_desc = Pexp_tuple [start; stop]; _ } ->
+      { pexp_desc = Pexp_tuple [None, start; None, stop]; _ } ->
         Range { start; stop; direction = Upto }
     | ["for"; "range"; "downto"],
-      { pexp_desc = Pexp_tuple [start; stop]; _ } ->
+      { pexp_desc = Pexp_tuple [None, start; None, stop]; _ } ->
         Range { start; stop; direction = Downto }
     | ["for"; "in"], seq ->
         In seq
diff --git a/vendor/parser-extended/extensions_parsing.ml b/vendor/parser-extended/extensions_parsing.ml
index 824719e230..53b7d1ac6e 100644
--- a/vendor/parser-extended/extensions_parsing.ml
+++ b/vendor/parser-extended/extensions_parsing.ml
@@ -290,12 +290,24 @@ module Pattern = Make_AST(struct
   let make_extension_node = Ast_helper.Pat.extension
 
   let make_extension_use ~loc ~extension_node pat =
-    Ast_helper.Pat.tuple ~loc [extension_node; pat]
+    Ast_helper.Pat.tuple ~loc [None, extension_node; None, pat] Closed
+
+  exception Found_label
 
   let match_extension_use pat =
     match pat.ppat_desc with
-    | Ppat_tuple({ppat_desc = Ppat_extension ext; _} :: patterns) ->
-        Some (ext, patterns)
+    | Ppat_tuple((None, {ppat_desc = Ppat_extension ext; _}) :: patterns,
+                 Closed) -> begin
+        try
+          let patterns =
+            List.map (function | None, p -> p
+                               | Some _, _ -> raise Found_label)
+              patterns
+          in
+          Some (ext, patterns)
+        with
+        | Found_label -> None
+      end
     | _ ->
        None
 
diff --git a/vendor/parser-extended/parser.mly b/vendor/parser-extended/parser.mly
index 79be6294c6..4704fdd398 100644
--- a/vendor/parser-extended/parser.mly
+++ b/vendor/parser-extended/parser.mly
@@ -100,9 +100,7 @@ let mkcf ~loc ?attrs ?docs d =
   Cf.mk ~loc:(make_loc loc) ?attrs ?docs d
 
 let mkrhs rhs loc = mkloc rhs (make_loc loc)
-(*
 let ghrhs rhs loc = mkloc rhs (ghost_loc loc)
-*)
 
 let mk_optional lbl loc = Optional (mkrhs lbl loc)
 let mk_labelled lbl loc = Labelled (mkrhs lbl loc)
@@ -245,6 +243,16 @@ let mkpat_local_if p pat =
 let mktyp_local_if p typ =
   if p then mktyp_stack typ else typ
 
+let mktyp_modes modes =
+  (* Jane Street: This is horrible temporary code until we properly add
+     support for more modes. *)
+  let is_local =
+    match modes with
+    | [] -> false
+    | _ :: _ -> true
+  in
+  mktyp_local_if is_local
+
 let exclave_ext_loc loc = mkloc "extension.exclave" loc
 
 let exclave_extension loc =
@@ -2438,7 +2446,7 @@ expr:
   | expr_attrs
       { let desc, attrs = $1 in
         mkexp_attrs ~loc:$sloc desc attrs }
-  | mkexp(expr_)
+  | expr_
       { $1 }
   | let_bindings(ext) IN seq_expr
       { expr_of_let_bindings ~loc:$sloc $1 $3 }
@@ -2531,19 +2539,19 @@ expr:
 ;
 %inline expr_:
   | simple_expr nonempty_llist(labeled_simple_expr)
-      { Pexp_apply($1, $2) }
-  | expr_comma_list %prec below_COMMA
-      { Pexp_tuple($1) }
+      { mkexp ~loc:$sloc (Pexp_apply($1, $2)) }
+  | labeled_tuple %prec below_COMMA
+      { mkexp ~loc:$sloc (Pexp_tuple $1) }
   | mkrhs(constr_longident) simple_expr %prec below_HASH
-      { Pexp_construct($1, Some $2) }
+      { mkexp ~loc:$sloc (Pexp_construct($1, Some $2)) }
   | name_tag simple_expr %prec below_HASH
-      { Pexp_variant($1, Some $2) }
+      { mkexp ~loc:$sloc (Pexp_variant($1, Some $2)) }
   | e1 = expr op = op(infix_operator) e2 = expr
-      { mkinfix e1 op e2 }
+      { mkexp ~loc:$sloc (mkinfix e1 op e2) }
   | subtractive expr %prec prec_unary_minus
-      { mkuminus ~oploc:$loc($1) $1 $2 }
+      { mkexp ~loc:$sloc (mkuminus ~oploc:$loc($1) $1 $2) }
   | additive expr %prec prec_unary_plus
-      { mkuplus ~oploc:$loc($1) $1 $2 }
+      { mkexp ~loc:$sloc (mkuplus ~oploc:$loc($1) $1 $2) }
 ;
 
 simple_expr:
@@ -2958,10 +2966,92 @@ fun_def:
     RPAREN fun_def
       { mk_newtypes ~loc:$sloc [name, Some layout] $7 }
 ;
-%inline expr_comma_list:
-  es = separated_nontrivial_llist(COMMA, expr)
-    { es }
+
+(* Parsing labeled tuple expressions
+
+   The grammar we want to parse is something like:
+
+     labeled_tuple_element := expr | ~x:expr | ~x | ~(x:ty)
+     labeled_tuple := lt_element [, lt_element]+
+
+   (The last case of [labeled_tuple_element] is a punned label with a type
+   constraint, which is allowed for functions, so we allow it here).
+
+   So you might think [labeled_tuple] could therefore just be:
+
+     labeled_tuple :
+       separated_nontrivial_llist(COMMA, labeled_tuple_element)
+
+   But this doesn't work:
+
+   - If we don't mark [labeled_tuple_element] %inline, this causes many
+     reduce/reduce conflicts (basically just ambiguities) because
+     [labeled_tuple_element] trivially reduces to [expr].
+
+   - If we do mark [labeled_tuple_element] %inline, it is not allowed to have
+     %prec annotations.  Menhir doesn't permit these on %inline non-terminals
+     that are used in non-tail position.
+
+   To get around this, we do mark it inlined, and then because we can only use
+   it in tail position it is _manually_ inlined into the occurrences in
+   [separated_nontrivial_llist] where it doesn't appear in tail position.  This
+   results in [labeled_tuple] and [reversed_labeled_tuple_body] below.  So the
+   latter is just a list of comma-separated labeled tuple elements, with length
+   at least two, where the first element in the base case is inlined (resulting
+   in one base case for each case of [labeled_tuple_element].  *)
+%inline labeled_tuple_element :
+  | expr
+     { None, $1 }
+  | LABEL simple_expr %prec below_HASH
+     { let label = mkrhs $1 $loc($1) in
+       Some label, $2 }
+  | TILDE label = LIDENT
+     { let loc = $loc(label) in
+       let lbl = ghrhs label loc in
+       Some lbl, mkexpvar ~loc label }
+  | TILDE LPAREN label = LIDENT ty = type_constraint RPAREN %prec below_HASH
+      { let lbl = ghrhs label $loc(label) in
+        Some lbl,
+        mkexp_constraint
+          ~loc:($startpos($2), $endpos) (mkexpvar ~loc:$loc(label) label) ty }
+;
+reversed_labeled_tuple_body:
+  (* > 2 elements *)
+  xs = reversed_labeled_tuple_body
+  COMMA
+  x = labeled_tuple_element
+    { x :: xs }
+  (* base cases (2 elements) *)
+| x1 = expr
+  COMMA
+  x2 = labeled_tuple_element
+    { [ x2; None, x1 ] }
+| l1 = LABEL x1 = simple_expr
+  COMMA
+  x2 = labeled_tuple_element
+  { let label = mkrhs l1 $loc(l1) in
+    [ x2; Some label, x1 ] }
+| TILDE l1 = LIDENT
+  COMMA
+  x2 = labeled_tuple_element
+  { let loc = $loc(l1) in
+    let label = ghrhs l1 loc in
+    [ x2; Some label, mkexpvar ~loc l1] }
+| TILDE LPAREN l1 = LIDENT ty1 = type_constraint RPAREN
+  COMMA
+  x2 = labeled_tuple_element
+  { let x1 =
+      mkexp_constraint
+        ~loc:($startpos($2), $endpos) (mkexpvar ~loc:$loc(l1) l1) ty1
+    in
+    let label = ghrhs l1 $loc(l1) in
+    [ x2; Some label, x1] }
+;
+%inline labeled_tuple:
+  xs = rev(reversed_labeled_tuple_body)
+    { xs }
 ;
+
 record_expr_content:
   eo = ioption(terminated(simple_expr, WITH))
   fields = separated_or_terminated_nonempty_list(SEMI, record_expr_field)
@@ -3062,8 +3152,6 @@ pattern_no_exn:
         { Ppat_alias($1, $3) }
     | self AS error
         { expecting $loc($3) "identifier" }
-    | pattern_comma_list(self) %prec below_COMMA
-        { Ppat_tuple(List.rev $1) }
     | self COLONCOLON error
         { expecting $loc($3) "pattern" }
     | self BAR pattern
@@ -3076,8 +3164,72 @@ pattern_no_exn:
     | self BAR error
         { expecting $loc($3) "pattern" }
   ) { $1 }
+  | reversed_labeled_tuple_pattern(self)
+      { let closed, pats = $1 in
+        mkpat ~loc:$sloc (Ppat_tuple (List.rev pats, closed))
+      }
 ;
 
+(* Parsing labeled tuple patterns
+
+   Here we play essentially the same game we did for expressions - see the
+   comment beginning "Parsing labeled tuple expressions".
+
+   One difference is that we would need to manually inline the definition of
+   individual elements in two places: Once in the base case for lists 2 or more
+   elements, and once in the special case for open patterns with just one
+   element (e.g., [~x, ..]).  Rather than manually inlining
+   [labeled_tuple_pat_element] twice, we simply define it twice: once with the
+   [%prec] annotations needed for its occurrences in tail position, and once
+   without them suitable for use in other locations.
+*)
+%inline labeled_tuple_pat_element(self):
+  | self { None, $1 }
+  | LABEL simple_pattern %prec COMMA
+      { let label = mkrhs $1 $loc($1) in
+        Some label, $2 }
+  | TILDE label = LIDENT
+      { let loc = $loc(label) in
+        let lbl = ghrhs label loc in
+        Some lbl, mkpatvar ~loc label }
+  | TILDE LPAREN label = LIDENT COLON cty = core_type RPAREN %prec COMMA
+      { let loc = $loc(label) in
+        let pat = mkpatvar ~loc label in
+        let lbl = ghrhs label loc in
+        Some lbl, mkpat ~loc (Ppat_constraint (pat, cty)) }
+
+%inline labeled_tuple_pat_element_noprec(self):
+  | self { None, $1 }
+  | LABEL simple_pattern
+      { let label = mkrhs $1 $loc($1) in
+        Some label, $2 }
+  | TILDE label = LIDENT
+      { let loc = $loc(label) in
+        let lbl = ghrhs label loc in
+        Some lbl, mkpatvar ~loc label }
+  | TILDE LPAREN label = LIDENT COLON cty = core_type RPAREN
+      { let loc = $loc(label) in
+        let pat = mkpatvar ~loc label in
+        let lbl = ghrhs label loc in
+        Some lbl, mkpat ~loc (Ppat_constraint (pat, cty)) }
+
+labeled_tuple_pat_element_list(self):
+  | labeled_tuple_pat_element_list(self) COMMA labeled_tuple_pat_element(self)
+      { $3 :: $1 }
+  | labeled_tuple_pat_element_noprec(self) COMMA labeled_tuple_pat_element(self)
+      { [ $3; $1 ] }
+  | self COMMA error
+      { expecting $loc($3) "pattern" }
+;
+
+reversed_labeled_tuple_pattern(self):
+  | labeled_tuple_pat_element_list(self) %prec below_COMMA
+      { Closed, $1 }
+  | labeled_tuple_pat_element_list(self) COMMA DOTDOT
+      { Open, $1 }
+  | labeled_tuple_pat_element_noprec(self) COMMA DOTDOT
+      { Open, [ $1 ] }
+
 pattern_gen:
     simple_pattern
       { $1 }
@@ -3175,11 +3327,6 @@ simple_delimited_pattern:
             $1 }
   ) { $1 }
 
-pattern_comma_list(self):
-    pattern_comma_list(self) COMMA pattern      { $3 :: $1 }
-  | self COMMA pattern                          { [$3; $1] }
-  | self COMMA error                            { expecting $loc($3) "pattern" }
-;
 %inline pattern_semi_list:
   ps = separated_or_terminated_nonempty_list(SEMI, pattern)
     { ps }
@@ -3725,20 +3872,20 @@ function_type:
   | ty = tuple_type
     %prec MINUSGREATER
       { ty }
-  | ty = strict_function_type
+  | ty = strict_function_or_labeled_tuple_type
       { ty }
 ;
-strict_function_type:
+strict_function_or_labeled_tuple_type:
   | mktyp(
       label = arg_label
-      local = optional_local
+      local = mode_flags
       domain = extra_rhs(param_type)
       MINUSGREATER
-      codomain = strict_function_type
+      codomain = strict_function_or_labeled_tuple_type
         { let arrow_type = {
             pap_label = label;
             pap_loc = make_loc $sloc;
-            pap_type = mktyp_local_if local domain;
+            pap_type = mktyp_modes local domain;
           }
           in
           let params, codomain =
@@ -3752,25 +3899,88 @@ strict_function_type:
     { $1 }
   | mktyp(
       label = arg_label
-      arg_local = optional_local
+      arg_local = mode_flags
       domain = extra_rhs(param_type)
       MINUSGREATER
-      ret_local = optional_local
+      ret_local = mode_flags
       codomain = tuple_type
       %prec MINUSGREATER
          { let arrow_type = {
              pap_label = label;
              pap_loc = make_loc $sloc;
-             pap_type = mktyp_local_if arg_local domain
+             pap_type = mktyp_modes arg_local domain
            }
            in
            let codomain =
-             mktyp_local_if ret_local (maybe_curry_typ codomain)
+             mktyp_modes ret_local (maybe_curry_typ codomain)
            in
            Ptyp_arrow([arrow_type], codomain)
          }
       )
       { $1 }
+  (* These next three cases are for labled tuples - see comment on [tuple_type]
+     below.
+
+     The first two cases are present just to resolve a shift reduce conflict
+     in a module type [S with t := x:t1 * t2 -> ...] which might be the
+     beginning of
+       [S with t := x:t1 * t2 -> S']    or    [S with t := x:t1 * t2 -> t3]
+     They are the same as the previous two cases, but with [arg_label] replaced
+     with the more specific [LIDENT COLON] and [param_type] replaced with the
+     more specific [proper_tuple_type].  Apparently, this is sufficient for
+     menhir to be able to delay a decision about which of the above module type
+     cases we are in.  *)
+  | mktyp(
+      label = LIDENT COLON
+      unique_local = mode_flags
+      tuple = proper_tuple_type
+      MINUSGREATER
+      codomain = strict_function_or_labeled_tuple_type
+         {
+           let ty, ltys = tuple in
+           let label = mk_labelled label $loc(label) in
+           let domain =
+             mktyp ~loc:$loc(tuple) (Ptyp_tuple ((None, ty) :: ltys))
+           in
+           let domain = extra_rhs_core_type domain ~pos:$endpos(tuple) in
+           let arrow_type = {
+             pap_label = label;
+             pap_loc = make_loc $sloc;
+             pap_type = mktyp_modes unique_local domain
+           }
+           in
+           Ptyp_arrow([arrow_type], codomain) }
+    )
+    { $1 }
+  | mktyp(
+      label = LIDENT COLON
+      arg_unique_local = mode_flags
+      tuple = proper_tuple_type
+      MINUSGREATER
+      ret_unique_local = mode_flags
+      codomain = tuple_type
+         { let ty, ltys = tuple in
+           let label = mk_labelled label $loc(label) in
+           let domain =
+             mktyp ~loc:$loc(tuple) (Ptyp_tuple ((None, ty) :: ltys))
+           in
+           let domain = extra_rhs_core_type domain ~pos:$endpos(tuple) in
+           let arrow_type = {
+             pap_label = label;
+             pap_loc = make_loc $sloc;
+             pap_type = mktyp_modes arg_unique_local domain
+           }
+           in
+           Ptyp_arrow([arrow_type],
+            mktyp_modes ret_unique_local (maybe_curry_typ codomain))
+         }
+    )
+    { $1 }
+  | label = LIDENT COLON proper_tuple_type %prec MINUSGREATER
+    { let ty, ltys = $3 in
+      let label = mkrhs label $loc(label) in
+      mktyp ~loc:$sloc (Ptyp_tuple ((Some label, ty) :: ltys))
+    }
 ;
 %inline param_type:
   | mktyp(
@@ -3795,22 +4005,52 @@ strict_function_type:
   | LOCAL
     { true }
 ;
+(* jane street: hackily copied and modified from our parser - to be replaced with the
+   exact version from our parser when ocamlformat is updated for uniqueness. *)
+%inline mode_flag:
+   | LOCAL
+       { $sloc }
+;
+%inline mode_flags:
+   | flags = iloption(mode_flag+)
+       { flags }
+;
 (* Tuple types include:
    - atomic types (see below);
    - proper tuple types:                  int * int * int list
    A proper tuple type is a star-separated list of at least two atomic types.
- *)
+
+   Tuple components can also be labeled, as an [int * int list * y:bool].
+
+   However, the special case of labeled tuples where the first element has a
+   label is not parsed as a proper_tuple_type, but rather as a case of
+   strict_function_or_labled_tuple_type above.  This helps in dealing with
+   ambiguities around [x:t1 * t2 -> t3] which must continue to parse as a
+   function with one labeled argument even in the presense of labled tuples.
+*)
 tuple_type:
   | ty = atomic_type
     %prec below_HASH
       { ty }
-  | mktyp(
-      tys = separated_nontrivial_llist(STAR, atomic_type)
-        { Ptyp_tuple tys }
-    )
-    { $1 }
+  | proper_tuple_type %prec below_FUNCTOR
+    { let ty, ltys = $1 in
+      mktyp ~loc:$sloc (Ptyp_tuple ((None, ty) :: ltys))
+    }
 ;
 
+%inline proper_tuple_type:
+  | ty = atomic_type
+    STAR
+    ltys = separated_nonempty_llist(STAR, labeled_tuple_typ_element)
+      { ty, ltys }
+
+%inline labeled_tuple_typ_element :
+  | atomic_type %prec STAR
+     { None, $1 }
+  | label = LIDENT COLON ty = atomic_type %prec STAR
+     { let label = mkrhs label $loc(label) in
+       Some label, ty }
+
 (* Atomic types are the most basic level in the syntax of types.
    Atomic types include:
    - types between parentheses:           (int -> int)
diff --git a/vendor/parser-extended/parsetree.mli b/vendor/parser-extended/parsetree.mli
index ba66b31c83..0099c3fe17 100644
--- a/vendor/parser-extended/parsetree.mli
+++ b/vendor/parser-extended/parsetree.mli
@@ -132,12 +132,14 @@ and core_type_desc =
             - [?l:T1 -> T2] when [lbl] is
                                      {{!Asttypes.arg_label.Optional}[Optional]}.
          *)
-  | Ptyp_tuple of core_type list
-      (** [Ptyp_tuple([T1 ; ... ; Tn])]
-          represents a product type [T1 * ... * Tn].
+  | Ptyp_tuple of (string loc option * core_type) list
+      (** [Ptyp_tuple(tl)] represents a product type:
+            - [T1 * ... * Tn]       when [tl] is [(None,T1);...;(None,Tn)]
+            - [L1:T1 * ... * Ln:Tn] when [tl] is [(Some L1,T1);...;(Some Ln,Tn)]
+            - A mix, e.g. [L1:T1,T2] when [tl] is [(Some L1,T1);(None,T2)]
 
-           Invariant: [n >= 2].
-        *)
+          Invariant: [n >= 2]
+      *)
   | Ptyp_constr of Longident.t loc * core_type list
       (** [Ptyp_constr(lident, l)] represents:
             - [tconstr]               when [l=[]],
@@ -268,11 +270,18 @@ and pattern_desc =
 
            Other forms of interval are recognized by the parser
            but rejected by the type-checker. *)
-  | Ppat_tuple of pattern list
-      (** Patterns [(P1, ..., Pn)].
-
-           Invariant: [n >= 2]
-        *)
+  | Ppat_tuple of (string loc option * pattern) list * Asttypes.closed_flag
+      (** [Ppat_tuple(pl, Closed)] represents
+            - [(P1, ..., Pn)]       when [pl] is [(None, P1);...;(None, Pn)]
+            - [(L1:P1, ..., Ln:Pn)] when [pl] is
+                                                [(Some L1, P1);...;(Some Ln, Pn)]
+            - A mix, e.g. [(L1:P1, P2)] when [pl] is [(Some L1, P1);(None, P2)]
+            - If pattern is open, then it also ends in a [..]
+
+        Invariant:
+            - If Closed, [n >= 2].
+            - If Open, [n >= 1].
+      *)
   | Ppat_construct of Longident.t loc * (string loc list * pattern) option
       (** [Ppat_construct(C, args)] represents:
             - [C]               when [args] is [None],
@@ -363,11 +372,17 @@ and expression_desc =
       (** [match E0 with P1 -> E1 | ... | Pn -> En] *)
   | Pexp_try of expression * case list
       (** [try E0 with P1 -> E1 | ... | Pn -> En] *)
-  | Pexp_tuple of expression list
-      (** Expressions [(E1, ..., En)]
-
-           Invariant: [n >= 2]
-        *)
+  | Pexp_tuple of (string loc option * expression) list
+      (** [Pexp_tuple(el)] represents
+            - [(E1, ..., En)]
+                when [el] is [(None, E1);...;(None, En)]
+            - [(~L1:E1, ..., ~Ln:En)]
+                when [el] is [(Some L1, E1);...;(Some Ln, En)]
+            - A mix, e.g.:
+                [(~L1:E1, E2)] when [el] is [(Some L1, E1); (None, E2)]
+
+          Invariant: [n >= 2].
+      *)
   | Pexp_construct of Longident.t loc * expression option
       (** [Pexp_construct(C, exp)] represents:
            - [C]               when [exp] is [None],
diff --git a/vendor/parser-extended/printast.ml b/vendor/parser-extended/printast.ml
index f769737d61..95d504623c 100644
--- a/vendor/parser-extended/printast.ml
+++ b/vendor/parser-extended/printast.ml
@@ -214,6 +214,11 @@ let fmt_layout_opt ppf l = Format.fprintf ppf "%s"
 let fmt_ty_var ppf (name, layout) =
   Format.fprintf ppf "%a:%a" fmt_str_opt_loc name fmt_layout_opt layout
 
+let tuple_component_label i ppf = function
+  | None -> line i ppf "Label: None\n"
+  | Some s -> line i ppf "Label: Some %a\n" fmt_string_loc s
+;;
+
 let typevars ppf vs =
   List.iter (fun x ->
       fprintf ppf " %a" fmt_ty_var x) vs
@@ -236,7 +241,7 @@ let rec core_type i ppf x =
       core_type i ppf ct2;
   | Ptyp_tuple l ->
       line i ppf "Ptyp_tuple\n";
-      list i core_type ppf l;
+      list i labeled_core_type ppf l;
   | Ptyp_constr (li, l) ->
       line i ppf "Ptyp_constr %a\n" fmt_longident_loc li;
       list i core_type ppf l;
@@ -286,6 +291,10 @@ and object_field i ppf x =
       line i ppf "Oinherit\n";
       core_type i ppf ct
 
+and labeled_core_type i ppf (l, t) =
+  tuple_component_label i ppf l;
+  core_type i ppf t
+
 and package_with i ppf (s, t) =
   line i ppf "with type %a\n" fmt_longident_loc s;
   core_type i ppf t
@@ -311,9 +320,10 @@ and pattern i ppf x =
       line i ppf "Ppat_interval\n";
       fmt_constant i ppf c1;
       fmt_constant i ppf c2;
-  | Ppat_tuple (l) ->
+  | Ppat_tuple (l,op) ->
       line i ppf "Ppat_tuple\n";
-      list i pattern ppf l;
+      list i labeled_pattern ppf l;
+      open_closed i ppf op
   | Ppat_construct (li, po) ->
       line i ppf "Ppat_construct %a\n" fmt_longident_loc li;
       option i
@@ -363,6 +373,15 @@ and pattern i ppf x =
       line i ppf "Ppat_cons\n";
       list i pattern ppf l
 
+and labeled_pattern i ppf (label, x) =
+    tuple_component_label i ppf label;
+    pattern i ppf x
+
+and open_closed i ppf =
+  function
+  | Open -> string i ppf "Open"
+  | Closed -> string i ppf "Closed"
+
 and expression i ppf x =
   line i ppf "expression %a\n" fmt_location x.pexp_loc;
   attributes i ppf x.pexp_attributes;
@@ -397,7 +416,7 @@ and expression i ppf x =
       list i case ppf l;
   | Pexp_tuple (l) ->
       line i ppf "Pexp_tuple\n";
-      list i expression ppf l;
+      list i labeled_expression ppf l;
   | Pexp_construct (li, eo) ->
       line i ppf "Pexp_construct %a\n" fmt_longident_loc li;
       option i expression ppf eo;
@@ -541,6 +560,11 @@ and expression i ppf x =
       expression i ppf e1;
       expression i ppf e2
 
+and labeled_expression i ppf (l, e) =
+  line i ppf "<tuple component>\n";
+  tuple_component_label i ppf l;
+  expression (i+1) ppf e;
+
 and if_branch i ppf { if_cond; if_body } =
   line i ppf "if_branch\n";
   expression i ppf if_cond;
diff --git a/vendor/parser-standard/jane_syntax.ml b/vendor/parser-standard/jane_syntax.ml
index f15dc7c98e..f7595f47ae 100644
--- a/vendor/parser-standard/jane_syntax.ml
+++ b/vendor/parser-standard/jane_syntax.ml
@@ -567,6 +567,136 @@ module Immutable_arrays = struct
     | _ -> failwith "Malformed immutable array pattern"
 end
 
+(** Labeled tuples *)
+module Labeled_tuples = struct
+  module Ext = struct
+    let feature : Feature.t = Language_extension Labeled_tuples
+  end
+
+  include Ext
+
+  type nonrec core_type = Lttyp_tuple of (string option * core_type) list
+
+  type nonrec expression = Ltexp_tuple of (string option * expression) list
+
+  type nonrec pattern =
+    | Ltpat_tuple of (string option * pattern) list * closed_flag
+
+  let string_of_label = function None -> "" | Some lbl -> lbl
+
+  let label_of_string = function "" -> None | s -> Some s
+
+  let string_of_closed_flag = function Closed -> "closed" | Open -> "open"
+
+  let closed_flag_of_string = function
+    | "closed" -> Closed
+    | "open" -> Open
+    | _ -> failwith "bad closed flag"
+
+  module Desugaring_error = struct
+    type error =
+      | Malformed
+      | Has_payload of payload
+
+    let report_error ~loc = function
+      | Malformed ->
+        Location.errorf ~loc "Malformed embedded labeled tuple term"
+      | Has_payload payload ->
+        Location.errorf ~loc
+          "Labeled tuples attribute has an unexpected payload:@;%a"
+          (Printast.payload 0) payload
+
+    exception Error of Location.t * error
+
+    let () =
+      Location.register_error_of_exn (function
+        | Error (loc, err) -> Some (report_error ~loc err)
+        | _ -> None)
+
+    let raise loc err = raise (Error (loc, err))
+  end
+
+  let typ_of ~loc ~attrs = function
+    | Lttyp_tuple tl ->
+      (* See Note [Wrapping with make_entire_jane_syntax] *)
+      Core_type.make_entire_jane_syntax ~loc feature (fun () ->
+          let names = List.map (fun (label, _) -> string_of_label label) tl in
+          Core_type.make_jane_syntax feature names
+          @@ Core_type.add_attributes attrs
+               (Ast_helper.Typ.tuple (List.map snd tl)))
+
+  (* Returns remaining unconsumed attributes *)
+  let of_typ typ =
+    let loc = typ.ptyp_loc in
+    let typ, labels, payload =
+      Core_type.match_payload_jane_syntax feature typ
+    in
+    match typ.ptyp_desc, payload with
+    | Ptyp_tuple components, PStr [] ->
+      if List.length labels <> List.length components
+      then Desugaring_error.raise typ.ptyp_loc Malformed;
+      let labeled_components =
+        List.map2 (fun s t -> label_of_string s, t) labels components
+      in
+      Lttyp_tuple labeled_components
+    | _, PStr [] -> Desugaring_error.raise loc Malformed
+    | _, _ -> Desugaring_error.raise loc (Has_payload payload)
+
+  let expr_of ~loc ~attrs = function
+    | Ltexp_tuple el ->
+      (* See Note [Wrapping with make_entire_jane_syntax] *)
+      Expression.make_entire_jane_syntax ~loc feature (fun () ->
+          let names = List.map (fun (label, _) -> string_of_label label) el in
+          Expression.make_jane_syntax feature names
+          @@ Expression.add_attributes attrs
+               (Ast_helper.Exp.tuple (List.map snd el)))
+
+  (* Returns remaining unconsumed attributes *)
+  let of_expr expr =
+    let loc = expr.pexp_loc in
+    let expr, labels, payload =
+      Expression.match_payload_jane_syntax feature expr
+    in
+    match expr.pexp_desc, payload with
+    | Pexp_tuple components, PStr [] ->
+      if List.length labels <> List.length components
+      then Desugaring_error.raise expr.pexp_loc Malformed;
+      let labeled_components =
+        List.map2 (fun s e -> label_of_string s, e) labels components
+      in
+      Ltexp_tuple labeled_components
+    | _, PStr [] -> Desugaring_error.raise expr.pexp_loc Malformed
+    | _, _ -> Desugaring_error.raise loc (Has_payload payload)
+
+  let pat_of ~loc ~attrs = function
+    | Ltpat_tuple (pl, closed) ->
+      (* See Note [Wrapping with make_entire_jane_syntax] *)
+      Pattern.make_entire_jane_syntax ~loc feature (fun () ->
+          let names = List.map (fun (label, _) -> string_of_label label) pl in
+          Pattern.make_jane_syntax feature
+            (string_of_closed_flag closed :: names)
+          @@ Pattern.add_attributes attrs
+               (Ast_helper.Pat.tuple (List.map snd pl)))
+
+  (* Returns remaining unconsumed attributes *)
+  let of_pat pat =
+    let loc = pat.ppat_loc in
+    let pat, labels, payload =
+      Pattern.match_payload_jane_syntax feature pat
+    in
+    match labels, pat.ppat_desc, payload with
+    | closed :: labels, Ppat_tuple components, PStr [] ->
+      if List.length labels <> List.length components
+      then Desugaring_error.raise pat.ppat_loc Malformed;
+      let closed = closed_flag_of_string closed in
+      let labeled_components =
+        List.map2 (fun s e -> label_of_string s, e) labels components
+      in
+      Ltpat_tuple (labeled_components, closed)
+    | _, _, PStr [] -> Desugaring_error.raise pat.ppat_loc Malformed
+    | _, _, _ -> Desugaring_error.raise loc (Has_payload payload)
+end
+
 (** [include functor] *)
 module Include_functor = struct
   type signature_item =
@@ -1041,10 +1171,13 @@ module Core_type = struct
   type t =
     | Jtyp_local of Local.core_type
     | Jtyp_layout of Layouts.core_type
+    | Jtyp_tuple of Labeled_tuples.core_type
 
   let of_ast_internal (feat : Feature.t) typ = match feat with
     | Language_extension Local -> Some (Jtyp_local (Local.of_type typ))
     | Language_extension Layouts -> Some (Jtyp_layout (Layouts.of_type typ))
+    | Language_extension Labeled_tuples ->
+      Some (Jtyp_tuple (Labeled_tuples.of_typ typ))
     | _ -> None
 
   let of_ast = Core_type.make_of_ast ~of_ast_internal
@@ -1053,6 +1186,7 @@ module Core_type = struct
     match jtyp with
     | Jtyp_local x -> Local.type_of ~loc ~attrs x
     | Jtyp_layout x -> Layouts.type_of ~loc ~attrs x
+    | Jtyp_tuple x -> Labeled_tuples.typ_of ~loc ~attrs x
 end
 
 module Constructor_argument = struct
@@ -1075,6 +1209,7 @@ module Expression = struct
     | Jexp_comprehension   of Comprehensions.expression
     | Jexp_immutable_array of Immutable_arrays.expression
     | Jexp_layout of Layouts.expression
+    | Jexp_tuple of Labeled_tuples.expression
 
   let of_ast_internal (feat : Feature.t) expr = match feat with
     | Language_extension Local ->
@@ -1084,6 +1219,8 @@ module Expression = struct
     | Language_extension Immutable_arrays ->
       Some (Jexp_immutable_array (Immutable_arrays.of_expr expr))
     | Language_extension Layouts -> Some (Jexp_layout (Layouts.of_expr expr))
+    | Language_extension Labeled_tuples ->
+      Some (Jexp_tuple (Labeled_tuples.of_expr expr))
     | _ -> None
 
   let of_ast = Expression.make_of_ast ~of_ast_internal
@@ -1093,6 +1230,7 @@ module Expression = struct
     | Jexp_comprehension    x -> Comprehensions.expr_of    ~loc ~attrs x
     | Jexp_immutable_array  x -> Immutable_arrays.expr_of  ~loc ~attrs x
     | Jexp_layout x -> Layouts.expr_of ~loc ~attrs x
+    | Jexp_tuple x -> Labeled_tuples.expr_of ~loc ~attrs x
 end
 
 module Pattern = struct
@@ -1100,6 +1238,7 @@ module Pattern = struct
     | Jpat_local           of Local.pattern
     | Jpat_immutable_array of Immutable_arrays.pattern
     | Jpat_layout of Layouts.pattern
+    | Jpat_tuple of Labeled_tuples.pattern
 
   let of_ast_internal (feat : Feature.t) pat = match feat with
     | Language_extension Local ->
@@ -1108,6 +1247,8 @@ module Pattern = struct
       Some (Jpat_immutable_array (Immutable_arrays.of_pat pat))
     | Language_extension Layouts ->
       Some (Jpat_layout (Layouts.of_pat pat))
+    | Language_extension Labeled_tuples ->
+      Some (Jpat_tuple (Labeled_tuples.of_pat pat))
     | _ -> None
 
   let of_ast = Pattern.make_of_ast ~of_ast_internal
@@ -1116,6 +1257,7 @@ module Pattern = struct
     | Jpat_local x -> Local.pat_of ~loc ~attrs x
     | Jpat_immutable_array x -> Immutable_arrays.pat_of ~loc ~attrs x
     | Jpat_layout x -> Layouts.pat_of ~loc ~attrs x
+    | Jpat_tuple x -> Labeled_tuples.pat_of ~loc ~attrs x
 end
 
 module Module_type = struct
diff --git a/vendor/parser-standard/jane_syntax.mli b/vendor/parser-standard/jane_syntax.mli
index a12cc85929..14484779a1 100644
--- a/vendor/parser-standard/jane_syntax.mli
+++ b/vendor/parser-standard/jane_syntax.mli
@@ -165,6 +165,58 @@ module Immutable_arrays : sig
     pattern -> Parsetree.pattern
 end
 
+
+(** The ASTs for labeled tuples. When we merge this upstream, we'll replace
+    existing [P{typ,exp,pat}_tuple] constructors with these. *)
+module Labeled_tuples : sig
+  type core_type =
+    | Lttyp_tuple of (string option * Parsetree.core_type) list
+        (** [Lttyp_tuple(tl)] represents a product type:
+          - [T1 * ... * Tn]       when [tl] is [(None,T1);...;(None,Tn)]
+          - [L1:T1 * ... * Ln:Tn] when [tl] is [(Some L1,T1);...;(Some Ln,Tn)]
+          - A mix, e.g. [L1:T1,T2] when [tl] is [(Some L1,T1);(None,T2)]
+
+          Invariant: [n >= 2] and there is at least one label.
+      *)
+
+  type expression =
+    | Ltexp_tuple of (string option * Parsetree.expression) list
+        (** [Ltexp_tuple(el)] represents
+          - [(E1, ..., En)]
+              when [el] is [(None, E1);...;(None, En)]
+          - [(~L1:E1, ..., ~Ln:En)]
+              when [el] is [(Some L1, E1);...;(Some Ln, En)]
+          - A mix, e.g.:
+              [(~L1:E1, E2)] when [el] is [(Some L1, E1); (None, E2)]
+
+          Invariant: [n >= 2] and there is at least one label.
+      *)
+
+  type pattern =
+    | Ltpat_tuple of
+        (string option * Parsetree.pattern) list * Asttypes.closed_flag
+        (** [Ltpat_tuple(pl, Closed)] represents
+          - [(P1, ..., Pn)]       when [pl] is [(None, P1);...;(None, Pn)]
+          - [(L1:P1, ..., Ln:Pn)] when [pl] is
+                                              [(Some L1, P1);...;(Some Ln, Pn)]
+          - A mix, e.g. [(L1:P1, P2)] when [pl] is [(Some L1, P1);(None, P2)]
+          - If pattern is open, then it also ends in a [..]
+
+        Invariant:
+        - If Closed, [n >= 2] and there is at least one label.
+        - If Open, [n >= 1]
+      *)
+
+  val typ_of : loc:Location.t -> attrs:Parsetree.attributes
+    -> core_type -> Parsetree.core_type
+
+  val expr_of : loc:Location.t -> attrs:Parsetree.attributes
+     -> expression -> Parsetree.expression
+
+  val pat_of : loc:Location.t -> attrs:Parsetree.attributes
+     -> pattern -> Parsetree.pattern
+end
+
 (** The ASTs for [include functor].  When we merge this upstream, we'll merge
     these into the existing [P{sig,str}_include] constructors (similar to what
     we did with [T{sig,str}_include], but without depending on typechecking). *)
@@ -389,6 +441,7 @@ module Core_type : sig
   type t =
     | Jtyp_local of Local.core_type
     | Jtyp_layout of Layouts.core_type
+    | Jtyp_tuple of Labeled_tuples.core_type
 
   include AST
     with type t := t * Parsetree.attributes
@@ -415,6 +468,7 @@ module Expression : sig
     | Jexp_comprehension    of Comprehensions.expression
     | Jexp_immutable_array  of Immutable_arrays.expression
     | Jexp_layout of Layouts.expression
+    | Jexp_tuple of Labeled_tuples.expression
 
   include AST
     with type t := t * Parsetree.attributes
@@ -427,6 +481,7 @@ module Pattern : sig
     | Jpat_local           of Local.pattern
     | Jpat_immutable_array of Immutable_arrays.pattern
     | Jpat_layout of Layouts.pattern
+    | Jpat_tuple of Labeled_tuples.pattern
 
   include AST
     with type t := t * Parsetree.attributes
diff --git a/vendor/parser-standard/language_extension.ml b/vendor/parser-standard/language_extension.ml
index 141e8b7f7b..cfb951a7b3 100644
--- a/vendor/parser-standard/language_extension.ml
+++ b/vendor/parser-standard/language_extension.ml
@@ -51,6 +51,7 @@ let get_level_ops : type a. a t -> (module Extension_level with type t = a) =
   | Module_strengthening -> (module Unit)
   | Layouts -> (module Maturity)
   | SIMD -> (module Unit)
+  | Labeled_tuples -> (module Unit)
 
 type extn_pair = Exist_pair.t = Pair : 'a t * 'a -> extn_pair
 type exist = Exist.t = Pack : _ t -> exist
@@ -75,8 +76,10 @@ let equal_t (type a b) (a : a t) (b : b t) : (a, b) Misc.eq option = match a, b
   | Module_strengthening, Module_strengthening -> Some Refl
   | Layouts, Layouts -> Some Refl
   | SIMD, SIMD -> Some Refl
+  | Labeled_tuples, Labeled_tuples -> Some Refl
   | (Comprehensions | Local | Include_functor | Polymorphic_parameters |
-     Immutable_arrays | Module_strengthening | Layouts | SIMD), _ -> None
+     Immutable_arrays | Module_strengthening | Layouts | SIMD |
+     Labeled_tuples ), _ -> None
 
 let equal a b = Option.is_some (equal_t a b)
 
@@ -171,6 +174,7 @@ let default_extensions : extn_pair list =
   [ Pair (Local, ())
   ; Pair (Include_functor, ())
   ; Pair (Polymorphic_parameters, ())
+  ; Pair (Labeled_tuples, ())
   ]
 let extensions : extn_pair list ref = ref default_extensions
 
diff --git a/vendor/parser-standard/language_extension.mli b/vendor/parser-standard/language_extension.mli
index e685e34959..ae7b3da4ed 100644
--- a/vendor/parser-standard/language_extension.mli
+++ b/vendor/parser-standard/language_extension.mli
@@ -17,6 +17,7 @@ type 'a t = 'a Language_extension_kernel.t =
   | Module_strengthening : unit t
   | Layouts : maturity t
   | SIMD : unit t
+  | Labeled_tuples : unit t
 
 (** Existentially packed language extension *)
 module Exist : sig
diff --git a/vendor/parser-standard/language_extension_kernel.ml b/vendor/parser-standard/language_extension_kernel.ml
index eae564c13d..41de716572 100644
--- a/vendor/parser-standard/language_extension_kernel.ml
+++ b/vendor/parser-standard/language_extension_kernel.ml
@@ -10,6 +10,7 @@ type _ t =
   | Module_strengthening : unit t
   | Layouts : maturity t
   | SIMD : unit t
+  | Labeled_tuples : unit t
 
 type 'a language_extension_kernel = 'a t
 
@@ -25,6 +26,7 @@ module Exist = struct
     ; Pack Module_strengthening
     ; Pack Layouts
     ; Pack SIMD
+    ; Pack Labeled_tuples
     ]
 end
 
@@ -42,6 +44,7 @@ let to_string : type a. a t -> string = function
   | Module_strengthening -> "module_strengthening"
   | Layouts -> "layouts"
   | SIMD -> "simd"
+  | Labeled_tuples -> "labeled_tuples"
 
 (* converts full extension names, like "layouts_alpha" to a pair of
    an extension and its maturity. For extensions that don't take an
@@ -59,6 +62,7 @@ let pair_of_string extn_name : Exist_pair.t option =
   | "layouts_alpha" -> Some (Pair (Layouts, Alpha))
   | "layouts_beta" -> Some (Pair (Layouts, Beta))
   | "simd" -> Some (Pair (SIMD, ()))
+  | "labeled_tuples" -> Some (Pair (Labeled_tuples, ()))
   | _ -> None
 
 let maturity_to_string = function
@@ -88,6 +92,7 @@ let is_erasable : type a. a t -> bool = function
   | Polymorphic_parameters
   | Immutable_arrays
   | Module_strengthening
+  | Labeled_tuples
   | SIMD ->
       false
 
diff --git a/vendor/parser-standard/language_extension_kernel.mli b/vendor/parser-standard/language_extension_kernel.mli
index 7ccbd98160..9d115aae81 100644
--- a/vendor/parser-standard/language_extension_kernel.mli
+++ b/vendor/parser-standard/language_extension_kernel.mli
@@ -19,6 +19,7 @@ type _ t =
   | Module_strengthening : unit t
   | Layouts : maturity t
   | SIMD : unit t
+  | Labeled_tuples : unit t
 
 module Exist : sig
   type 'a extn = 'a t
diff --git a/vendor/parser-standard/parser.mly b/vendor/parser-standard/parser.mly
index a90fafc537..108a49ecc6 100644
--- a/vendor/parser-standard/parser.mly
+++ b/vendor/parser-standard/parser.mly
@@ -178,6 +178,16 @@ let local_if : type ast. ast Local_syntax_category.t -> _ -> _ -> ast -> ast =
   else
     x
 
+let local_if_has_flags flags sloc x =
+  (* Jane Street: This is horrible temporary code until we properly add
+     support for more modes. *)
+  let is_local =
+    match flags with
+    | [] -> false
+    | _ :: _ -> true
+  in
+  local_if Type is_local sloc x
+
 let global_if global_flag sloc carg =
   match global_flag with
   | Global ->
@@ -303,6 +313,30 @@ let removed_string_set loc =
   raise(Syntaxerr.Error(Syntaxerr.Removed_string_set(make_loc loc)))
 *)
 
+let ppat_lttuple loc elts closed =
+  Jane_syntax.Labeled_tuples.pat_of
+    ~attrs:[]
+    ~loc:(make_loc loc)
+    (Ltpat_tuple (elts, closed))
+
+let ptyp_lttuple loc tl =
+  Jane_syntax.Labeled_tuples.typ_of
+    ~attrs:[]
+    ~loc:(make_loc loc)
+    (Lttyp_tuple tl)
+
+let mktyp_tuple loc ltys =
+  if List.for_all (fun (lbl, _) -> Option.is_none lbl) ltys then
+    mktyp ~loc (Ptyp_tuple (List.map snd ltys))
+  else
+    ptyp_lttuple loc ltys
+
+let pexp_lttuple loc args =
+  Jane_syntax.Labeled_tuples.expr_of
+    ~attrs:[]
+    ~loc:(make_loc loc)
+    (Ltexp_tuple args)
+
 (* Using the function [not_expecting] in a semantic action means that this
    syntactic form is recognized by the parser but is in fact incorrect. This
    idiom is used in a few places to produce ad hoc syntax error messages. *)
@@ -2540,7 +2574,7 @@ expr:
   | expr_attrs
       { let desc, attrs = $1 in
         mkexp_attrs ~loc:$sloc desc attrs }
-  | mkexp(expr_)
+  | expr_
       { $1 }
   | let_bindings(ext) IN seq_expr
       { expr_of_let_bindings ~loc:$sloc $1 $3 }
@@ -2630,15 +2664,19 @@ expr:
 ;
 %inline expr_:
   | simple_expr nonempty_llist(labeled_simple_expr)
-      { Pexp_apply($1, $2) }
-  | expr_comma_list %prec below_COMMA
-      { Pexp_tuple($1) }
+      { mkexp ~loc:$sloc (Pexp_apply($1, $2)) }
+  | labeled_tuple %prec below_COMMA
+      { if List.for_all (fun (l,_) -> Option.is_none l) $1 then
+          mkexp ~loc:$sloc (Pexp_tuple (List.map snd $1))
+        else
+          pexp_lttuple $sloc $1
+      }
   | mkrhs(constr_longident) simple_expr %prec below_HASH
-      { Pexp_construct($1, Some $2) }
+      { mkexp ~loc:$sloc (Pexp_construct($1, Some $2)) }
   | name_tag simple_expr %prec below_HASH
-      { Pexp_variant($1, Some $2) }
+      { mkexp ~loc:$sloc (Pexp_variant($1, Some $2)) }
   | e1 = expr op = op(infix_operator) e2 = expr
-      { mkinfix e1 op e2 }
+      { mkexp ~loc:$sloc (mkinfix e1 op e2) }
 ;
 
 simple_expr:
@@ -3054,10 +3092,86 @@ fun_def:
   | LPAREN TYPE mkrhs(LIDENT) COLON layout_annotation RPAREN fun_def
       { mk_newtypes ~loc:$sloc [$3, Some $5] $7 }
 ;
-%inline expr_comma_list:
-  es = separated_nontrivial_llist(COMMA, expr)
-    { es }
+
+(* Parsing labeled tuple expressions
+
+   The grammar we want to parse is something like:
+
+     labeled_tuple_element := expr | ~x:expr | ~x | ~(x:ty)
+     labeled_tuple := lt_element [, lt_element]+
+
+   (The last case of [labeled_tuple_element] is a punned label with a type
+   constraint, which is allowed for functions, so we allow it here).
+
+   So you might think [labeled_tuple] could therefore just be:
+
+     labeled_tuple :
+       separated_nontrivial_llist(COMMA, labeled_tuple_element)
+
+   But this doesn't work:
+
+   - If we don't mark [labeled_tuple_element] %inline, this causes many
+     reduce/reduce conflicts (basically just ambiguities) because
+     [labeled_tuple_element] trivially reduces to [expr].
+
+   - If we do mark [labeled_tuple_element] %inline, it is not allowed to have
+     %prec annotations.  Menhir doesn't permit these on %inline non-terminals
+     that are used in non-tail position.
+
+   To get around this, we do mark it inlined, and then because we can only use
+   it in tail position it is _manually_ inlined into the occurrences in
+   [separated_nontrivial_llist] where it doesn't appear in tail position.  This
+   results in [labeled_tuple] and [reversed_labeled_tuple_body] below.  So the
+   latter is just a list of comma-separated labeled tuple elements, with length
+   at least two, where the first element in the base case is inlined (resulting
+   in one base case for each case of [labeled_tuple_element].  *)
+%inline labeled_tuple_element :
+  | expr
+     { None, $1 }
+  | LABEL simple_expr %prec below_HASH
+     { Some $1, $2 }
+  | TILDE label = LIDENT
+     { let loc = $loc(label) in
+       Some label, mkexpvar ~loc label }
+  | TILDE LPAREN label = LIDENT ty = type_constraint RPAREN %prec below_HASH
+      { Some label,
+        mkexp_constraint
+          ~loc:($startpos($2), $endpos) (mkexpvar ~loc:$loc(label) label) ty }
+;
+reversed_labeled_tuple_body:
+  (* > 2 elements *)
+  xs = reversed_labeled_tuple_body
+  COMMA
+  x = labeled_tuple_element
+    { x :: xs }
+  (* base cases (2 elements) *)
+| x1 = expr
+  COMMA
+  x2 = labeled_tuple_element
+    { [ x2; None, x1 ] }
+| l1 = LABEL x1 = simple_expr
+  COMMA
+  x2 = labeled_tuple_element
+    { [ x2; Some l1, x1 ] }
+| TILDE l1 = LIDENT
+  COMMA
+  x2 = labeled_tuple_element
+  { let loc = $loc(l1) in
+    [ x2; Some l1, mkexpvar ~loc l1] }
+| TILDE LPAREN l1 = LIDENT ty1 = type_constraint RPAREN
+  COMMA
+  x2 = labeled_tuple_element
+  { let x1 =
+      mkexp_constraint
+        ~loc:($startpos($2), $endpos) (mkexpvar ~loc:$loc(l1) l1) ty1
+    in
+    [ x2; Some l1, x1] }
+;
+%inline labeled_tuple:
+  xs = rev(reversed_labeled_tuple_body)
+    { xs }
 ;
+
 record_expr_content:
   eo = ioption(terminated(simple_expr, WITH))
   fields = separated_or_terminated_nonempty_list(SEMI, record_expr_field)
@@ -3162,8 +3276,6 @@ pattern_no_exn:
         { Ppat_alias($1, $3) }
     | self AS error
         { expecting $loc($3) "identifier" }
-    | pattern_comma_list(self) %prec below_COMMA
-        { Ppat_tuple(List.rev $1) }
     | self COLONCOLON error
         { expecting $loc($3) "pattern" }
     | self BAR pattern
@@ -3171,8 +3283,71 @@ pattern_no_exn:
     | self BAR error
         { expecting $loc($3) "pattern" }
   ) { $1 }
+  | reversed_labeled_tuple_pattern(self)
+      { let closed, pats = $1 in
+        if    closed = Closed
+           && List.for_all (fun (l,_) -> Option.is_none l) pats
+        then
+          mkpat ~loc:$sloc (Ppat_tuple(List.rev_map snd pats))
+        else
+          ppat_lttuple $sloc (List.rev pats) closed
+      }
 ;
 
+(* Parsing labeled tuple patterns
+
+   Here we play essentially the same game we did for expressions - see the
+   comment beginning "Parsing labeled tuple expressions".
+
+   One difference is that we would need to manually inline the definition of
+   individual elements in two places: Once in the base case for lists 2 or more
+   elements, and once in the special case for open patterns with just one
+   element (e.g., [~x, ..]).  Rather than manually inlining
+   [labeled_tuple_pat_element] twice, we simply define it twice: once with the
+   [%prec] annotations needed for its occurrences in tail position, and once
+   without them suitable for use in other locations.
+*)
+%inline labeled_tuple_pat_element(self):
+  | self { None, $1 }
+  | LABEL simple_pattern %prec COMMA
+      { Some $1, $2 }
+  | TILDE label = LIDENT
+      { let loc = $loc(label) in
+        Some label, mkpatvar ~loc label }
+  | TILDE LPAREN label = LIDENT COLON cty = core_type RPAREN %prec COMMA
+      { let loc = $loc(label) in
+        let pat = mkpatvar ~loc label in
+        Some label, mkpat_opt_constraint ~loc pat (Some cty) }
+
+%inline labeled_tuple_pat_element_noprec(self):
+  | self { None, $1 }
+  | LABEL simple_pattern
+      { Some $1, $2 }
+  | TILDE label = LIDENT
+      { let loc = $loc(label) in
+        Some label, mkpatvar ~loc label }
+  | TILDE LPAREN label = LIDENT COLON cty = core_type RPAREN
+      { let loc = $loc(label) in
+        let pat = mkpatvar ~loc label in
+        Some label, mkpat_opt_constraint ~loc pat (Some cty) }
+
+labeled_tuple_pat_element_list(self):
+  | labeled_tuple_pat_element_list(self) COMMA labeled_tuple_pat_element(self)
+      { $3 :: $1 }
+  | labeled_tuple_pat_element_noprec(self) COMMA labeled_tuple_pat_element(self)
+      { [ $3; $1 ] }
+  | self COMMA error
+      { expecting $loc($3) "pattern" }
+;
+
+reversed_labeled_tuple_pattern(self):
+  | labeled_tuple_pat_element_list(self) %prec below_COMMA
+      { Closed, $1 }
+  | labeled_tuple_pat_element_list(self) COMMA DOTDOT
+      { Open, $1 }
+  | labeled_tuple_pat_element_noprec(self) COMMA DOTDOT
+      { Open, [ $1 ] }
+
 pattern_gen:
     simple_pattern
       { $1 }
@@ -3274,11 +3449,6 @@ simple_delimited_pattern:
             $1 }
   ) { $1 }
 
-pattern_comma_list(self):
-    pattern_comma_list(self) COMMA pattern      { $3 :: $1 }
-  | self COMMA pattern                          { [$3; $1] }
-  | self COMMA error                            { expecting $loc($3) "pattern" }
-;
 %inline pattern_semi_list:
   ps = separated_or_terminated_nonempty_list(SEMI, pattern)
     { ps }
@@ -3860,35 +4030,95 @@ function_type:
   | ty = tuple_type
     %prec MINUSGREATER
       { ty }
-  | ty = strict_function_type
+  | ty = strict_function_or_labeled_tuple_type
       { ty }
 ;
 
-strict_function_type:
+strict_function_or_labeled_tuple_type:
   | mktyp(
       label = arg_label
-      local = optional_local
+      unique_local = mode_flags
       domain = extra_rhs(param_type)
       MINUSGREATER
-      codomain = strict_function_type
-        { Ptyp_arrow(label, local_if Type local $loc(local) domain, codomain) }
+      codomain = strict_function_or_labeled_tuple_type
+        { Ptyp_arrow(label,
+                     local_if_has_flags unique_local $loc(unique_local) domain,
+                     codomain) }
     )
     { $1 }
   | mktyp(
       label = arg_label
-      arg_local = optional_local
+      arg_local = mode_flags
       domain = extra_rhs(param_type)
       MINUSGREATER
-      ret_local = optional_local
+      ret_local = mode_flags
       codomain = tuple_type
       %prec MINUSGREATER
         { Ptyp_arrow(label,
-            local_if Type arg_local $loc(arg_local) domain,
-            local_if Type ret_local $loc(ret_local)
+            local_if_has_flags arg_local $loc(arg_local) domain,
+            local_if_has_flags ret_local $loc(ret_local)
+              (Jane_syntax.Builtin.mark_curried
+                 ~loc:(make_loc $loc(codomain)) codomain)) }
+    )
+    { $1 }
+  (* These next three cases are for labled tuples - see comment on [tuple_type]
+     below.
+
+     The first two cases are present just to resolve a shift reduce conflict
+     in a module type [S with t := x:t1 * t2 -> ...] which might be the
+     beginning of
+       [S with t := x:t1 * t2 -> S']    or    [S with t := x:t1 * t2 -> t3]
+     They are the same as the previous two cases, but with [arg_label] replaced
+     with the more specific [LIDENT COLON] and [param_type] replaced with the
+     more specific [proper_tuple_type].  Apparently, this is sufficient for
+     menhir to be able to delay a decision about which of the above module type
+     cases we are in.  *)
+  | mktyp(
+      label = LIDENT COLON
+      local = mode_flags
+      tuple = proper_tuple_type
+      MINUSGREATER
+      codomain = strict_function_or_labeled_tuple_type
+         {
+           let ty, ltys = tuple in
+           let label = Labelled label in
+           let domain = mktyp_tuple $loc(tuple) ((None, ty) :: ltys) in
+           let domain = extra_rhs_core_type domain ~pos:$endpos(tuple) in
+           Ptyp_arrow(label, local_if_has_flags local $loc(local) domain , codomain) }
+    )
+    { $1 }
+  | mktyp(
+      label = LIDENT COLON
+      arg_local = mode_flags
+      tuple = proper_tuple_type
+      MINUSGREATER
+      ret_local = mode_flags
+      codomain = tuple_type
+         { let ty, ltys = tuple in
+           let label = Labelled label in
+           let domain = mktyp_tuple $loc(tuple) ((None, ty) :: ltys) in
+           let domain = extra_rhs_core_type domain ~pos:$endpos(tuple) in
+           Ptyp_arrow(label,
+            local_if_has_flags arg_local $loc(arg_local) domain ,
+            local_if_has_flags ret_local $loc(ret_local)
               (Jane_syntax.Builtin.mark_curried
                  ~loc:(make_loc $loc(codomain)) codomain)) }
     )
     { $1 }
+  | label = LIDENT COLON proper_tuple_type %prec MINUSGREATER
+    { let ty, ltys = $3 in
+      ptyp_lttuple $sloc ((Some label, ty) :: ltys)
+    }
+;
+(* jane street: hackily copied and modified from our parser - to be replaced with the
+   exact version from our parser when ocamlformat is updated for uniqueness. *)
+%inline mode_flag:
+   | LOCAL
+       { $sloc }
+;
+%inline mode_flags:
+   | flags = iloption(mode_flag+)
+       { flags }
 ;
 %inline param_type:
   | mktyp_jane_syntax_ltyp(
@@ -3899,11 +4129,15 @@ strict_function_type:
   | ty = tuple_type
     { ty }
 ;
-%inline arg_label:
+%inline strict_arg_label:
   | label = optlabel
       { Optional label }
   | label = LIDENT COLON
       { Labelled label }
+
+%inline arg_label:
+  | strict_arg_label
+      { $1 }
   | /* empty */
       { Nolabel }
 ;
@@ -3917,18 +4151,36 @@ strict_function_type:
    - atomic types (see below);
    - proper tuple types:                  int * int * int list
    A proper tuple type is a star-separated list of at least two atomic types.
+   Tuple components can also be labeled, as an [int * int list * y:bool].
+
+   However, the special case of labeled tuples where the first element has a
+   label is not parsed as a proper_tuple_type, but rather as a case of
+   strict_function_or_labled_tuple_type above.  This helps in dealing with
+   ambiguities around [x:t1 * t2 -> t3] which must continue to parse as a
+   function with one labeled argument even in the presense of labled tuples.
  *)
 tuple_type:
   | ty = atomic_type
     %prec below_HASH
       { ty }
-  | mktyp(
-      tys = separated_nontrivial_llist(STAR, atomic_type)
-        { Ptyp_tuple tys }
-    )
-    { $1 }
+  | proper_tuple_type %prec below_FUNCTOR
+    { let ty, ltys = $1 in
+      mktyp_tuple $sloc ((None, ty) :: ltys)
+    }
 ;
 
+%inline proper_tuple_type:
+  | ty = atomic_type
+    STAR
+    ltys = separated_nonempty_llist(STAR, labeled_tuple_typ_element)
+      { ty, ltys }
+
+%inline labeled_tuple_typ_element :
+  | atomic_type %prec STAR
+     { None, $1 }
+  | label = LIDENT COLON ty = atomic_type %prec STAR
+     { Some label, ty }
+
 (* Atomic types are the most basic level in the syntax of types.
    Atomic types include:
    - types between parentheses:           (int -> int)