diff --git a/CHANGES.md b/CHANGES.md
index 7eb2723c7d..f68d943ccb 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -8,7 +8,7 @@ profile. This started with version 0.26.0.
 
 ### Added 
 
-- Support for OCaml 5.4 (#2717, @Julow)
+- Support for OCaml 5.4 (#2717, #2720, @Julow, @Octachron)
 
 - Added option `module-indent` option (#2711, @HPRIOR) to control the indentation
   of items within modules. This affects modules and signatures. For example, 
diff --git a/lib/Ast.ml b/lib/Ast.ml
index b65a4a80bf..8398c31132 100644
--- a/lib/Ast.ml
+++ b/lib/Ast.ml
@@ -61,8 +61,8 @@ let longident_is_simple c x =
   let rec length x =
     match x with
     | Longident.Lident x -> String.length x
-    | Ldot (x, y) -> length x + 1 + String.length y
-    | Lapply (x, y) -> length x + length y + 3
+    | Ldot (x, y) -> length x.txt + 1 + String.length y.txt
+    | Lapply (x, y) -> length x.txt + length y.txt + 3
   in
   longident_fit_margin c (length x)
 
@@ -977,14 +977,15 @@ 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:snd_f)
+      | Ptyp_constr (_, t1N) -> assert (List.exists t1N ~f)
       | Ptyp_variant (r1N, _, _) ->
           assert (
             List.exists r1N ~f:(function
               | {prf_desc= Rtag (_, _, t1N); _} -> List.exists t1N ~f
               | {prf_desc= Rinherit t1; _} -> typ == t1 ) )
       | Ptyp_open (_, t1) -> assert (t1 == typ)
-      | Ptyp_package (_, it1N, _) -> assert (List.exists it1N ~f:snd_f)
+      | Ptyp_package ptyp -> assert (List.exists ptyp.ppt_cstrs ~f:snd_f)
       | Ptyp_object (fields, _) ->
           assert (
             List.exists fields ~f:(function
@@ -1017,15 +1018,15 @@ end = struct
       match ctx.ppat_desc with
       | Ppat_constraint (_, t1) -> assert (typ == t1)
       | Ppat_extension (_, PTyp t) -> assert (typ == t)
-      | Ppat_unpack (_, Some (_, l, _)) ->
-          assert (List.exists l ~f:(fun (_, t) -> typ == t))
+      | Ppat_unpack (_, Some ptyp) ->
+          assert (List.exists ptyp.ppt_cstrs ~f:(fun (_, t) -> typ == t))
       | Ppat_record (l, _) ->
           assert (List.exists l ~f:(fun (_, t, _) -> Option.exists t ~f))
       | _ -> assert false )
     | Exp ctx -> (
       match ctx.pexp_desc with
-      | Pexp_pack (_, Some (_, it1N, _), _) ->
-          assert (List.exists it1N ~f:snd_f)
+      | Pexp_pack (_, Some ptyp, _) ->
+          assert (List.exists ptyp.ppt_cstrs ~f:snd_f)
       | Pexp_constraint (_, t1)
        |Pexp_coerce (_, None, t1)
        |Pexp_extension (_, PTyp t1) ->
@@ -1063,7 +1064,7 @@ end = struct
     | Mod ctx -> (
       match ctx.pmod_desc with
       | Pmod_unpack (_, ty1, ty2) ->
-          let f (_, cstrs, _) = List.exists cstrs ~f:(fun (_, x) -> f x) in
+          let f ptyp = List.exists ptyp.ppt_cstrs ~f:snd_f in
           assert (Option.exists ty1 ~f || Option.exists ty2 ~f)
       | _ -> assert false )
     | Sig ctx -> (
@@ -1255,7 +1256,9 @@ end = struct
     | Pat ctx -> (
         let f pI = pI == pat in
         match ctx.ppat_desc with
-        | Ppat_array p1N | Ppat_list p1N | Ppat_tuple p1N | Ppat_cons p1N ->
+        | Ppat_tuple (p1N, _) ->
+            assert (List.exists p1N ~f:(fun (_, x) -> f x))
+        | Ppat_array p1N | Ppat_list p1N | Ppat_cons p1N ->
             assert (List.exists p1N ~f)
         | Ppat_record (p1N, _) ->
             assert (List.exists p1N ~f:(fun (_, _, x) -> Option.exists x ~f))
@@ -1423,7 +1426,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:snd_f)
+        | 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)
@@ -1529,7 +1533,10 @@ 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_tuple e1N ->
+        List.for_all e1N ~f:(snd >> Exp.is_trivial)
+        && fit_margin c (width xexp)
+    | Pexp_array e1N | Pexp_list e1N ->
         List.for_all e1N ~f:Exp.is_trivial && fit_margin c (width xexp)
     | Pexp_record (e1N, e0) ->
         Option.for_all e0 ~f:Exp.is_trivial
@@ -1631,7 +1638,7 @@ end = struct
     | {ast= Typ _; _} -> None
     | {ctx= Exp {pexp_desc; _}; ast= Exp exp} -> (
       match pexp_desc with
-      | Pexp_tuple (e0 :: _) ->
+      | Pexp_tuple ((_, e0) :: _) ->
           Some (Comma, if exp == e0 then Left else Right)
       | Pexp_cons l ->
           Some (ColonColon, if exp == List.last_exn l then Right else Left)
@@ -1848,6 +1855,9 @@ end = struct
           ( Str {pstr_desc= Pstr_exception _; _}
           | Sig {psig_desc= Psig_exception _; _} ) } ->
         true
+    | { ast= {ptyp_desc= Ptyp_tuple ((Some _, _) :: _); _}
+      ; ctx= Typ {ptyp_desc= Ptyp_arrow _; _} } ->
+        true
     | _ -> (
       match ambig_prec (sub_ast ~ctx (Typ typ)) with
       | `Ambiguous -> true
@@ -2087,7 +2097,7 @@ end = struct
          |Pexp_try (_, cases, _) ->
             continue (List.last_exn cases).pc_rhs
         | 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)
@@ -2168,7 +2178,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)
@@ -2220,7 +2230,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/Conf.ml b/lib/Conf.ml
index 469ef89044..995f87c8e8 100644
--- a/lib/Conf.ml
+++ b/lib/Conf.ml
@@ -1068,7 +1068,10 @@ module Formatting = struct
 
   let module_indent =
     let docv = "COLS" in
-    let doc = "Indentation of items within struct ... end and sig ... end ($(docv) columns)." in
+    let doc =
+      "Indentation of items within struct ... end and sig ... end ($(docv) \
+       columns)."
+    in
     let names = ["module-indent"] in
     Decl.int ~names ~default ~doc ~docv ~kind
       (fun conf elt -> update conf ~f:(fun f -> {f with module_indent= elt}))
diff --git a/lib/Exposed.ml b/lib/Exposed.ml
index c094ee92e4..9cee9a4f65 100644
--- a/lib/Exposed.ml
+++ b/lib/Exposed.ml
@@ -15,7 +15,7 @@ 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 -> core_type (snd @@ List.hd_exn l)
     | Ptyp_object _ -> true
     | Ptyp_alias (typ, _) -> core_type typ
     | _ -> false
@@ -29,7 +29,7 @@ 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 -> core_type (snd @@ List.last_exn l)
       | Ptyp_object _ -> true
       | _ -> false )
 
diff --git a/lib/Extended_ast.ml b/lib/Extended_ast.ml
index 2e2347997d..37285bb79a 100644
--- a/lib/Extended_ast.ml
+++ b/lib/Extended_ast.ml
@@ -222,26 +222,6 @@ module Parse = struct
              && not (Std_longident.is_monadic_binding longident) ->
           let label_loc = {txt= op; loc= loc_op} in
           {e with pexp_desc= Pexp_infix (label_loc, m.expr m l, m.expr m r)}
-      (* [(module M) : (module T)] -> [(module M : T)] *)
-      | { pexp_desc=
-            Pexp_constraint
-              ( { pexp_desc=
-                    Pexp_pack (name, None, {infix_ext= None; infix_attrs= []})
-                ; pexp_attributes= []
-                ; pexp_loc
-                ; _ }
-              , {ptyp_desc= Ptyp_package pt; ptyp_attributes= []; ptyp_loc; _}
-              )
-        ; _ } as p
-        when Migrate_ast.Location.compare_start ptyp_loc pexp_loc > 0 ->
-          (* Match locations to differentiate between the two position for
-             the constraint, we want to shorten the second: - [let _ :
-             (module S) = (module M)] - [let _ = ((module M) : (module
-             S))] *)
-          { p with
-            pexp_desc=
-              Pexp_pack (name, Some pt, {infix_ext= None; infix_attrs= []})
-          }
       | e -> Ast_mapper.default_mapper.expr m e
     in
     Ast_mapper.{default_mapper with expr; pat; binding_op}
diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml
index a8be43cb62..f962b7a0b5 100644
--- a/lib/Fmt_ast.ml
+++ b/lib/Fmt_ast.ml
@@ -239,28 +239,33 @@ let fmt_recmodule c ctx items fmt_item ast sub =
 (* In several places, a break such as [Fmt.force_break] is used to force the
    enclosing box to break across multiple lines. *)
 
-let rec fmt_longident (li : Longident.t) =
+let fmt_str_loc c ?pre {txt; loc} = Cmts.fmt c loc (opt pre str $ str txt)
+
+let rec fmt_longident c (li : Longident.t) =
   let fmt_id id =
     wrap_if
       (Std_longident.String_id.is_symbol id)
       (str "( ") (str " )") (str id)
   in
+  let fmt_id_loc c id =
+    wrap_if
+      (Std_longident.String_id.is_symbol id.txt)
+      (str "( ") (str " )") (fmt_str_loc c id)
+  in
   match li with
   | Lident id -> fmt_id id
   | Ldot (li, id) ->
-      hvbox 0 (fmt_longident li $ cut_break $ str "." $ fmt_id id)
+      hvbox 0 (fmt_longident_loc c li $ cut_break $ str "." $ fmt_id_loc c id)
   | Lapply (li1, li2) ->
       hvbox 2
-        ( fmt_longident li1
-        $ wrap (cut_break $ str "(") (str ")") (fmt_longident li2) )
-
-let fmt_longident_loc c ?pre {txt; loc} =
-  Cmts.fmt c loc (opt pre str $ fmt_longident txt)
+        ( fmt_longident_loc c li1
+        $ wrap (cut_break $ str "(") (str ")") (fmt_longident_loc c li2) )
 
-let str_longident x =
-  Format_.asprintf "%a" (fun fs x -> eval fs (fmt_longident x)) x
+and fmt_longident_loc c ?pre {txt; loc} =
+  Cmts.fmt c loc (opt pre str $ fmt_longident c txt)
 
-let fmt_str_loc c ?pre {txt; loc} = Cmts.fmt c loc (opt pre str $ str txt)
+let str_longident c x =
+  Format_.asprintf "%a" (fun fs x -> eval fs (fmt_longident c x)) x
 
 let fmt_str_loc_opt c ?pre ?(default = "_") {txt; loc} =
   Cmts.fmt c loc (opt pre str $ str (Option.value ~default txt))
@@ -368,6 +373,12 @@ let fmt_label lbl sep =
   | Labelled l -> str "~" $ str l.txt $ sep
   | Optional l -> str "?" $ str l.txt $ sep
 
+let fmt_tuple_label sym lbl sep =
+  (* No comment can be attached here. *)
+  match lbl with
+  | None -> noop
+  | Some l -> sym $ str l $ sep
+
 let fmt_direction_flag = function
   | Upto -> space_break $ str "to "
   | Downto -> space_break $ str "downto "
@@ -918,11 +929,13 @@ and fmt_core_type c ?(box = true) ?pro ?(pro_space = true) ?constraint_ctx
         $ space_break $ fmt_longident_loc c lid )
   | Ptyp_extension ext ->
       hvbox c.conf.fmt_opts.extension_indent.v (fmt_extension c ctx ext)
-  | Ptyp_package (id, cnstrs, attrs) ->
-      hvbox 2
-        ( hovbox 0 (str "module" $ space_break $ fmt_longident_loc c id)
-        $ fmt_package_type c ctx cnstrs
-        $ fmt_attributes c attrs )
+  | Ptyp_package {ppt_path= id; ppt_cstrs= cnstrs; ppt_attrs= attrs; ppt_loc}
+    ->
+      Cmts.fmt c ppt_loc
+      @@ hvbox 2
+           ( hovbox 0 (str "module" $ space_break $ fmt_longident_loc c id)
+           $ fmt_package_type c ctx cnstrs
+           $ fmt_attributes c attrs )
   | Ptyp_open (lid, typ) ->
       hvbox 2
         ( hvbox 0 (fmt_longident_loc c lid $ str ".(")
@@ -953,12 +966,14 @@ and fmt_core_type c ?(box = true) ?pro ?(pro_space = true) ?constraint_ctx
         $ fmt_core_type c ?box:box_core_type ~pro_space:false
             (sub_typ ~ctx t) )
   | Ptyp_tuple typs ->
+      let with_label (lbl, typ) =
+        fmt_tuple_label noop lbl (str ":")
+        $ fmt_core_type c (sub_typ ~ctx typ)
+      in
       hvbox 0
         (wrap_if parenze_constraint_ctx (str "(") (str ")")
            (wrap_fits_breaks_if ~space:false c.conf parens "(" ")"
-              (list typs
-                 (space_break $ str "* ")
-                 (sub_typ ~ctx >> fmt_core_type c) ) ) )
+              (list typs (space_break $ str "* ") with_label) ) )
   | Ptyp_var s -> fmt_type_var s
   | Ptyp_variant (rfs, flag, lbls) ->
       let row_fields rfs =
@@ -1145,13 +1160,33 @@ and fmt_pattern ?ext c ?pro ?parens ?(box = false)
                      (str "( ") (str " )") (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, open_pat) ->
       let parens =
         parens || Poly.(c.conf.fmt_opts.parens_tuple_patterns.v = `Always)
       in
+      let with_label (lbl, pat) =
+        match (lbl, pat) with
+        | ( Some txt
+          , { ppat_desc=
+                ( Ppat_var var
+                | Ppat_constraint ({ppat_desc= Ppat_var var; _}, _) )
+            ; ppat_attributes= []
+            ; _ } )
+          when String.(var.txt = txt) ->
+            str "~" $ fmt_pattern c (sub_pat ~ctx pat)
+        | Some _, {ppat_desc= Ppat_construct _; _} ->
+            fmt_tuple_label (str "~") lbl (str ":")
+            $ fmt_pattern ~parens:true c (sub_pat ~ctx pat)
+        | _ ->
+            fmt_tuple_label (str "~") lbl (str ":")
+            $ fmt_pattern c (sub_pat ~ctx pat)
+      in
+      let close =
+        match open_pat with Open -> str ", .." | Closed -> noop
+      in
       hvbox 0
-        (Params.wrap_tuple ~parens ~no_parens_if_break:false c.conf
-           (List.map pats ~f:(sub_pat ~ctx >> fmt_pattern c)) )
+        (Params.wrap_tuple ~close ~parens ~no_parens_if_break:false c.conf
+           (List.map pats ~f:with_label) )
   | Ppat_construct ({txt= Lident (("()" | "[]") as txt); loc}, None) ->
       let opn = txt.[0] and cls = txt.[1] in
       Cmts.fmt c loc
@@ -1310,14 +1345,17 @@ and fmt_pattern ?ext c ?pro ?parens ?(box = false)
   | Ppat_unpack (name, pt) ->
       let fmt_constraint_opt pt k =
         match pt with
-        | Some (id, cnstrs, attrs) ->
-            hovbox 0
-              (Params.parens_if parens c.conf
-                 (hvbox 1
-                    ( hovbox 0
-                        (k $ space_break $ str ": " $ fmt_longident_loc c id)
-                    $ fmt_package_type c ctx cnstrs
-                    $ fmt_attributes c attrs ) ) )
+        | Some {ppt_path= id; ppt_cstrs= cnstrs; ppt_attrs= attrs; ppt_loc}
+          ->
+            Cmts.fmt c ppt_loc
+            @@ hovbox 0
+                 (Params.parens_if parens c.conf
+                    (hvbox 1
+                       ( hovbox 0
+                           ( k $ space_break $ str ": "
+                           $ fmt_longident_loc c id )
+                       $ fmt_package_type c ctx cnstrs
+                       $ fmt_attributes c attrs ) ) )
         | None -> wrap_fits_breaks_if ~space:false c.conf parens "(" ")" k
       in
       fmt_constraint_opt pt
@@ -2444,7 +2482,7 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
       pro
       $ Cmts.fmt c loc
         @@ wrap_if outer_parens (str "(") (str ")")
-        @@ (fmt_longident txt $ Cmts.fmt_within c loc $ fmt_atrs)
+        @@ (fmt_longident c txt $ Cmts.fmt_within c loc $ fmt_atrs)
   | Pexp_ifthenelse (if_branches, else_) ->
       let outer_parens = parens && has_attr in
       let parens = parens || has_attr in
@@ -2738,11 +2776,14 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
       and epi = cls_paren in
       let fmt_mod m =
         match pt with
-        | Some (id, cnstrs, attrs) ->
-            hvbox 2
-              ( hovbox 0 (m $ space_break $ str ": " $ fmt_longident_loc c id)
-              $ fmt_package_type c ctx cnstrs
-              $ fmt_attributes c attrs )
+        | Some {ppt_path= id; ppt_cstrs= cnstrs; ppt_attrs= attrs; ppt_loc}
+          ->
+            Cmts.fmt c ppt_loc
+            @@ hvbox 2
+                 ( hovbox 0
+                     (m $ space_break $ str ": " $ fmt_longident_loc c id)
+                 $ fmt_package_type c ctx cnstrs
+                 $ fmt_attributes c attrs )
         | None -> m
       in
       outer_pro
@@ -2822,13 +2863,36 @@ 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 with_label (lbl, exp) =
+        match (lbl, exp) with
+        | ( Some txt
+          , { pexp_desc= Pexp_ident {txt= Lident i; loc}
+            ; pexp_attributes= []
+            ; pexp_loc
+            ; _ } )
+          when String.equal i txt ->
+            Cmts.fmt c loc @@ Cmts.fmt c ?eol pexp_loc @@ str "~" $ str txt
+        | ( Some l
+          , { pexp_desc=
+                Pexp_constraint
+                  ({pexp_desc= Pexp_ident {txt= Lident i; _}; _}, _)
+            ; _ } )
+          when String.equal l i && List.is_empty exp.pexp_attributes ->
+            str "~" $ fmt_expression c (sub_exp ~ctx exp)
+        | Some _, {pexp_desc= Pexp_apply _ | Pexp_function _; _} ->
+            fmt_tuple_label (str "~") lbl (str ":")
+            $ fmt_expression ~parens:true c (sub_exp ~ctx exp)
+        | _ ->
+            fmt_tuple_label (str "~") lbl (str ":")
+            $ fmt_expression c (sub_exp ~ctx 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.map es ~f:(sub_exp ~ctx >> fmt_expression c)) )
+                    (List.map es ~f:with_label) )
              $ fmt_atrs ) )
   | Pexp_lazy (e, infix_ext_attrs) ->
       fmt_lazy c ~ctx ~pro ~fmt_atrs ~infix_ext_attrs ~parens e
@@ -2901,7 +2965,7 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
         @@ hvbox 2
              (Params.parens_if parens c.conf
                 ( fmt_infix_ext_attrs c ~pro:(str "new") infix_ext_attrs
-                $ space_break $ fmt_longident txt $ fmt_atrs ) )
+                $ space_break $ fmt_longident c txt $ fmt_atrs ) )
   | Pexp_object ({pcstr_self; pcstr_fields}, infix_ext_attrs) ->
       pro
       $ hvbox 0
@@ -2917,9 +2981,9 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
         | Pexp_ident {txt= txt'; loc}
           when Std_longident.field_alias ~field:txt txt'
                && List.is_empty f.pexp_attributes ->
-            Cmts.fmt c ~eol loc @@ fmt_longident txt'
+            Cmts.fmt c ~eol loc @@ fmt_longident c txt'
         | _ ->
-            Cmts.fmt c ~eol loc @@ fmt_longident txt
+            Cmts.fmt c ~eol loc @@ fmt_longident c txt
             $ str " = "
             $ fmt_expression c (sub_exp ~ctx f)
       in
@@ -4286,13 +4350,13 @@ and fmt_with_constraint c ctx ~pre = function
       str pre $ str " module " $ fmt_longident_loc c m1 $ str " := "
       $ fmt_longident_loc c m2
   | Pwith_modtype (m1, m2) ->
-      let m1 = {m1 with txt= Some (str_longident m1.txt)} in
+      let m1 = {m1 with txt= Some (str_longident c m1.txt)} in
       let m2 = Some (sub_mty ~ctx m2) in
       str pre $ break 1 2
       $ fmt_module c ctx "module type" m1 [] None ~rec_flag:false m2
           ~attrs:Ast_helper.Attr.empty_ext_attrs
   | Pwith_modtypesubst (m1, m2) ->
-      let m1 = {m1 with txt= Some (str_longident m1.txt)} in
+      let m1 = {m1 with txt= Some (str_longident c m1.txt)} in
       let m2 = Some (sub_mty ~ctx m2) in
       str pre $ break 1 2
       $ fmt_module c ctx ~eqty:":=" "module type" m1 [] None ~rec_flag:false
@@ -4485,12 +4549,15 @@ and fmt_module_expr ?(dock_struct = true) c ({ast= m; ctx= ctx0} as xmod) =
                 (str "end" $ fmt_attributes_and_docstrings c pmod_attributes)
             $ after ) }
   | Pmod_unpack (e, ty1, ty2) ->
-      let package_type sep (lid, cstrs, attrs) =
+      let package_type sep
+          {ppt_path= lid; ppt_cstrs= cstrs; ppt_attrs= attrs; ppt_loc} =
         break 1 (Params.Indent.mod_unpack_annot c.conf)
         $ hovbox 0
-            ( hovbox 0 (str sep $ fmt_longident_loc c lid)
+            ( hovbox 0
+                ( str sep $ Cmts.fmt_before c ppt_loc
+                $ fmt_longident_loc c lid )
             $ fmt_package_type c ctx cstrs
-            $ fmt_attributes c attrs )
+            $ fmt_attributes c attrs $ Cmts.fmt_after c ppt_loc )
       in
       { empty with
         opn= Some (open_hvbox 2)
@@ -4877,7 +4944,7 @@ let fmt_toplevel_directive c ~semisemi dir =
     | Pdir_string s -> str (Printf.sprintf "%S" s)
     | Pdir_int (lit, Some m) -> str (Printf.sprintf "%s%c" lit m)
     | Pdir_int (lit, None) -> str lit
-    | Pdir_ident longident -> fmt_longident longident
+    | Pdir_ident longident -> fmt_longident c longident
     | Pdir_bool bool -> str (Bool.to_string bool)
   in
   let {pdir_name= name; pdir_arg; pdir_loc} = dir in
diff --git a/lib/Params.ml b/lib/Params.ml
index 29ae8be40e..c22ea038c6 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -636,13 +636,14 @@ let wrap_collec c ~space_around opn cls =
 let wrap_record (c : Conf.t) =
   wrap_collec c ~space_around:c.fmt_opts.space_around_records.v "{" "}"
 
-let wrap_tuple (c : Conf.t) ~parens ~no_parens_if_break items =
+let wrap_tuple (c : Conf.t) ~parens ~no_parens_if_break ?(close = noop) items
+    =
   let tuple_sep =
     match c.fmt_opts.break_separators.v with
     | `Before -> fits_breaks ", " ~hint:(1000, -2) ", "
     | `After -> str "," $ space_break
   in
-  let k = list items tuple_sep Fn.id in
+  let k = list items tuple_sep Fn.id $ close in
   if parens then wrap_fits_breaks c "(" ")" (hvbox 0 k)
   else if no_parens_if_break then k
   else fits_breaks "" "( " $ hvbox 0 k $ fits_breaks "" ~hint:(1, 0) ")"
diff --git a/lib/Params.mli b/lib/Params.mli
index 4dfe304201..cc983a0bd1 100644
--- a/lib/Params.mli
+++ b/lib/Params.mli
@@ -160,7 +160,12 @@ val get_cases :
   -> cases
 
 val wrap_tuple :
-  Conf.t -> parens:bool -> no_parens_if_break:bool -> Fmt.t list -> Fmt.t
+     Conf.t
+  -> parens:bool
+  -> no_parens_if_break:bool
+  -> ?close:Fmt.t
+  -> Fmt.t list
+  -> Fmt.t
 (** Format a tuple given a list of items. *)
 
 type record_type =
diff --git a/lib/Std_longident.ml b/lib/Std_longident.ml
index d0981058f2..7626d853d0 100644
--- a/lib/Std_longident.ml
+++ b/lib/Std_longident.ml
@@ -103,7 +103,7 @@ let is_symbol i = is_prefix i || is_infix i || is_index_op i
 
 let field_alias_str ~field y =
   match field with
-  | Ldot (_, x) | Lident x -> String.equal x y
+  | Ldot (_, {txt= x; _}) | Lident x -> String.equal x y
   | Lapply _ -> false
 
 let field_alias ~field = function
diff --git a/test/passing/gen/dune.inc b/test/passing/gen/dune.inc
index 6f802e4c6d..1762810c7e 100644
--- a/test/passing/gen/dune.inc
+++ b/test/passing/gen/dune.inc
@@ -3434,6 +3434,24 @@
  (package ocamlformat)
  (action (diff label_option_default_args.ml.err label_option_default_args.ml.stderr)))
 
+(rule
+ (deps .ocamlformat)
+ (package ocamlformat)
+ (action
+  (with-stdout-to labeled_tuples.ml.stdout
+   (with-stderr-to labeled_tuples.ml.stderr
+     (run %{bin:ocamlformat} --name labeled_tuples.ml --margin-check %{dep:../tests/labeled_tuples.ml})))))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff labeled_tuples.ml.ref labeled_tuples.ml.stdout)))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff labeled_tuples.ml.err labeled_tuples.ml.stderr)))
+
 (rule
  (deps .ocamlformat)
  (package ocamlformat)
diff --git a/test/passing/refs.ahrefs/first_class_module.ml.ref b/test/passing/refs.ahrefs/first_class_module.ml.ref
index 96292846c4..46ef84a0b1 100644
--- a/test/passing/refs.ahrefs/first_class_module.ml.ref
+++ b/test/passing/refs.ahrefs/first_class_module.ml.ref
@@ -113,9 +113,9 @@ let _ =
     let y = 1
   end)
 
-(* Three form that have an equivalent AST: *)
+(* Three form that had an equivalent AST at some point: *)
 let x : (module S) = (module M)
-let x = (module M : S)
+let x = ((module M) : (module S))
 let x = (module M : S)
 
 (* Unpack containing a [pexp_constraint]. *)
diff --git a/test/passing/refs.ahrefs/injectivity.ml.ref b/test/passing/refs.ahrefs/injectivity.ml.ref
index b7d62f2c30..4f616059f0 100644
--- a/test/passing/refs.ahrefs/injectivity.ml.ref
+++ b/test/passing/refs.ahrefs/injectivity.ml.ref
@@ -16,6 +16,14 @@ type +!'a t = private 'a
 
 type -!'a t = private 'a -> unit
 
+type +-'a t = int
+type -+'a t = int
+
+type !+-'a t = A
+type !-+'a t = A
+type +-!'a t = A
+type -+!'a t = A
+
 module M : sig
   type +!'a t
 end = struct
diff --git a/test/passing/refs.ahrefs/labeled_tuples.ml.ref b/test/passing/refs.ahrefs/labeled_tuples.ml.ref
new file mode 100644
index 0000000000..9978168749
--- /dev/null
+++ b/test/passing/refs.ahrefs/labeled_tuples.ml.ref
@@ -0,0 +1,594 @@
+(** Concatenation of all labeled tuples test from the compiler testsuite *)
+
+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 = fun (~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 = fun (~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 = fun (~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) = (~x, ~y : yx)
+
+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, 2, ~y:3, ~z:4, 5, 6
+
+(* Full match, in order *)
+let matches =
+  let ~x, k1, ~y, ~z, k2, k3 = lt in
+  x, k1, y, z, k2, k3
+
+(* Full match, over-bound *)
+let matches =
+  let ~x, k1, ~y, ~z, x, k3 = lt in
+  ()
+
+let matches =
+  let ~x, k1, ~y, ~z:x, k2, k3 = lt in
+  ()
+
+(* Full match, missing label *)
+let matches =
+  let ~x, k1, ~y, k2, k3 = lt in
+  ()
+
+(* Full match, wrong label *)
+let matches =
+  let ~x, k1, ~y, ~w, k2, k3 = lt in
+  ()
+
+(* Full match, extra label *)
+let matches =
+  let ~x, k1, ~y, ~z, ~w, k2, k3 = lt in
+  ()
+
+(* Full match, extra unlabeled label *)
+let matches =
+  let ~x, k1, ~y, ~z, k2, k3, k4 = lt in
+  x, y, z
+
+(* Partial match *)
+let matches =
+  let ~x, ~z, .. = lt in
+  x, z
+
+(* Partial match, reordered *)
+let matches =
+  let ~z, ~x, .. = lt in
+  x, z
+
+(* Partial match, reordered, over-bound *)
+let matches =
+  let ~z:x, ~x, .. = lt in
+  x
+
+(* Partial match one *)
+let matches =
+  let ~z, .. = lt in
+  z
+
+(* Partial match all *)
+let matches =
+  let ~x, k1, ~y, ~z, k2, k3, .. = lt in
+  x, k1, y, z, k2, k3
+
+(* Partial match bad name *)
+let matches =
+  let ~w, ~y, ~x, .. = lt in
+  ()
+
+(* 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, 3, ~z:4)
+
+(* Good match *)
+let _1234 =
+  match x with
+  | { contents = ~x:x0, ~y, w, ~z:x } -> x0, y, w, x
+
+(* Good partial match *)
+let _1 =
+  match x with
+  | { contents = ~y, .. } -> y
+
+(* Wrong label *)
+let () =
+  match x with
+  | { contents = ~w, .. } -> w
+
+(* Missing unlabeled element *)
+let () =
+  match x with
+  | { contents = ~x, ~y, ~z } -> y
+
+(* Extra unlabeled element *)
+let () =
+  match x with
+  | { contents = ~x, ~y, w1, ~z, w2 } -> y
+
+(* Extra unlabeled element, open *)
+let () =
+  match x with
+  | { contents = ~x, ~y, w1, ~z, w2, .. } -> y
+
+(* Missing label *)
+let () =
+  match x with
+  | { contents = ~x, ~y, w } -> y
+
+(* Extra label *)
+let () =
+  match x with
+  | { contents = ~z, ~y, ~w, ~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 =
+  x1:int
+  * y2:int
+  * int
+  * x4:int
+  * x5:int
+  * y6:int
+  * y7:int
+  * int
+  * int
+  * y10:int
+  * x11:int
+
+let t : t = ~x1:1, ~y2:2, 3, ~x4:4, ~x5:5, ~y6:6, ~y7:7, 8, 9, ~y10:10, ~x11:11
+
+let _ =
+  let ~y2, ~y7, ~y10, .. = t in
+  y2, y7, y10
+
+let _ =
+  let a, b, c, .. = t in
+  a, b, c
+
+let _ =
+  let n3, ~y6:n6, ~y7, ~x1:n1, .. = t in
+  n1, n6, n3, y7
+
+let _ =
+  let ~x4, ~x1, ~x11, ~x5, .. = t in
+  x1, x4, x5, x11
+
+let _ =
+  let ( ~y2:n2,
+        ~y6:n6,
+        n3,
+        ~x1:n1,
+        ~y7:n7,
+        n8,
+        ~y10:n10,
+        ~x4:n4,
+        ~x5:n5,
+        ~x11:n11,
+        n9 ) =
+    t
+  in
+  n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11
+
+let _ =
+  let ( n3,
+        n8,
+        n9,
+        ~y2:n2,
+        ~y6:n6,
+        ~y7:n7,
+        ~y10:n10,
+        ~x1:n1,
+        ~x4:n4,
+        ~x5:n5,
+        ~x11:n11 ) =
+    t
+  in
+  n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11
+
+let _ =
+  let ( ~x1:n1,
+        ~y2:n2,
+        n3,
+        ~x4:n4,
+        ~x5:n5,
+        ~y6:n6,
+        ~y7:n7,
+        n8,
+        n9,
+        ~y10:n10,
+        ~x11:n11 ) =
+    t
+  in
+  n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11
+
+(* 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 unify 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))
+
+let x = ~x:1, ~y:2
+
+(* Attribute should prevent punning *)
+let z = 5
+let y = ~z, ~z':z, ~z1:(z [@attr])
+
+let (~x:x0, ~s, ~(y : int), ..) : x:int * s:string * y:int * string =
+  ~x:1, ~s:"a", ~y:2, "ignore me"
+
+(* 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, ~b:"hi" else ~a:"5", 10, ~c:"hi"
+
+(* Repeated labels *)
+type t = x:int * bool * x:int
+
+let _ = 1, ~x:2, 3, ~x:4
+
+let f (a, ~x, b, ~x:c) = ()
+
+(* 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
+  module T = struct
+    include IntString
+  end
+  include T
+  include Stringable.Make (T)
+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 sum_and_product ints =
+  let init = ~sum:0, ~product:1 in
+  List.fold_left
+    (fun (~sum, ~product) elem ->
+      let sum = elem + sum in
+      let product = elem * product in
+      ~sum, ~product)
+    init ints
+let _ = sum_and_product [ 1; 2; 3; 4 ]
+let _ = sum_and_product [ 1; -10; 2 ]
+
+(** Strange syntax test *)
+
+let ~x:(Some (Some x)), _ = None, 0
+
+let f = ~x, ~y:(fun x -> x)
+
+let _ =
+  ( ~x:(();
+        1),
+    2 )
+
+let ~(x : int), _ = ~x:0, 1
+
+let _ = ~(x : int), ~(y : int)
diff --git a/test/passing/refs.default/first_class_module.ml.ref b/test/passing/refs.default/first_class_module.ml.ref
index cb3e082e9a..e0ad8c15b7 100644
--- a/test/passing/refs.default/first_class_module.ml.ref
+++ b/test/passing/refs.default/first_class_module.ml.ref
@@ -106,9 +106,9 @@ module M = (val x (* b *))
 
 let _ = (module struct let x = 0 let y = 1 end)
 
-(* Three form that have an equivalent AST: *)
+(* Three form that had an equivalent AST at some point: *)
 let x : (module S) = (module M)
-let x = (module M : S)
+let x = ((module M) : (module S))
 let x = (module M : S)
 
 (* Unpack containing a [pexp_constraint]. *)
diff --git a/test/passing/refs.default/injectivity.ml.ref b/test/passing/refs.default/injectivity.ml.ref
index 73c6a47593..8fc7321880 100644
--- a/test/passing/refs.default/injectivity.ml.ref
+++ b/test/passing/refs.default/injectivity.ml.ref
@@ -7,6 +7,12 @@ type +!'a t = private 'a
 type -!'a t = private 'a -> unit
 type +!'a t = private 'a
 type -!'a t = private 'a -> unit
+type +-'a t = int
+type -+'a t = int
+type !+-'a t = A
+type !-+'a t = A
+type +-!'a t = A
+type -+!'a t = A
 
 module M : sig
   type +!'a t
diff --git a/test/passing/refs.default/labeled_tuples.ml.err b/test/passing/refs.default/labeled_tuples.ml.err
new file mode 100644
index 0000000000..2af4dd541a
--- /dev/null
+++ b/test/passing/refs.default/labeled_tuples.ml.err
@@ -0,0 +1 @@
+Warning: labeled_tuples.ml:200 exceeds the margin
diff --git a/test/passing/refs.default/labeled_tuples.ml.ref b/test/passing/refs.default/labeled_tuples.ml.ref
new file mode 100644
index 0000000000..50fe5c4c7a
--- /dev/null
+++ b/test/passing/refs.default/labeled_tuples.ml.ref
@@ -0,0 +1,534 @@
+(** Concatenation of all labeled tuples test from the compiler testsuite *)
+
+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 = fun (~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 = fun (~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 = fun (~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) = ((~x, ~y) : yx)
+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, 2, ~y:3, ~z:4, 5, 6)
+
+(* Full match, in order *)
+let matches =
+  let ~x, k1, ~y, ~z, k2, k3 = lt in
+  (x, k1, y, z, k2, k3)
+
+(* Full match, over-bound *)
+let matches =
+  let ~x, k1, ~y, ~z, x, k3 = lt in
+  ()
+
+let matches =
+  let ~x, k1, ~y, ~z:x, k2, k3 = lt in
+  ()
+
+(* Full match, missing label *)
+let matches =
+  let ~x, k1, ~y, k2, k3 = lt in
+  ()
+
+(* Full match, wrong label *)
+let matches =
+  let ~x, k1, ~y, ~w, k2, k3 = lt in
+  ()
+
+(* Full match, extra label *)
+let matches =
+  let ~x, k1, ~y, ~z, ~w, k2, k3 = lt in
+  ()
+
+(* Full match, extra unlabeled label *)
+let matches =
+  let ~x, k1, ~y, ~z, k2, k3, k4 = lt in
+  (x, y, z)
+
+(* Partial match *)
+let matches =
+  let ~x, ~z, .. = lt in
+  (x, z)
+
+(* Partial match, reordered *)
+let matches =
+  let ~z, ~x, .. = lt in
+  (x, z)
+
+(* Partial match, reordered, over-bound *)
+let matches =
+  let ~z:x, ~x, .. = lt in
+  x
+
+(* Partial match one *)
+let matches =
+  let ~z, .. = lt in
+  z
+
+(* Partial match all *)
+let matches =
+  let ~x, k1, ~y, ~z, k2, k3, .. = lt in
+  (x, k1, y, z, k2, k3)
+
+(* Partial match bad name *)
+let matches =
+  let ~w, ~y, ~x, .. = lt in
+  ()
+
+(* 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, 3, ~z:4)
+
+(* Good match *)
+let _1234 = match x with { contents = ~x:x0, ~y, w, ~z:x } -> (x0, y, w, x)
+
+(* Good partial match *)
+let _1 = match x with { contents = ~y, .. } -> y
+
+(* Wrong label *)
+let () = match x with { contents = ~w, .. } -> w
+
+(* Missing unlabeled element *)
+let () = match x with { contents = ~x, ~y, ~z } -> y
+
+(* Extra unlabeled element *)
+let () = match x with { contents = ~x, ~y, w1, ~z, w2 } -> y
+
+(* Extra unlabeled element, open *)
+let () = match x with { contents = ~x, ~y, w1, ~z, w2, .. } -> y
+
+(* Missing label *)
+let () = match x with { contents = ~x, ~y, w } -> y
+
+(* Extra label *)
+let () = match x with { contents = ~z, ~y, ~w, ~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 =
+  x1:int
+  * y2:int
+  * int
+  * x4:int
+  * x5:int
+  * y6:int
+  * y7:int
+  * int
+  * int
+  * y10:int
+  * x11:int
+
+let t : t = (~x1:1, ~y2:2, 3, ~x4:4, ~x5:5, ~y6:6, ~y7:7, 8, 9, ~y10:10, ~x11:11)
+
+let _ =
+  let ~y2, ~y7, ~y10, .. = t in
+  (y2, y7, y10)
+
+let _ =
+  let a, b, c, .. = t in
+  (a, b, c)
+
+let _ =
+  let n3, ~y6:n6, ~y7, ~x1:n1, .. = t in
+  (n1, n6, n3, y7)
+
+let _ =
+  let ~x4, ~x1, ~x11, ~x5, .. = t in
+  (x1, x4, x5, x11)
+
+let _ =
+  let ( ~y2:n2,
+        ~y6:n6,
+        n3,
+        ~x1:n1,
+        ~y7:n7,
+        n8,
+        ~y10:n10,
+        ~x4:n4,
+        ~x5:n5,
+        ~x11:n11,
+        n9 ) =
+    t
+  in
+  (n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11)
+
+let _ =
+  let ( n3,
+        n8,
+        n9,
+        ~y2:n2,
+        ~y6:n6,
+        ~y7:n7,
+        ~y10:n10,
+        ~x1:n1,
+        ~x4:n4,
+        ~x5:n5,
+        ~x11:n11 ) =
+    t
+  in
+  (n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11)
+
+let _ =
+  let ( ~x1:n1,
+        ~y2:n2,
+        n3,
+        ~x4:n4,
+        ~x5:n5,
+        ~y6:n6,
+        ~y7:n7,
+        n8,
+        n9,
+        ~y10:n10,
+        ~x11:n11 ) =
+    t
+  in
+  (n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11)
+
+(* 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 unify 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))
+let x = (~x:1, ~y:2)
+
+(* Attribute should prevent punning *)
+let z = 5
+let y = (~z, ~z':z, ~z1:(z [@attr]))
+
+let (~x:x0, ~s, ~(y : int), ..) : x:int * s:string * y:int * string =
+  (~x:1, ~s:"a", ~y:2, "ignore me")
+
+(* 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, ~b:"hi") else (~a:"5", 10, ~c:"hi")
+
+(* Repeated labels *)
+type t = x:int * bool * x:int
+
+let _ = (1, ~x:2, 3, ~x:4)
+let f (a, ~x, b, ~x:c) = ()
+
+(* 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
+  module T = struct
+    include IntString
+  end
+
+  include T
+  include Stringable.Make (T)
+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 sum_and_product ints =
+  let init = (~sum:0, ~product:1) in
+  List.fold_left
+    (fun (~sum, ~product) elem ->
+      let sum = elem + sum in
+      let product = elem * product in
+      (~sum, ~product))
+    init ints
+
+let _ = sum_and_product [ 1; 2; 3; 4 ]
+let _ = sum_and_product [ 1; -10; 2 ]
+
+(** Strange syntax test *)
+
+let ~x:(Some (Some x)), _ = (None, 0)
+let f = (~x, ~y:(fun x -> x))
+
+let _ =
+  ( ~x:(();
+        1),
+    2 )
+
+let ~(x : int), _ = (~x:0, 1)
+let _ = (~(x : int), ~(y : int))
diff --git a/test/passing/refs.janestreet/first_class_module.ml.ref b/test/passing/refs.janestreet/first_class_module.ml.ref
index dcc00fe71a..fd8d92d72a 100644
--- a/test/passing/refs.janestreet/first_class_module.ml.ref
+++ b/test/passing/refs.janestreet/first_class_module.ml.ref
@@ -114,9 +114,9 @@ module M = (val x (* b *))
 
 let _ = (module struct let x = 0 let y = 1 end)
 
-(* Three form that have an equivalent AST: *)
+(* Three form that had an equivalent AST at some point: *)
 let x : (module S) = (module M)
-let x = (module M : S)
+let x = ((module M) : (module S))
 let x = (module M : S)
 
 (* Unpack containing a [pexp_constraint]. *)
diff --git a/test/passing/refs.janestreet/injectivity.ml.ref b/test/passing/refs.janestreet/injectivity.ml.ref
index 93cb814548..79a90dd645 100644
--- a/test/passing/refs.janestreet/injectivity.ml.ref
+++ b/test/passing/refs.janestreet/injectivity.ml.ref
@@ -7,6 +7,12 @@ type +!'a t = private 'a
 type -!'a t = private 'a -> unit
 type +!'a t = private 'a
 type -!'a t = private 'a -> unit
+type +-'a t = int
+type -+'a t = int
+type !+-'a t = A
+type !-+'a t = A
+type +-!'a t = A
+type -+!'a t = A
 
 module M : sig
   type +!'a t
diff --git a/test/passing/refs.janestreet/labeled_tuples.ml.ref b/test/passing/refs.janestreet/labeled_tuples.ml.ref
new file mode 100644
index 0000000000..a42d08165d
--- /dev/null
+++ b/test/passing/refs.janestreet/labeled_tuples.ml.ref
@@ -0,0 +1,592 @@
+(** Concatenation of all labeled tuples test from the compiler testsuite *)
+
+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 = fun (~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 = fun (~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 = fun (~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) = ((~x, ~y) : yx)
+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, 2, ~y:3, ~z:4, 5, 6
+
+(* Full match, in order *)
+let matches =
+  let ~x, k1, ~y, ~z, k2, k3 = lt in
+  x, k1, y, z, k2, k3
+;;
+
+(* Full match, over-bound *)
+let matches =
+  let ~x, k1, ~y, ~z, x, k3 = lt in
+  ()
+;;
+
+let matches =
+  let ~x, k1, ~y, ~z:x, k2, k3 = lt in
+  ()
+;;
+
+(* Full match, missing label *)
+let matches =
+  let ~x, k1, ~y, k2, k3 = lt in
+  ()
+;;
+
+(* Full match, wrong label *)
+let matches =
+  let ~x, k1, ~y, ~w, k2, k3 = lt in
+  ()
+;;
+
+(* Full match, extra label *)
+let matches =
+  let ~x, k1, ~y, ~z, ~w, k2, k3 = lt in
+  ()
+;;
+
+(* Full match, extra unlabeled label *)
+let matches =
+  let ~x, k1, ~y, ~z, k2, k3, k4 = lt in
+  x, y, z
+;;
+
+(* Partial match *)
+let matches =
+  let ~x, ~z, .. = lt in
+  x, z
+;;
+
+(* Partial match, reordered *)
+let matches =
+  let ~z, ~x, .. = lt in
+  x, z
+;;
+
+(* Partial match, reordered, over-bound *)
+let matches =
+  let ~z:x, ~x, .. = lt in
+  x
+;;
+
+(* Partial match one *)
+let matches =
+  let ~z, .. = lt in
+  z
+;;
+
+(* Partial match all *)
+let matches =
+  let ~x, k1, ~y, ~z, k2, k3, .. = lt in
+  x, k1, y, z, k2, k3
+;;
+
+(* Partial match bad name *)
+let matches =
+  let ~w, ~y, ~x, .. = lt in
+  ()
+;;
+
+(* 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, 3, ~z:4)
+
+(* Good match *)
+let _1234 =
+  match x with
+  | { contents = ~x:x0, ~y, w, ~z:x } -> x0, y, w, x
+;;
+
+(* Good partial match *)
+let _1 =
+  match x with
+  | { contents = ~y, .. } -> y
+;;
+
+(* Wrong label *)
+let () =
+  match x with
+  | { contents = ~w, .. } -> w
+;;
+
+(* Missing unlabeled element *)
+let () =
+  match x with
+  | { contents = ~x, ~y, ~z } -> y
+;;
+
+(* Extra unlabeled element *)
+let () =
+  match x with
+  | { contents = ~x, ~y, w1, ~z, w2 } -> y
+;;
+
+(* Extra unlabeled element, open *)
+let () =
+  match x with
+  | { contents = ~x, ~y, w1, ~z, w2, .. } -> y
+;;
+
+(* Missing label *)
+let () =
+  match x with
+  | { contents = ~x, ~y, w } -> y
+;;
+
+(* Extra label *)
+let () =
+  match x with
+  | { contents = ~z, ~y, ~w, ~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 =
+  x1:int
+  * y2:int
+  * int
+  * x4:int
+  * x5:int
+  * y6:int
+  * y7:int
+  * int
+  * int
+  * y10:int
+  * x11:int
+
+let t : t = ~x1:1, ~y2:2, 3, ~x4:4, ~x5:5, ~y6:6, ~y7:7, 8, 9, ~y10:10, ~x11:11
+
+let _ =
+  let ~y2, ~y7, ~y10, .. = t in
+  y2, y7, y10
+;;
+
+let _ =
+  let a, b, c, .. = t in
+  a, b, c
+;;
+
+let _ =
+  let n3, ~y6:n6, ~y7, ~x1:n1, .. = t in
+  n1, n6, n3, y7
+;;
+
+let _ =
+  let ~x4, ~x1, ~x11, ~x5, .. = t in
+  x1, x4, x5, x11
+;;
+
+let _ =
+  let ~y2:n2, ~y6:n6, n3, ~x1:n1, ~y7:n7, n8, ~y10:n10, ~x4:n4, ~x5:n5, ~x11:n11, n9 =
+    t
+  in
+  n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11
+;;
+
+let _ =
+  let n3, n8, n9, ~y2:n2, ~y6:n6, ~y7:n7, ~y10:n10, ~x1:n1, ~x4:n4, ~x5:n5, ~x11:n11 =
+    t
+  in
+  n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11
+;;
+
+let _ =
+  let ~x1:n1, ~y2:n2, n3, ~x4:n4, ~x5:n5, ~y6:n6, ~y7:n7, n8, n9, ~y10:n10, ~x11:n11 =
+    t
+  in
+  n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11
+;;
+
+(* 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 unify 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))
+let x = ~x:1, ~y:2
+
+(* Attribute should prevent punning *)
+let z = 5
+let y = ~z, ~z':z, ~z1:(z [@attr])
+
+let (~x:x0, ~s, ~(y : int), ..) : x:int * s:string * y:int * string =
+  ~x:1, ~s:"a", ~y:2, "ignore me"
+;;
+
+(* 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, ~b:"hi" else ~a:"5", 10, ~c:"hi"
+
+(* Repeated labels *)
+type t = x:int * bool * x:int
+
+let _ = 1, ~x:2, 3, ~x:4
+let f (a, ~x, b, ~x:c) = ()
+
+(* 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
+  module T = struct
+    include IntString
+  end
+
+  include T
+  include Stringable.Make (T)
+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 sum_and_product ints =
+  let init = ~sum:0, ~product:1 in
+  List.fold_left
+    (fun (~sum, ~product) elem ->
+       let sum = elem + sum in
+       let product = elem * product in
+       ~sum, ~product)
+    init
+    ints
+;;
+
+let _ = sum_and_product [ 1; 2; 3; 4 ]
+let _ = sum_and_product [ 1; -10; 2 ]
+
+(** Strange syntax test *)
+
+let ~x:(Some (Some x)), _ = None, 0
+let f = ~x, ~y:(fun x -> x)
+
+let _ =
+  ( ~x:(();
+        1)
+  , 2 )
+;;
+
+let ~(x : int), _ = ~x:0, 1
+let _ = ~(x : int), ~(y : int)
diff --git a/test/passing/refs.ocamlformat/first_class_module.ml.ref b/test/passing/refs.ocamlformat/first_class_module.ml.ref
index 0c1bd834b0..a83dde57ea 100644
--- a/test/passing/refs.ocamlformat/first_class_module.ml.ref
+++ b/test/passing/refs.ocamlformat/first_class_module.ml.ref
@@ -107,10 +107,10 @@ let _ =
     let y = 1
   end )
 
-(* Three form that have an equivalent AST: *)
+(* Three form that had an equivalent AST at some point: *)
 let x : (module S) = (module M)
 
-let x = (module M : S)
+let x = ((module M) : (module S))
 
 let x = (module M : S)
 
diff --git a/test/passing/refs.ocamlformat/injectivity.ml.ref b/test/passing/refs.ocamlformat/injectivity.ml.ref
index ea909bba79..95aeefd157 100644
--- a/test/passing/refs.ocamlformat/injectivity.ml.ref
+++ b/test/passing/refs.ocamlformat/injectivity.ml.ref
@@ -16,6 +16,18 @@ type +!'a t = private 'a
 
 type -!'a t = private 'a -> unit
 
+type +-'a t = int
+
+type -+'a t = int
+
+type !+-'a t = A
+
+type !-+'a t = A
+
+type +-!'a t = A
+
+type -+!'a t = A
+
 module M : sig
   type +!'a t
 end = struct
diff --git a/test/passing/refs.ocamlformat/labeled_tuples.ml.err b/test/passing/refs.ocamlformat/labeled_tuples.ml.err
new file mode 100644
index 0000000000..3cda29edb8
--- /dev/null
+++ b/test/passing/refs.ocamlformat/labeled_tuples.ml.err
@@ -0,0 +1 @@
+Warning: labeled_tuples.ml:223 exceeds the margin
diff --git a/test/passing/refs.ocamlformat/labeled_tuples.ml.ref b/test/passing/refs.ocamlformat/labeled_tuples.ml.ref
new file mode 100644
index 0000000000..c4117d22ec
--- /dev/null
+++ b/test/passing/refs.ocamlformat/labeled_tuples.ml.ref
@@ -0,0 +1,599 @@
+(** Concatenation of all labeled tuples test from the compiler testsuite *)
+
+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 = fun (~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 = fun (~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 = fun (~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) = ((~x, ~y) : yx)
+
+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, 2, ~y:3, ~z:4, 5, 6)
+
+(* Full match, in order *)
+let matches =
+  let ~x, k1, ~y, ~z, k2, k3 = lt in
+  (x, k1, y, z, k2, k3)
+
+(* Full match, over-bound *)
+let matches =
+  let ~x, k1, ~y, ~z, x, k3 = lt in
+  ()
+
+let matches =
+  let ~x, k1, ~y, ~z:x, k2, k3 = lt in
+  ()
+
+(* Full match, missing label *)
+let matches =
+  let ~x, k1, ~y, k2, k3 = lt in
+  ()
+
+(* Full match, wrong label *)
+let matches =
+  let ~x, k1, ~y, ~w, k2, k3 = lt in
+  ()
+
+(* Full match, extra label *)
+let matches =
+  let ~x, k1, ~y, ~z, ~w, k2, k3 = lt in
+  ()
+
+(* Full match, extra unlabeled label *)
+let matches =
+  let ~x, k1, ~y, ~z, k2, k3, k4 = lt in
+  (x, y, z)
+
+(* Partial match *)
+let matches =
+  let ~x, ~z, .. = lt in
+  (x, z)
+
+(* Partial match, reordered *)
+let matches =
+  let ~z, ~x, .. = lt in
+  (x, z)
+
+(* Partial match, reordered, over-bound *)
+let matches =
+  let ~z:x, ~x, .. = lt in
+  x
+
+(* Partial match one *)
+let matches =
+  let ~z, .. = lt in
+  z
+
+(* Partial match all *)
+let matches =
+  let ~x, k1, ~y, ~z, k2, k3, .. = lt in
+  (x, k1, y, z, k2, k3)
+
+(* Partial match bad name *)
+let matches =
+  let ~w, ~y, ~x, .. = lt in
+  ()
+
+(* 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, 3, ~z:4)
+
+(* Good match *)
+let _1234 = match x with {contents= ~x:x0, ~y, w, ~z:x} -> (x0, y, w, x)
+
+(* Good partial match *)
+let _1 = match x with {contents= ~y, ..} -> y
+
+(* Wrong label *)
+let () = match x with {contents= ~w, ..} -> w
+
+(* Missing unlabeled element *)
+let () = match x with {contents= ~x, ~y, ~z} -> y
+
+(* Extra unlabeled element *)
+let () = match x with {contents= ~x, ~y, w1, ~z, w2} -> y
+
+(* Extra unlabeled element, open *)
+let () = match x with {contents= ~x, ~y, w1, ~z, w2, ..} -> y
+
+(* Missing label *)
+let () = match x with {contents= ~x, ~y, w} -> y
+
+(* Extra label *)
+let () = match x with {contents= ~z, ~y, ~w, ~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 =
+  x1:int
+  * y2:int
+  * int
+  * x4:int
+  * x5:int
+  * y6:int
+  * y7:int
+  * int
+  * int
+  * y10:int
+  * x11:int
+
+let t : t = (~x1:1, ~y2:2, 3, ~x4:4, ~x5:5, ~y6:6, ~y7:7, 8, 9, ~y10:10, ~x11:11)
+
+let _ =
+  let ~y2, ~y7, ~y10, .. = t in
+  (y2, y7, y10)
+
+let _ =
+  let a, b, c, .. = t in
+  (a, b, c)
+
+let _ =
+  let n3, ~y6:n6, ~y7, ~x1:n1, .. = t in
+  (n1, n6, n3, y7)
+
+let _ =
+  let ~x4, ~x1, ~x11, ~x5, .. = t in
+  (x1, x4, x5, x11)
+
+let _ =
+  let ( ~y2:n2
+      , ~y6:n6
+      , n3
+      , ~x1:n1
+      , ~y7:n7
+      , n8
+      , ~y10:n10
+      , ~x4:n4
+      , ~x5:n5
+      , ~x11:n11
+      , n9 ) =
+    t
+  in
+  (n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11)
+
+let _ =
+  let ( n3
+      , n8
+      , n9
+      , ~y2:n2
+      , ~y6:n6
+      , ~y7:n7
+      , ~y10:n10
+      , ~x1:n1
+      , ~x4:n4
+      , ~x5:n5
+      , ~x11:n11 ) =
+    t
+  in
+  (n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11)
+
+let _ =
+  let ( ~x1:n1
+      , ~y2:n2
+      , n3
+      , ~x4:n4
+      , ~x5:n5
+      , ~y6:n6
+      , ~y7:n7
+      , n8
+      , n9
+      , ~y10:n10
+      , ~x11:n11 ) =
+    t
+  in
+  (n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11)
+
+(* 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 unify 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))
+
+let x = (~x:1, ~y:2)
+
+(* Attribute should prevent punning *)
+let z = 5
+
+let y = (~z, ~z':z, ~z1:(z [@attr]))
+
+let (~x:x0, ~s, ~(y : int), ..) : x:int * s:string * y:int * string =
+  (~x:1, ~s:"a", ~y:2, "ignore me")
+
+(* 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, ~b:"hi") else (~a:"5", 10, ~c:"hi")
+
+(* Repeated labels *)
+type t = x:int * bool * x:int
+
+let _ = (1, ~x:2, 3, ~x:4)
+
+let f (a, ~x, b, ~x:c) = ()
+
+(* 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
+  module T = struct
+    include IntString
+  end
+
+  include T
+  include Stringable.Make (T)
+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 sum_and_product ints =
+  let init = (~sum:0, ~product:1) in
+  List.fold_left
+    (fun (~sum, ~product) elem ->
+      let sum = elem + sum in
+      let product = elem * product in
+      (~sum, ~product) )
+    init ints
+
+let _ = sum_and_product [1; 2; 3; 4]
+
+let _ = sum_and_product [1; -10; 2]
+
+(** Strange syntax test *)
+
+let ~x:(Some (Some x)), _ = (None, 0)
+
+let f = (~x, ~y:(fun x -> x))
+
+let _ = (~x:(() ; 1), 2)
+
+let ~(x : int), _ = (~x:0, 1)
+
+let _ = (~(x : int), ~(y : int))
diff --git a/test/passing/tests/first_class_module.ml b/test/passing/tests/first_class_module.ml
index 9f2c09219a..5b6c1106c2 100644
--- a/test/passing/tests/first_class_module.ml
+++ b/test/passing/tests/first_class_module.ml
@@ -107,7 +107,7 @@ let _ =
     let y = 1
   end )
 
-(* Three form that have an equivalent AST: *)
+(* Three form that had an equivalent AST at some point: *)
 let x : (module S) = (module M)
 let x = ((module M) : (module S))
 let x = (module M : S)
diff --git a/test/passing/tests/injectivity.ml b/test/passing/tests/injectivity.ml
index ea909bba79..b49ac74249 100644
--- a/test/passing/tests/injectivity.ml
+++ b/test/passing/tests/injectivity.ml
@@ -16,6 +16,14 @@ type +!'a t = private 'a
 
 type -!'a t = private 'a -> unit
 
+type +-'a t = int
+type -+'a t = int
+
+type !+-'a t = A
+type !-+'a t = A
+type +-!'a t = A
+type -+!'a t = A
+
 module M : sig
   type +!'a t
 end = struct
diff --git a/test/passing/tests/labeled_tuples.ml b/test/passing/tests/labeled_tuples.ml
new file mode 100644
index 0000000000..3df05594e3
--- /dev/null
+++ b/test/passing/tests/labeled_tuples.ml
@@ -0,0 +1,644 @@
+(** Concatenation of all labeled tuples test from the compiler testsuite *)
+
+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 = fun (~foo, ~bar:bar) -> foo * 10 + bar
+let bar = 5
+let _ = f (~foo:1, ~bar)
+
+(* Correct annotation *)
+let f : (foo:int * bar:int) -> int =
+   fun (~foo, ~bar:bar) -> foo * 10 + bar
+
+let f = fun (~foo, ~bar:bar) : (foo:int * bar:int) -> foo * 10 + bar
+
+(* Missing label *)
+let f : (int * bar:int) -> int = fun (~foo, ~bar:bar) -> foo * 10 + bar
+
+let f = fun (~foo, ~bar:bar) : (foo:int * int) -> foo * 10 + bar
+
+(* Wrong label *)
+let f : (foo:int * foo':int) -> int =
+   fun (~foo, ~bar:bar) -> foo * 10 + bar
+
+(* Wrong type *)
+let f : (foo:float * foo':int) -> int =
+   fun (~foo, ~bar: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) = (~x, ~y : yx)
+
+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, 2, ~y:3, ~z:4, 5, 6
+
+(* Full match, in order *)
+let matches =
+  let ~x, k1, ~y, ~z, k2, k3 = lt in
+  x, k1, y, z, k2, k3
+
+(* Full match, over-bound *)
+let matches =
+  let ~x, k1, ~y, ~z, x, k3 = lt in
+  ()
+
+let matches =
+  let ~x, k1, ~y, ~z:x, k2, k3 = lt in
+  ()
+
+(* Full match, missing label *)
+let matches =
+  let ~x, k1, ~y, k2, k3 = lt in
+  ()
+
+(* Full match, wrong label *)
+let matches =
+  let ~x, k1, ~y, ~w, k2, k3 = lt in
+  ()
+
+(* Full match, extra label *)
+let matches =
+  let ~x, k1, ~y, ~z, ~w, k2, k3 = lt in
+  ()
+
+(* Full match, extra unlabeled label *)
+let matches =
+  let ~x, k1, ~y, ~z, k2, k3, k4 = lt in
+  x, y, z
+
+(* Partial match *)
+let matches =
+  let ~x, ~z, .. = lt in
+  x, z
+
+(* Partial match, reordered *)
+let matches =
+  let ~z, ~x, .. = lt in
+  x, z
+
+(* Partial match, reordered, over-bound *)
+let matches =
+  let ~z:x, ~x, .. = lt in
+  x
+
+(* Partial match one *)
+let matches =
+  let ~z, .. = lt in
+  z
+
+(* Partial match all *)
+let matches =
+   let ~x, k1, ~y, ~z, k2, k3, .. = lt in
+   x, k1, y, z, k2, k3
+
+
+(* Partial match bad name *)
+let matches =
+   let ~w, ~y, ~x, .. = lt in
+   ()
+
+
+(* 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, 3, ~z:4)
+
+(* Good match *)
+let _1234 = match x with
+| { contents = ~x:x0, ~y, w, ~z:x } -> x0, y, w, x
+
+
+(* Good partial match *)
+let _1  = match x with
+| { contents = ~y, ..} -> y
+
+
+(* Wrong label *)
+let () = match x with
+| { contents = ~w , .. } -> w
+
+
+(* Missing unlabeled element *)
+let () = match x with
+| { contents = ~x, ~y, ~z } -> y
+
+
+(* Extra unlabeled element *)
+let () = match x with
+| { contents = ~x, ~y, w1, ~z, w2 } -> y
+
+(* Extra unlabeled element, open *)
+let () = match x with
+| { contents = ~x, ~y, w1, ~z, w2, .. } -> y
+
+
+(* Missing label *)
+let () = match x with
+| { contents = ~x, ~y, w } -> y
+
+
+(* Extra label *)
+let () = match x with
+| { contents = ~z, ~y, ~w, ~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 =
+  x1:int *
+  y2:int *
+  int *
+  x4:int *
+  x5:int *
+  y6:int *
+  y7:int *
+  int *
+  int *
+  y10:int *
+  x11:int
+
+let t : t = ~x1:1, ~y2:2, 3, ~x4:4, ~x5:5, ~y6:6, ~y7:7, 8, 9, ~y10:10, ~x11:11
+
+let _ =
+  let (~y2, ~y7, ~y10, ..) = t in
+  y2, y7, y10
+
+
+let _ =
+  let (a, b, c, ..) = t in
+  (a, b, c)
+
+let _ =
+  let (n3, ~y6:n6, ~y7, ~x1:n1, ..) = t in
+  (n1, n6, n3, y7)
+
+let _ =
+  let (~x4, ~x1, ~x11, ~x5, ..) = t in
+  (x1, x4, x5, x11)
+
+
+let _ =
+  let (~y2:n2, ~y6:n6, n3, ~x1:n1, ~y7:n7, n8,
+       ~y10:n10, ~x4:n4, ~x5:n5, ~x11:n11, n9) =
+    t
+  in
+  (n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11)
+
+
+let _ =
+  let (n3, n8, n9, ~y2:n2, ~y6:n6, ~y7:n7,
+       ~y10:n10, ~x1:n1, ~x4:n4, ~x5:n5, ~x11:n11) =
+    t
+  in
+  (n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11)
+
+
+let _ =
+  let (~x1:n1, ~y2:n2, n3, ~x4:n4, ~x5:n5,
+       ~y6:n6, ~y7:n7, n8, n9, ~y10:n10, ~x11:n11) =
+    t
+  in
+  (n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11)
+
+(* 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 unify 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))
+
+let x = ~x:1, ~y:2
+
+
+(* Attribute should prevent punning *)
+let z = 5
+let y = ~z, ~z':z, ~z1:(z [@attr])
+
+let (~x:x0, ~s, ~(y:int), ..) : x:int * s:string * y:int * string =
+   ~x: 1, ~s: "a", ~y: 2, "ignore me"
+
+
+(* 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, ~b: "hi"
+else
+   ~a: "5", 10, ~c: "hi"
+
+
+(* Repeated labels *)
+type t = x:int * bool * x:int
+
+let _ = 1, ~x:2, 3, ~x:4
+
+
+let f (a, ~x, b, ~x:c) = ()
+
+
+(* 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
+  module T = struct
+    include IntString
+  end
+  include T
+  include Stringable.Make(T)
+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 sum_and_product ints =
+  let init = ~sum:0, ~product:1 in
+  List.fold_left (fun (~sum, ~product) elem ->
+    let sum = elem + sum in
+    let product = elem * product in
+    ~sum, ~product
+  ) init ints
+let _ = sum_and_product [1;2;3;4]
+let _ = sum_and_product [1;-10;2;]
+
+
+(** Strange syntax test *)
+
+let ~x:(Some Some x), _ = None, 0
+
+let f = ~x, ~y:(fun x -> x)
+
+let _ = ~x:((); 1), 2
+
+let ~(x:int), _ = ~x:0, 1
+
+let _ = ~(x:int), ~(y:int);;
diff --git a/vendor/ocaml-common/longident.ml b/vendor/ocaml-common/longident.ml
index eaafb02bee..c40ea91c06 100644
--- a/vendor/ocaml-common/longident.ml
+++ b/vendor/ocaml-common/longident.ml
@@ -15,19 +15,37 @@
 
 type t =
     Lident of string
-  | Ldot of t * string
-  | Lapply of t * t
+  | Ldot of t Location.loc * string Location.loc
+  | Lapply of t Location.loc * t Location.loc
+
+
+let rec same t t' =
+  t == t'
+  || match t, t' with
+  | Lident s, Lident s' ->
+      String.equal s s'
+  | Ldot ({ txt = t; _ }, { txt = s; _ }),
+    Ldot ({ txt = t'; _ }, { txt = s'; _ }) ->
+      if String.equal s s' then
+        same t t'
+      else
+        false
+  | Lapply ({ txt = tl; _ }, { txt = tr; _ }),
+    Lapply ({ txt = tl'; _ }, { txt = tr'; _ }) ->
+      same tl tl' && same tr tr'
+  | _, _ -> false
+
 
 let rec flat accu = function
     Lident s -> s :: accu
-  | Ldot(lid, s) -> flat (s :: accu) lid
+  | Ldot({ txt = lid; _ }, { txt = s; _ }) -> flat (s :: accu) lid
   | Lapply(_, _) -> Misc.fatal_error "Longident.flat"
 
 let flatten lid = flat [] lid
 
 let last = function
     Lident s -> s
-  | Ldot(_, s) -> s
+  | Ldot(_, s) -> s.txt
   | Lapply(_, _) -> Misc.fatal_error "Longident.last"
 
 
@@ -41,7 +59,11 @@ let rec split_at_dots s pos =
 let unflatten l =
   match l with
   | [] -> None
-  | hd :: tl -> Some (List.fold_left (fun p s -> Ldot(p, s)) (Lident hd) tl)
+  | hd :: tl ->
+    Some (List.fold_left
+            (fun p s -> Ldot(Location.mknoloc p, Location.mknoloc s))
+            (Lident hd) tl
+         )
 
 let parse s =
   match unflatten (split_at_dots s 0) with
diff --git a/vendor/ocaml-common/longident.mli b/vendor/ocaml-common/longident.mli
index 8704a7780e..f7f186cea7 100644
--- a/vendor/ocaml-common/longident.mli
+++ b/vendor/ocaml-common/longident.mli
@@ -25,8 +25,12 @@
 
 type t =
     Lident of string
-  | Ldot of t * string
-  | Lapply of t * t
+  | Ldot of t Location.loc * string Location.loc
+  | Lapply of t Location.loc * t Location.loc
+
+(** [same t t'] compares the longidents [t] and [t'] without taking locations
+    into account. *)
+val same: t -> t -> bool
 
 val flatten: t -> string list
 val unflatten: string list -> t option
diff --git a/vendor/parser-extended/ast_helper.ml b/vendor/parser-extended/ast_helper.ml
index a4ad32033f..4585098667 100644
--- a/vendor/parser-extended/ast_helper.ml
+++ b/vendor/parser-extended/ast_helper.ml
@@ -89,6 +89,12 @@ module Typ = struct
   let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a)
   let open_ ?loc ?attrs mod_ident t = mk ?loc ?attrs (Ptyp_open (mod_ident, t))
 
+  let package_type ?(loc = !default_loc) ?(attrs = []) p c =
+    {ppt_loc = loc;
+     ppt_path = p;
+     ppt_cstrs = c;
+     ppt_attrs = attrs}
+
 (*
   let force_poly t =
     match t.ptyp_desc with
@@ -109,7 +115,8 @@ module Typ = struct
             Ptyp_var x
         | Ptyp_arrow (label,core_type,core_type') ->
             Ptyp_arrow(label, loop core_type, loop core_type')
-        | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
+        | Ptyp_tuple lst ->
+            Ptyp_tuple (List.map (fun (l, t) -> l, loop t) lst)
         | Ptyp_constr( { txt = Longident.Lident s }, [])
           when List.mem s var_names ->
             Ptyp_var s
@@ -129,8 +136,8 @@ module Typ = struct
           List.iter (fun v ->
             check_variable var_names t.ptyp_loc v.txt) string_lst;
             Ptyp_poly(string_lst, loop core_type)
-        | Ptyp_package(longident,lst) ->
-            Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst)
+        | Ptyp_package ptyp ->
+            Ptyp_package (loop_package_type ptyp)
         | Ptyp_open (mod_ident, core_type) ->
             Ptyp_open (mod_ident, loop core_type)
         | Ptyp_extension (s, arg) ->
@@ -153,8 +160,12 @@ module Typ = struct
             Oinherit (loop t)
       in
       { field with pof_desc; }
+    and loop_package_type ptyp =
+      { ptyp with
+        ppt_cstrs = List.map (fun (n,typ) -> (n,loop typ) ) ptyp.ppt_cstrs }
     in
     loop t
+
 *)
 end
 
@@ -171,7 +182,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 1daa6588e4..b7e07f20a2 100644
--- a/vendor/parser-extended/ast_mapper.ml
+++ b/vendor/parser-extended/ast_mapper.ml
@@ -68,6 +68,7 @@ type mapper = {
                            -> module_type_declaration;
   open_declaration: mapper -> open_declaration -> open_declaration;
   open_description: mapper -> open_description -> open_description;
+  package_type: mapper -> package_type -> package_type;
   pat: mapper -> pattern -> pattern;
   payload: mapper -> payload -> payload;
   signature: mapper -> signature -> signature;
@@ -97,13 +98,30 @@ let map_opt f = function None -> None | Some x -> Some (f x)
 
 let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt}
 
+let rec map_lid sub lid =
+  let open Longident in
+  match lid with
+  | Lident id -> Lident id
+  | Ldot (lid, id) ->
+      let lid = { lid with txt = map_lid sub lid.txt } in
+      Ldot (map_loc sub lid, map_loc sub id)
+  | Lapply (lid, lid') ->
+    let lid = { lid with txt = map_lid sub lid.txt } in
+    let lid' = { lid' with txt = map_lid sub lid'.txt } in
+    Lapply(map_loc sub lid, map_loc sub lid')
+
+let map_loc_lid sub {loc; txt} =
+  let txt = map_lid sub txt in
+  map_loc sub {loc; txt}
+
 let variant_var sub x =
   {loc = sub.location sub x.loc; txt= map_loc sub x.txt}
 
-let map_package_type sub (lid, l, attrs) =
-  (map_loc sub lid),
-  (List.map (map_tuple (map_loc sub) (sub.typ sub)) l),
-  sub.attributes sub attrs
+let map_package_type sub {ppt_loc; ppt_path; ppt_cstrs; ppt_attrs} =
+  let loc = sub.location sub ppt_loc in
+  let attrs = sub.attributes sub ppt_attrs in
+  Typ.package_type ~loc ~attrs (map_loc_lid sub ppt_path)
+    (List.map (map_tuple (map_loc_lid sub) (sub.typ sub)) ppt_cstrs)
 
 let map_arg_label sub = function
   | Asttypes.Nolabel -> Asttypes.Nolabel
@@ -231,24 +249,27 @@ 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 (l, t) -> l, sub.typ sub t) tyl)
     | Ptyp_constr (lid, tl) ->
-        constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
+        constr ~loc ~attrs (map_loc_lid sub lid) (List.map (sub.typ sub) tl)
     | Ptyp_object (l, o) ->
         object_ ~loc ~attrs (List.map (object_field sub) l)
           (Flag.map_obj_closed sub o)
     | Ptyp_class (lid, tl) ->
-        class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
-    | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) (map_loc sub s)
+        class_ ~loc ~attrs (map_loc_lid sub lid) (List.map (sub.typ sub) tl)
+    | Ptyp_alias (t, s) ->
+        let s = map_loc sub s in
+        alias ~loc ~attrs (sub.typ sub t) s
     | Ptyp_variant (rl, b, ll) ->
         variant ~loc ~attrs (List.map (row_field sub) rl) b
           (map_opt (List.map (variant_var sub)) ll)
     | Ptyp_poly (sl, t) -> poly ~loc ~attrs
                              (List.map (map_loc sub) sl) (sub.typ sub t)
     | Ptyp_package pt ->
-        package ~loc ~attrs (map_package_type sub pt)
+        package ~loc ~attrs (sub.package_type sub pt)
     | Ptyp_open (mod_ident, t) ->
-        open_ ~loc ~attrs (map_loc sub mod_ident) (sub.typ sub t)
+        open_ ~loc ~attrs (map_loc_lid sub mod_ident) (sub.typ sub t)
     | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x)
 
   let map_type_declaration sub
@@ -292,7 +313,7 @@ module T = struct
     let loc = sub.location sub ptyext_loc in
     let attrs = sub.ext_attrs sub ptyext_attributes in
     Te.mk ~loc ~attrs
-      (map_loc sub ptyext_path)
+      (map_loc_lid sub ptyext_path)
       (List.map (sub.extension_constructor sub) ptyext_constructors)
       ~params:(List.map (map_fst (sub.typ sub)) ptyext_params)
       ~priv:(Flag.map_private sub ptyext_private)
@@ -310,7 +331,7 @@ module T = struct
                   map_constructor_arguments sub ctl,
                   map_opt (sub.typ sub) cto)
     | Pext_rebind li ->
-        Pext_rebind (map_loc sub li)
+        Pext_rebind (map_loc_lid sub li)
 
   let map_extension_constructor sub
       {pext_name;
@@ -334,7 +355,7 @@ module CT = struct
     let attrs = sub.attributes sub attrs in
     match desc with
     | Pcty_constr (lid, tys) ->
-        constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys)
+        constr ~loc ~attrs (map_loc_lid sub lid) (List.map (sub.typ sub) tys)
     | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x)
     | Pcty_arrow (params, ct) ->
         arrow ~loc ~attrs (List.map (T.map_arrow_param sub) params)
@@ -384,8 +405,8 @@ module MT = struct
     let loc = sub.location sub loc in
     let attrs = sub.attributes sub attrs in
     match desc with
-    | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s)
-    | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s)
+    | Pmty_ident s -> ident ~loc ~attrs (map_loc_lid sub s)
+    | Pmty_alias s -> alias ~loc ~attrs (map_loc_lid sub s)
     | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg)
     | Pmty_functor (params, mt, short) ->
         functor_ ~loc ~attrs
@@ -400,17 +421,17 @@ module MT = struct
 
   let map_with_constraint sub = function
     | Pwith_type (lid, d) ->
-        Pwith_type (map_loc sub lid, sub.type_declaration sub d)
+        Pwith_type (map_loc_lid sub lid, sub.type_declaration sub d)
     | Pwith_module (lid, lid2) ->
-        Pwith_module (map_loc sub lid, map_loc sub lid2)
+        Pwith_module (map_loc_lid sub lid, map_loc_lid sub lid2)
     | Pwith_modtype (lid, mty) ->
-        Pwith_modtype (map_loc sub lid, sub.module_type sub mty)
+        Pwith_modtype (map_loc_lid sub lid, sub.module_type sub mty)
     | Pwith_typesubst (lid, d) ->
-        Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d)
+        Pwith_typesubst (map_loc_lid sub lid, sub.type_declaration sub d)
     | Pwith_modsubst (s, lid) ->
-        Pwith_modsubst (map_loc sub s, map_loc sub lid)
+        Pwith_modsubst (map_loc_lid sub s, map_loc_lid sub lid)
     | Pwith_modtypesubst (lid, mty) ->
-        Pwith_modtypesubst (map_loc sub lid, sub.module_type sub mty)
+        Pwith_modtypesubst (map_loc_lid sub lid, sub.module_type sub mty)
 
   let map_signature_item sub {psig_desc = desc; psig_loc = loc} =
     let open Sig in
@@ -450,7 +471,7 @@ module M = struct
     let loc = sub.location sub loc in
     let attrs = sub.attributes sub attrs in
     match desc with
-    | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x)
+    | Pmod_ident x -> ident ~loc ~attrs (map_loc_lid sub x)
     | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str)
     | Pmod_functor (params, body) ->
         functor_ ~loc ~attrs
@@ -561,16 +582,17 @@ module E = struct
     | Pexp_match (e, pel, iea) ->
         match_ ~loc ~attrs ~infix_ext_attrs:(sub.infix_ext_attrs sub iea) (sub.expr sub e) (sub.cases sub pel)
     | Pexp_try (e, pel, iea) -> try_ ~loc ~attrs ~infix_ext_attrs:(sub.infix_ext_attrs sub iea) (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 (l, e) -> l, sub.expr sub e) el)
     | Pexp_construct (lid, arg) ->
-        construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg)
+        construct ~loc ~attrs (map_loc_lid sub lid) (map_opt (sub.expr sub) arg)
     | Pexp_variant (lab, eo) ->
         variant ~loc ~attrs (variant_var sub lab) (map_opt (sub.expr sub) eo)
     | Pexp_record (l, eo) ->
         let fields =
           List.map
             (map_tuple3
-               (map_loc sub)
+               (map_loc_lid sub)
                (map_opt (map_constraint sub))
                (map_opt (sub.expr sub)))
             l
@@ -579,7 +601,7 @@ module E = struct
     | Pexp_field (e, lid) ->
         field ~loc ~attrs (sub.expr sub e) (map_loc sub lid)
     | Pexp_setfield (e1, lid, e2) ->
-        setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid)
+        setfield ~loc ~attrs (sub.expr sub e1) (map_loc_lid sub lid)
           (sub.expr sub e2)
     | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el)
     | Pexp_list el -> list ~loc ~attrs (List.map (sub.expr sub) el)
@@ -690,9 +712,10 @@ 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,c) ->
+        tuple ~loc ~attrs (List.map (fun (l, p) -> l, sub.pat sub p) pl) c
     | Ppat_construct (l, p) ->
-        construct ~loc ~attrs (map_loc sub l)
+        construct ~loc ~attrs (map_loc_lid sub l)
           (map_opt
              (fun (vl, p) -> List.map (map_loc sub) vl, sub.pat sub p)
              p)
@@ -702,7 +725,7 @@ module P = struct
         let fields =
           List.map
             (map_tuple3
-               (map_loc sub)
+               (map_loc_lid sub)
                (map_opt (sub.typ sub))
                (map_opt (sub.pat sub)))
             lpl
@@ -734,7 +757,7 @@ module CE = struct
     let attrs = sub.attributes sub attrs in
     match desc with
     | Pcl_constr (lid, tys) ->
-        constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys)
+        constr ~loc ~attrs (map_loc_lid sub lid) (List.map (sub.typ sub) tys)
     | Pcl_structure s ->
         structure ~loc ~attrs (sub.class_structure sub s)
     | Pcl_fun (p, ce) ->
@@ -839,6 +862,7 @@ let default_mapper =
     type_extension = T.map_type_extension;
     type_exception = T.map_type_exception;
     extension_constructor = T.map_extension_constructor;
+    package_type = map_package_type;
     value_description =
       (fun this {pval_name; pval_type; pval_prim; pval_loc;
                  pval_attributes} ->
@@ -904,7 +928,7 @@ let default_mapper =
 
     open_description =
       (fun this {popen_expr; popen_override; popen_attributes; popen_loc} ->
-         Opn.mk (map_loc this popen_expr)
+         Opn.mk (map_loc_lid this popen_expr)
            ~override:popen_override
            ~loc:(this.location this popen_loc)
            ~attrs:(this.ext_attrs this popen_attributes)
@@ -1003,7 +1027,10 @@ let default_mapper =
 
     directive_argument =
       (fun this a ->
-         { pdira_desc= a.pdira_desc
+         { pdira_desc= (match a.pdira_desc with
+               | Pdir_ident i -> Pdir_ident (map_lid this i)
+               | x -> x
+             )
          ; pdira_loc= this.location this a.pdira_loc} );
 
     toplevel_directive =
@@ -1074,12 +1101,13 @@ module PpxContext = struct
   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 "::")
+        (Some (Exp.tuple [None, f x; None, make_list f rest]))
     | [] ->
       Exp.construct (lid "[]") None
 
   let make_pair f1 f2 (x1, x2) =
-    Exp.tuple [f1 x1; f2 x2]
+    Exp.tuple [None, f1 x1; None, f2 x2]
 
   let make_option f opt =
     match opt with
@@ -1116,7 +1144,7 @@ module PpxContext = struct
         lid "use_vmthreads", make_bool false;
         lid "recursive_types", make_bool !Clflags.recursive_types;
         lid "principal", make_bool !Clflags.principal;
-        lid "transparent_modules", make_bool !Clflags.transparent_modules;
+        lid "no_alias_deps", make_bool !Clflags.no_alias_deps;
         lid "unboxed_types", make_bool !Clflags.unboxed_types;
         lid "unsafe_string", make_bool false; (* kept for compatibility *)
         get_cookies ()
@@ -1151,7 +1179,8 @@ module PpxContext = struct
       and get_list elem = function
         | {pexp_desc =
              Pexp_construct ({txt = Longident.Lident "::"},
-                             Some {pexp_desc = Pexp_tuple [exp; rest]}) } ->
+                             Some {pexp_desc = Pexp_tuple [None, exp;
+                                                           None, rest]}) } ->
             elem exp :: get_list elem rest
         | {pexp_desc =
              Pexp_construct ({txt = Longident.Lident "[]"}, None)} ->
@@ -1159,7 +1188,7 @@ module PpxContext = struct
         | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
                              { %s }] list syntax" name
       and get_pair f1 f2 = function
-        | {pexp_desc = Pexp_tuple [e1; e2]} ->
+        | {pexp_desc = Pexp_tuple [None, e1; None, e2]} ->
             (f1 e1, f2 e2)
         | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
                              { %s }] pair syntax" name
@@ -1209,8 +1238,8 @@ module PpxContext = struct
           Clflags.recursive_types := get_bool payload
       | "principal" ->
           Clflags.principal := get_bool payload
-      | "transparent_modules" ->
-          Clflags.transparent_modules := get_bool payload
+      | "no_alias_deps" ->
+          Clflags.no_alias_deps := get_bool payload
       | "unboxed_types" ->
           Clflags.unboxed_types := get_bool payload
       | "cookies" ->
diff --git a/vendor/parser-extended/asttypes.mli b/vendor/parser-extended/asttypes.mli
index a6d6f0adbc..8dd8eb1b88 100644
--- a/vendor/parser-extended/asttypes.mli
+++ b/vendor/parser-extended/asttypes.mli
@@ -45,6 +45,8 @@ type mutable_flag = Immutable | Mutable of Location.t
 
 type virtual_flag = Virtual of Location.t | Concrete
 
+type atomic_flag = Nonatomic | Atomic of Location.t
+
 type private_virtual = {pv_priv: Location.t option; pv_virt: Location.t option}
 
 type mutable_virtual = {mv_mut: Location.t option; mv_virt: Location.t option}
diff --git a/vendor/parser-extended/parser.mly b/vendor/parser-extended/parser.mly
index 93cc03212d..7ff75f8760 100644
--- a/vendor/parser-extended/parser.mly
+++ b/vendor/parser-extended/parser.mly
@@ -116,6 +116,7 @@ let mkrhs rhs loc = mkloc rhs (make_loc loc)
 (*
 let ghrhs rhs loc = mkloc rhs (ghost_loc loc)
 *)
+let ldot lid lid_loc name loc = Ldot (mkrhs lid lid_loc, mkrhs name loc)
 
 let push_loc x acc =
   if x.Location.loc_ghost
@@ -319,9 +320,9 @@ let indexop_unclosed_error loc_s s loc_e =
   let left, right = paren_to_strings s in
   unclosed left loc_s right loc_e
 
-let lapply ~loc p1 p2 =
+let lapply ~loc p1 loc_p1 p2 loc_p2 =
   if !Clflags.applicative_functors
-  then Lapply(p1, p2)
+  then Lapply(mkrhs p1 loc_p1, mkrhs p2 loc_p2)
   else raise (Syntaxerr.Error(
                   Syntaxerr.Applicative_path (make_loc loc)))
 
@@ -805,7 +806,7 @@ The precedences must be listed from low to high.
 %nonassoc AS
 %left     BAR                           /* pattern (p|p|p) */
 %nonassoc below_COMMA
-%left     COMMA                         /* expr/expr_comma_list (e,e,e) */
+%left     COMMA                         /* expr/labeled_tuple (e,e,e) */
 %right    MINUSGREATER                  /* function_type (t -> t -> t) */
 %right    OR BARBAR                     /* expr (e || e || e) */
 %right    AMPERSAND AMPERAMPER          /* expr (e && e && e) */
@@ -1400,11 +1401,11 @@ paren_module_expr:
 %inline expr_colon_package_type:
     e = expr
       { e, None, None }
-  | e = expr COLON ty1 = package_type
+  | e = expr COLON ty1 = package_type_
       { e, Some ty1, None }
-  | e = expr COLON ty1 = package_type COLONGREATER ty2 = package_type
+  | e = expr COLON ty1 = package_type_ COLONGREATER ty2 = package_type_
       { e, Some ty1, Some ty2 }
-  | e = expr COLONGREATER ty2 = package_type
+  | e = expr COLONGREATER ty2 = package_type_
       { e, None, Some ty2 }
 ;
 
@@ -2419,7 +2420,7 @@ fun_expr:
 %inline expr_:
   | simple_expr nonempty_llist(labeled_simple_expr)
       { Pexp_apply($1, $2) }
-  | expr_comma_list %prec below_COMMA
+  | labeled_tuple %prec below_COMMA
       { Pexp_tuple($1) }
   | mkrhs(constr_longident) simple_expr %prec below_HASH
       { Pexp_construct($1, Some $2) }
@@ -2466,7 +2467,7 @@ simple_expr:
       { Pexp_new($3, $2) }
   | LPAREN MODULE expr_ext_attributes module_expr RPAREN
       { Pexp_pack ($4, None, $3) }
-  | LPAREN MODULE expr_ext_attributes module_expr COLON package_type RPAREN
+  | LPAREN MODULE expr_ext_attributes module_expr COLON package_type_ RPAREN
       { Pexp_pack ($4, Some $6, $3) }
   | LPAREN MODULE expr_ext_attributes module_expr COLON error
       { unclosed "(" $loc($1) ")" $loc($6) }
@@ -2572,10 +2573,10 @@ simple_expr:
     LBRACKET expr_semi_list error
       { unclosed "[" $loc($3) "]" $loc($5) }
   | od=open_dot_declaration DOT LPAREN MODULE expr_ext_attributes module_expr COLON
-    package_type RPAREN
+    ptyp = package_type_ RPAREN
       { let modexp =
           mkexp ~loc:($startpos($3), $endpos)
-            (Pexp_pack ($6, Some $8, $5)) in
+            (Pexp_pack ($6, Some ptyp, $5)) in
         Pexp_open(od, modexp) }
   | mod_longident DOT
     LPAREN MODULE ext_attributes module_expr COLON error
@@ -2756,6 +2757,84 @@ fun_param_as_list:
 fun_params:
   | nonempty_concat(fun_param_as_list) { $1 }
 *)
+
+(* 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 c = type_constraint RPAREN %prec below_HASH
+      { Some label,
+        mkexp_constraint ~loc:($startpos($2), $endpos)
+          (mkexpvar ~loc:$loc(label) label) c }
+;
+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 c = type_constraint RPAREN
+  COMMA
+  x2 = labeled_tuple_element
+  { let x1 =
+      mkexp_constraint ~loc:($startpos($2), $endpos)
+        (mkexpvar ~loc:$loc(l1) l1) c
+    in
+    [ x2; Some l1, x1] }
+;
+%inline labeled_tuple:
+  xs = rev(reversed_labeled_tuple_body)
+    { xs }
 param_val:
   | labeled_simple_pattern
       { $1 }
@@ -2777,10 +2856,6 @@ class_fun_param:
 ;
 expr_fun_params:
   | nonempty_llist(expr_fun_param) { $1 }
-%inline expr_comma_list:
-  es = separated_nontrivial_llist(COMMA, expr)
-    { es }
-;
 record_expr_content:
   eo = ioption(terminated(simple_expr, WITH))
   fields = separated_or_terminated_nonempty_list(SEMI, record_expr_field)
@@ -2870,8 +2945,8 @@ 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) }
+    | labeled_tuple_pattern(self)
+        { $1 }
     | self COLONCOLON error
         { expecting $loc($3) "pattern" }
     | self BAR pattern
@@ -2916,7 +2991,7 @@ simple_pattern_not_ident:
       { $1 }
   | LPAREN MODULE ext_attributes mkrhs(module_name) RPAREN
       { mkpat_attrs ~loc:$sloc (Ppat_unpack ($4, None)) $3 }
-  | LPAREN MODULE ext_attributes mkrhs(module_name) COLON package_type RPAREN
+  | LPAREN MODULE ext_attributes mkrhs(module_name) COLON package_type_ RPAREN
       { mkpat_attrs ~loc:$sloc (Ppat_unpack ($4, Some $6)) $3 }
   | mkpat(simple_pattern_not_ident_)
       { $1 }
@@ -2954,7 +3029,7 @@ simple_pattern_not_ident:
       { unclosed "(" $loc($1) ")" $loc($5) }
   | LPAREN pattern COLON error
       { expecting $loc($4) "type" }
-  | LPAREN MODULE ext_attributes module_name COLON package_core_type
+  | LPAREN MODULE ext_attributes module_name COLON package_type
     error
       { unclosed "(" $loc($1) ")" $loc($7) }
   | extension
@@ -2980,10 +3055,66 @@ simple_delimited_pattern:
       { unclosed "[|" $loc($1) "|]" $loc($3) }
   ) { $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" }
+(* 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 lbl_loc = $loc(label) in
+        let pat_loc = $startpos($2), $endpos in
+        let pat = mkpatvar ~loc:lbl_loc label in
+        Some label, mkpat ~loc:pat_loc (Ppat_constraint(pat, cty)) }
+;
+(* If changing this, don't forget to change its copy just above. *)
+%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 lbl_loc = $loc(label) in
+        let pat_loc = $startpos($2), $endpos in
+        let pat = mkpatvar ~loc:lbl_loc label in
+        Some label, mkpat ~loc:pat_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 ] }
+;
+labeled_tuple_pattern(self):
+  | reversed_labeled_tuple_pattern(self)
+      { let closed, pat = $1 in
+        Ppat_tuple(List.rev pat, closed) }
 ;
 %inline pattern_semi_list:
   ps = separated_or_terminated_nonempty_list(SEMI, pattern)
@@ -3185,10 +3316,12 @@ type_variance:
   | MINUS BANG  { [ mkvarinj "-" $loc($1); mkvarinj "!" $loc($2) ] }
   | BANG MINUS  { [ mkvarinj "!" $loc($1); mkvarinj "-" $loc($2) ] }
   | INFIXOP2
-      { if ($1 = "+!") || ($1 = "-!") then [ mkvarinj $1 $sloc ]
+      { if $1 = "+!" ||  $1 = "-!" || $1 = "+-"|| $1 = "-+"
+        ||  $1 = "+-!" || $1 = "-+!"  then [ mkvarinj $1 $sloc ]
         else expecting $loc($1) "type_variance" }
   | PREFIXOP
-      { if ($1 = "!+") || ($1 = "!-") then [ mkvarinj $1 $sloc ]
+      { if ($1 = "!+") || ($1 = "!-") || ($1 = "!+-") || ($1 = "!-+")
+        then [ mkvarinj $1 $sloc ]
         else expecting $loc($1) "type_variance" }
 ;
 
@@ -3488,6 +3621,40 @@ function_type:
         }
     )
     { $1 }
+  (* The next two cases are for labled tuples - see comment on [tuple_type]
+     below.
+
+     The first case is 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]
+     It is the same as the previous case, but with [arg_label] specialized to
+     [LIDENT COLON] and the domain type specialized to [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
+      tuple = proper_tuple_type
+      MINUSGREATER
+      codomain = function_type
+        { let ty, ltys = tuple in
+          let tuple_loc = $loc(tuple) in
+          let domain =
+            mktyp ~loc:tuple_loc (Ptyp_tuple ((None, ty) :: ltys))
+          in
+          let domain = extra_rhs_core_type domain ~pos:(snd tuple_loc) in
+          let arrow_type = {
+            pap_label = Labelled (mkrhs label $loc(label));
+            pap_loc = make_loc $sloc;
+            pap_type = domain;
+          }
+          in
+          Ptyp_arrow([arrow_type], codomain) }
+    )
+    { $1 }
+  | label = LIDENT COLON proper_tuple_type %prec MINUSGREATER
+    { let ty, ltys = $3 in
+      mktyp ~loc:$sloc (Ptyp_tuple ((Some label, ty) :: ltys))
+    }
 ;
 %inline arg_label:
   | label = optlabel
@@ -3501,16 +3668,33 @@ 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
+   function_type above.  This resolves ambiguities around [x:t1 * t2 -> t3]
+   which must continue to parse as a function with one labeled argument even in
+   the presence 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_WITH
+    { 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
+     { Some label, ty }
 ;
 
 (* Atomic types are the most basic level in the syntax of types.
@@ -3547,7 +3731,7 @@ tuple_type:
 delimited_type_supporting_local_open:
   | LPAREN type_ = core_type RPAREN
       { type_ }
-  | LPAREN MODULE attrs = ext_attributes package_type = package_core_type RPAREN
+  | LPAREN MODULE attrs = ext_attributes package_type = package_type RPAREN
       { wrap_typ_attrs ~loc:$sloc (reloc_typ ~loc:$sloc package_type) attrs }
   | mktyp(
       LBRACKET field = tag_field RBRACKET
@@ -3638,13 +3822,12 @@ atomic_type:
       { tys }
 ;
 
-%inline package_core_type: module_type
+%inline package_type_: module_type
       { let (lid, cstrs, attrs) = package_type_of_module_type $1 in
-        let descr = Ptyp_package (lid, cstrs, []) in
-        mktyp ~loc:$sloc ~attrs descr }
-;
-%inline package_type: module_type
-      { package_type_of_module_type $1 }
+        Typ.package_type ~loc:(make_loc $sloc) ~attrs lid cstrs }
+
+%inline package_type: package_type_
+      { mktyp ~loc:$sloc (Ptyp_package $1) }
 ;
 %inline row_field_list:
   separated_nonempty_llist(BAR, row_field)
@@ -3817,13 +4000,13 @@ constr_ident:
 ;
 constr_longident:
     mod_longident       %prec below_DOT  { $1 } /* A.B.x vs (A).B.x */
-  | mod_longident DOT constr_extra_ident { Ldot($1,$3) }
+  | mod_longident DOT constr_extra_ident { ldot $1 $loc($1) $3 $loc($3) }
   | constr_extra_ident                   { Lident $1 }
   | constr_extra_nonprefix_ident         { Lident $1 }
 ;
 mk_longident(prefix,final):
    | final            { Lident $1 }
-   | prefix DOT final { Ldot($1,$3) }
+   | prefix DOT final { ldot $1 $loc($1) $3 $loc($3) }
 ;
 val_longident:
     mk_longident(mod_longident, val_ident) { $1 }
@@ -3846,7 +4029,7 @@ mod_ext_longident:
     mk_longident(mod_ext_longident, UIDENT) { $1 }
   | mod_longident_disam { $1 }
   | mod_ext_longident LPAREN mod_ext_longident RPAREN
-      { lapply ~loc:$sloc $1 $3 }
+      { lapply ~loc:$sloc $1 $loc($1) $3 $loc($3) }
   | mod_ext_longident LPAREN error
       { expecting $loc($3) "module path" }
 ;
@@ -4018,6 +4201,7 @@ single_attr_id:
   | DO { "do" }
   | DONE { "done" }
   | DOWNTO { "downto" }
+  | EFFECT { "effect" }
   | ELSE { "else" }
   | END { "end" }
   | EXCEPTION { "exception" }
diff --git a/vendor/parser-extended/parsetree.mli b/vendor/parser-extended/parsetree.mli
index ab37cfcbbd..ec688f8085 100644
--- a/vendor/parser-extended/parsetree.mli
+++ b/vendor/parser-extended/parsetree.mli
@@ -122,9 +122,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 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].
         *)
@@ -173,6 +178,15 @@ and core_type_desc =
              to a constraint on a let-binding:
             {[let x : 'a1 ... 'an. T = e ...]}
 
+           - Under {{!class_field_kind.Cfk_virtual}[Cfk_virtual]} for methods
+          (not values).
+
+           - As the {!core_type} of a
+           {{!class_type_field_desc.Pctf_method}[Pctf_method]} node.
+
+           - As the {!core_type} of a {{!expression_desc.Pexp_poly}[Pexp_poly]}
+           node.
+
            - As the {{!label_declaration.pld_type}[pld_type]} field of a
            {!label_declaration}.
 
@@ -186,10 +200,16 @@ and core_type_desc =
   | Ptyp_open of Longident.t loc * core_type (** [M.(T)] *)
   | Ptyp_extension of extension  (** [[%id]]. *)
 
-and package_type = Longident.t loc * (Longident.t loc * core_type) list * attributes
+and package_type =
+    {
+     ppt_path: Longident.t loc;
+     ppt_cstrs: (Longident.t loc * core_type) list;
+     ppt_loc: Location.t;
+     ppt_attrs: attributes;
+    }
 (** As {!package_type} typed values:
-         - [(S, [])] represents [(module S)],
-         - [(S, [(t1, T1) ; ... ; (tn, Tn)])]
+         - [{ppt_path: S; ppt_cstrs: []}] represents [(module S)],
+         - [{ppt_path: S; ppt_cstrs: [(t1, T1) ; ... ; (tn, Tn)]}]
           represents [(module S with type t1 = T1 and ... and tn = Tn)].
        *)
 
@@ -246,11 +266,22 @@ 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 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)]
+
+          [Ppat_tuple(pl, Open)] is similar, but indicates the pattern
+          additionally 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],
@@ -331,8 +362,9 @@ and expression_desc =
       [C] represents a type constraint or coercion placed immediately before the
       arrow, e.g. [fun P1 ... Pn : ty -> ...] when [C = Some (Pconstraint ty)].
 
-      A function must have parameters. [Pexp_function (params, _, body)] must
-      have non-empty [params] or a [Pfunction_cases _] body.
+      A function must have parameters: in [Pexp_function (params, _, body)],
+      if [params] does not contain a [Pparam_val _], [body] must be
+      [Pfunction_cases _].
   *)
   | Pexp_apply of expression * (arg_label * expression) list
       (** [Pexp_apply(E0, [(l1, E1) ; ... ; (ln, En)])]
@@ -349,8 +381,14 @@ and expression_desc =
       (** [match E0 with P1 -> E1 | ... | Pn -> En] *)
   | Pexp_try of expression * case list * infix_ext_attrs
       (** [try E0 with P1 -> E1 | ... | Pn -> En] *)
-  | Pexp_tuple of expression list
-      (** Expressions [(E1, ..., En)]
+  | Pexp_tuple of (string 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]
         *)
diff --git a/vendor/parser-extended/printast.ml b/vendor/parser-extended/printast.ml
index 5c581d7791..a3209c2230 100644
--- a/vendor/parser-extended/printast.ml
+++ b/vendor/parser-extended/printast.ml
@@ -74,9 +74,9 @@ let fmt_location f loc =
 let rec fmt_longident_aux f x =
   match x with
   | Longident.Lident (s) -> fprintf f "%s" s
-  | Longident.Ldot (y, s) -> fprintf f "%a.%s" fmt_longident_aux y s
+  | Longident.Ldot (y, s) -> fprintf f "%a.%s" fmt_longident_aux y.txt s.txt
   | Longident.Lapply (y, z) ->
-      fprintf f "%a(%a)" fmt_longident_aux y fmt_longident_aux z
+      fprintf f "%a(%a)" fmt_longident_aux y.txt fmt_longident_aux z.txt
 
 let fmt_longident f x = fprintf f "\"%a\"" fmt_longident_aux x
 
@@ -192,6 +192,10 @@ let typevars ppf vs =
   List.iter (fun x ->
       fprintf ppf " %a %a" Pprintast.tyvar x.txt fmt_location x.loc) vs
 
+let labeled_tuple_element f i ppf (l, ct) =
+  option i string ppf l;
+  f i ppf ct
+
 let variant_var i ppf (x : variant_var) =
   line i ppf "variant_var %a\n" fmt_location x.loc;
   string_loc (i+1) ppf x.txt
@@ -209,7 +213,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_tuple_element 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;
@@ -229,9 +233,9 @@ let rec core_type i ppf x =
   | Ptyp_poly (sl, ct) ->
       line i ppf "Ptyp_poly%a\n" typevars sl;
       core_type i ppf ct;
-  | Ptyp_package pt ->
+  | Ptyp_package ptyp ->
       line i ppf "Ptyp_package\n";
-      package_type i ppf pt
+      package_type i ppf ptyp;
   | Ptyp_open (mod_ident, t) ->
       line i ppf "Ptyp_open \"%a\"\n" fmt_longident_loc mod_ident;
       core_type i ppf t
@@ -256,15 +260,16 @@ and object_field i ppf x =
       line i ppf "Oinherit\n";
       core_type i ppf ct
 
+and package_type i ppf ptyp =
+  let i = i + 1 in
+  line i ppf "package_type %a\n" fmt_longident_loc ptyp.ppt_path;
+  attributes i ppf ptyp.ppt_attrs;
+  list i package_with ppf ptyp.ppt_cstrs;
+
 and package_with i ppf (s, t) =
   line i ppf "with type %a\n" fmt_longident_loc s;
   core_type i ppf t
 
-and package_type i ppf (s, l, attrs) =
-  line i ppf "package_type %a\n" fmt_longident_loc s;
-  attributes (i+1) ppf attrs;
-  list i package_with ppf l
-
 and pattern i ppf x =
   line i ppf "pattern %a\n" fmt_location x.ppat_loc;
   attributes i ppf x.ppat_attributes;
@@ -282,9 +287,9 @@ and pattern i ppf x =
       line i ppf "Ppat_interval\n";
       fmt_constant i ppf c1;
       fmt_constant i ppf c2;
-  | Ppat_tuple (l) ->
-      line i ppf "Ppat_tuple\n";
-      list i pattern ppf l;
+  | Ppat_tuple (l, c) ->
+      line i ppf "Ppat_tuple\n %a\n" fmt_closed_flag c;
+      list i (labeled_tuple_element pattern) ppf l;
   | Ppat_construct (li, po) ->
       line i ppf "Ppat_construct %a\n" fmt_longident_loc li;
       option i
@@ -374,7 +379,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_tuple_element expression) ppf l;
   | Pexp_construct (li, eo) ->
       line i ppf "Pexp_construct %a\n" fmt_longident_loc li;
       option i expression ppf eo;
diff --git a/vendor/parser-shims/ocamlformat_parser_shims.ml b/vendor/parser-shims/ocamlformat_parser_shims.ml
index 1420bf7ba3..53acdc8c27 100644
--- a/vendor/parser-shims/ocamlformat_parser_shims.ml
+++ b/vendor/parser-shims/ocamlformat_parser_shims.ml
@@ -17,6 +17,7 @@ module Clflags : sig
   val applicative_functors : bool ref
   val for_package : string option ref
   val transparent_modules : bool ref
+  val no_alias_deps: bool ref
   val locations : bool ref
   val color : Misc.Color.setting option ref
   val error_style : Misc.Error_style.setting option ref
@@ -35,6 +36,7 @@ end = struct
   let applicative_functors = ref true     (* -no-app-funct *)
   let for_package = ref (None: string option) (* -for-pack *)
   let transparent_modules = ref false     (* -trans-mod *)
+  let no_alias_deps = transparent_modules
   let locations = ref true                (* -d(no-)locations *)
   let color = ref None                    (* -color *)
   let error_style = ref None              (* -error-style *)
diff --git a/vendor/parser-standard/ast_helper.ml b/vendor/parser-standard/ast_helper.ml
index f2ee0f6248..d7aa011351 100644
--- a/vendor/parser-standard/ast_helper.ml
+++ b/vendor/parser-standard/ast_helper.ml
@@ -75,7 +75,7 @@ module Typ = struct
   let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b))
   let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c))
   let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b))
-  let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b))
+  let package ?loc ?attrs a = mk ?loc ?attrs (Ptyp_package a)
   let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a)
   let open_ ?loc ?attrs mod_ident t = mk ?loc ?attrs (Ptyp_open (mod_ident, t))
 
@@ -98,7 +98,8 @@ module Typ = struct
             Ptyp_var x
         | Ptyp_arrow (label,core_type,core_type') ->
             Ptyp_arrow(label, loop core_type, loop core_type')
-        | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
+        | Ptyp_tuple lst ->
+            Ptyp_tuple (List.map (fun (l, t) -> l, loop t) lst)
         | Ptyp_constr( { txt = Longident.Lident s }, [])
           when List.mem s var_names ->
             Ptyp_var s
@@ -118,8 +119,8 @@ module Typ = struct
           List.iter (fun v ->
             check_variable var_names t.ptyp_loc v.txt) string_lst;
             Ptyp_poly(string_lst, loop core_type)
-        | Ptyp_package(longident,lst) ->
-            Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst)
+        | Ptyp_package ptyp ->
+            Ptyp_package (loop_package_type ptyp)
         | Ptyp_open (mod_ident, core_type) ->
             Ptyp_open (mod_ident, loop core_type)
         | Ptyp_extension (s, arg) ->
@@ -142,9 +143,17 @@ module Typ = struct
             Oinherit (loop t)
       in
       { field with pof_desc; }
+    and loop_package_type ptyp =
+      { ptyp with
+        ppt_cstrs = List.map (fun (n,typ) -> (n,loop typ) ) ptyp.ppt_cstrs }
     in
     loop t
 
+  let package_type ?(loc = !default_loc) ?(attrs = []) p c =
+    {ppt_loc = loc;
+     ppt_path = p;
+     ppt_cstrs = c;
+     ppt_attrs = attrs}
 end
 
 module Pat = struct
@@ -160,7 +169,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))
@@ -215,7 +224,7 @@ module Exp = struct
   let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b))
   let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a)
   let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b))
-  let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a)
+  let pack ?loc ?attrs a b = mk ?loc ?attrs (Pexp_pack (a, b))
   let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_open (a, b))
   let letop ?loc ?attrs let_ ands body =
     mk ?loc ?attrs (Pexp_letop {let_; ands; body})
diff --git a/vendor/parser-standard/ast_mapper.ml b/vendor/parser-standard/ast_mapper.ml
index d180d09a41..9e9f7405c9 100644
--- a/vendor/parser-standard/ast_mapper.ml
+++ b/vendor/parser-standard/ast_mapper.ml
@@ -66,6 +66,7 @@ type mapper = {
                            -> module_type_declaration;
   open_declaration: mapper -> open_declaration -> open_declaration;
   open_description: mapper -> open_description -> open_description;
+  package_type: mapper -> package_type -> package_type;
   pat: mapper -> pattern -> pattern;
   payload: mapper -> payload -> payload;
   signature: mapper -> signature -> signature;
@@ -92,6 +93,22 @@ let map_opt f = function None -> None | Some x -> Some (f x)
 
 let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt}
 
+let rec map_lid sub lid =
+  let open Longident in
+  match lid with
+  | Lident id -> Lident id
+  | Ldot (lid, id) ->
+      let lid = { lid with txt = map_lid sub lid.txt } in
+      Ldot (map_loc sub lid, map_loc sub id)
+  | Lapply (lid, lid') ->
+    let lid = { lid with txt = map_lid sub lid.txt } in
+    let lid' = { lid' with txt = map_lid sub lid'.txt } in
+    Lapply(map_loc sub lid, map_loc sub lid')
+
+let map_loc_lid sub {loc; txt} =
+  let txt = map_lid sub txt in
+  map_loc sub {loc; txt}
+
 module C = struct
   (* Constants *)
 
@@ -147,13 +164,14 @@ module T = struct
     | Ptyp_var s -> var ~loc ~attrs s
     | Ptyp_arrow (lab, t1, t2) ->
         arrow ~loc ~attrs lab (sub.typ sub t1) (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 (l, t) -> l, sub.typ sub t) tyl)
     | Ptyp_constr (lid, tl) ->
-        constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
+        constr ~loc ~attrs (map_loc_lid sub lid) (List.map (sub.typ sub) tl)
     | Ptyp_object (l, o) ->
         object_ ~loc ~attrs (List.map (object_field sub) l) o
     | Ptyp_class (lid, tl) ->
-        class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
+        class_ ~loc ~attrs (map_loc_lid sub lid) (List.map (sub.typ sub) tl)
     | Ptyp_alias (t, s) ->
         let s = map_loc sub s in
         alias ~loc ~attrs (sub.typ sub t) s
@@ -161,11 +179,10 @@ module T = struct
         variant ~loc ~attrs (List.map (row_field sub) rl) b ll
     | Ptyp_poly (sl, t) -> poly ~loc ~attrs
                              (List.map (map_loc sub) sl) (sub.typ sub t)
-    | Ptyp_package (lid, l) ->
-        package ~loc ~attrs (map_loc sub lid)
-          (List.map (map_tuple (map_loc sub) (sub.typ sub)) l)
+    | Ptyp_package ptyp ->
+        package ~loc ~attrs (sub.package_type sub ptyp)
     | Ptyp_open (mod_ident, t) ->
-        open_ ~loc ~attrs (map_loc sub mod_ident) (sub.typ sub t)
+        open_ ~loc ~attrs (map_loc_lid sub mod_ident) (sub.typ sub t)
     | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x)
 
   let map_type_declaration sub
@@ -207,7 +224,7 @@ module T = struct
     let loc = sub.location sub ptyext_loc in
     let attrs = sub.attributes sub ptyext_attributes in
     Te.mk ~loc ~attrs
-      (map_loc sub ptyext_path)
+      (map_loc_lid sub ptyext_path)
       (List.map (sub.extension_constructor sub) ptyext_constructors)
       ~params:(List.map (map_fst (sub.typ sub)) ptyext_params)
       ~priv:ptyext_private
@@ -225,7 +242,7 @@ module T = struct
                   map_constructor_arguments sub ctl,
                   map_opt (sub.typ sub) cto)
     | Pext_rebind li ->
-        Pext_rebind (map_loc sub li)
+        Pext_rebind (map_loc_lid sub li)
 
   let map_extension_constructor sub
       {pext_name;
@@ -238,6 +255,12 @@ module T = struct
       (map_loc sub pext_name)
       (map_extension_constructor_kind sub pext_kind)
 
+  let map_package_type sub {ppt_loc; ppt_path; ppt_cstrs; ppt_attrs} =
+    let loc = sub.location sub ppt_loc in
+    let attrs = sub.attributes sub ppt_attrs in
+    Typ.package_type ~loc ~attrs (map_loc_lid sub ppt_path)
+      (List.map (map_tuple (map_loc_lid sub) (sub.typ sub)) ppt_cstrs)
+
 end
 
 module CT = struct
@@ -249,7 +272,7 @@ module CT = struct
     let attrs = sub.attributes sub attrs in
     match desc with
     | Pcty_constr (lid, tys) ->
-        constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys)
+        constr ~loc ~attrs (map_loc_lid sub lid) (List.map (sub.typ sub) tys)
     | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x)
     | Pcty_arrow (lab, t, ct) ->
         arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct)
@@ -291,8 +314,8 @@ module MT = struct
     let loc = sub.location sub loc in
     let attrs = sub.attributes sub attrs in
     match desc with
-    | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s)
-    | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s)
+    | Pmty_ident s -> ident ~loc ~attrs (map_loc_lid sub s)
+    | Pmty_alias s -> alias ~loc ~attrs (map_loc_lid sub s)
     | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg)
     | Pmty_functor (param, mt) ->
         functor_ ~loc ~attrs
@@ -306,17 +329,17 @@ module MT = struct
 
   let map_with_constraint sub = function
     | Pwith_type (lid, d) ->
-        Pwith_type (map_loc sub lid, sub.type_declaration sub d)
+        Pwith_type (map_loc_lid sub lid, sub.type_declaration sub d)
     | Pwith_module (lid, lid2) ->
-        Pwith_module (map_loc sub lid, map_loc sub lid2)
+        Pwith_module (map_loc_lid sub lid, map_loc_lid sub lid2)
     | Pwith_modtype (lid, mty) ->
-        Pwith_modtype (map_loc sub lid, sub.module_type sub mty)
+        Pwith_modtype (map_loc_lid sub lid, sub.module_type sub mty)
     | Pwith_typesubst (lid, d) ->
-        Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d)
+        Pwith_typesubst (map_loc_lid sub lid, sub.type_declaration sub d)
     | Pwith_modsubst (s, lid) ->
-        Pwith_modsubst (map_loc sub s, map_loc sub lid)
+        Pwith_modsubst (map_loc_lid sub s, map_loc_lid sub lid)
     | Pwith_modtypesubst (lid, mty) ->
-        Pwith_modtypesubst (map_loc sub lid, sub.module_type sub mty)
+        Pwith_modtypesubst (map_loc_lid sub lid, sub.module_type sub mty)
 
   let map_signature_item sub {psig_desc = desc; psig_loc = loc} =
     let open Sig in
@@ -356,7 +379,7 @@ module M = struct
     let loc = sub.location sub loc in
     let attrs = sub.attributes sub attrs in
     match desc with
-    | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x)
+    | Pmod_ident x -> ident ~loc ~attrs (map_loc_lid sub x)
     | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str)
     | Pmod_functor (param, body) ->
         functor_ ~loc ~attrs
@@ -438,7 +461,7 @@ module E = struct
     let loc = sub.location sub loc in
     let attrs = sub.attributes sub attrs in
     match desc with
-    | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x)
+    | Pexp_ident x -> ident ~loc ~attrs (map_loc_lid sub x)
     | Pexp_constant x -> constant ~loc ~attrs (sub.constant sub x)
     | Pexp_let (r, vbs, e) ->
         let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs)
@@ -453,18 +476,20 @@ 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 (l, e) -> l, sub.expr sub e) el)
     | Pexp_construct (lid, arg) ->
-        construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg)
+        construct ~loc ~attrs (map_loc_lid sub lid) (map_opt (sub.expr sub) arg)
     | Pexp_variant (lab, eo) ->
         variant ~loc ~attrs lab (map_opt (sub.expr sub) eo)
     | Pexp_record (l, eo) ->
-        record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l)
+        record ~loc ~attrs
+          (List.map (map_tuple (map_loc_lid sub) (sub.expr sub)) l)
           (map_opt (sub.expr sub) eo)
     | Pexp_field (e, lid) ->
-        field ~loc ~attrs (sub.expr sub e) (map_loc sub lid)
+        field ~loc ~attrs (sub.expr sub e) (map_loc_lid sub lid)
     | Pexp_setfield (e1, lid, e2) ->
-        setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid)
+        setfield ~loc ~attrs (sub.expr sub e1) (map_loc_lid sub lid)
           (sub.expr sub e2)
     | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el)
     | Pexp_ifthenelse (e1, e2, e3) ->
@@ -484,7 +509,7 @@ module E = struct
         constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t)
     | Pexp_send (e, s) ->
         send ~loc ~attrs (sub.expr sub e) (map_loc sub s)
-    | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid)
+    | Pexp_new lid -> new_ ~loc ~attrs (map_loc_lid sub lid)
     | Pexp_setinstvar (s, e) ->
         setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e)
     | Pexp_override sel ->
@@ -504,7 +529,9 @@ module E = struct
     | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls)
     | Pexp_newtype (s, e) ->
         newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e)
-    | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me)
+    | Pexp_pack (me, optyp) ->
+        let optyp = Option.map (sub.package_type sub) optyp in
+        pack ~loc ~attrs (sub.module_expr sub me) optyp
     | Pexp_open (o, e) ->
         open_ ~loc ~attrs (sub.open_declaration sub o) (sub.expr sub e)
     | Pexp_letop {let_; ands; body} ->
@@ -540,24 +567,26 @@ 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,c) ->
+        tuple ~loc ~attrs (List.map (fun (l, p) -> l, sub.pat sub p) pl) c
     | Ppat_construct (l, p) ->
-        construct ~loc ~attrs (map_loc sub l)
+        construct ~loc ~attrs (map_loc_lid sub l)
           (map_opt
              (fun (vl, p) -> List.map (map_loc sub) vl, sub.pat sub p)
              p)
     | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p)
     | Ppat_record (lpl, cf) ->
         record ~loc ~attrs
-               (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf
+               (List.map (map_tuple (map_loc_lid sub) (sub.pat sub)) lpl) cf
     | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl)
     | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2)
     | Ppat_constraint (p, t) ->
         constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t)
-    | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s)
+    | Ppat_type s -> type_ ~loc ~attrs (map_loc_lid sub s)
     | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p)
     | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s)
-    | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p)
+    | Ppat_open (lid,p) ->
+        open_ ~loc ~attrs (map_loc_lid sub lid) (sub.pat sub p)
     | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p)
     | Ppat_effect(p1, p2) ->
         effect_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2)
@@ -573,7 +602,7 @@ module CE = struct
     let attrs = sub.attributes sub attrs in
     match desc with
     | Pcl_constr (lid, tys) ->
-        constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys)
+        constr ~loc ~attrs (map_loc_lid sub lid) (List.map (sub.typ sub) tys)
     | Pcl_structure s ->
         structure ~loc ~attrs (sub.class_structure sub s)
     | Pcl_fun (lab, e, p, ce) ->
@@ -663,6 +692,7 @@ let default_mapper =
     type_extension = T.map_type_extension;
     type_exception = T.map_type_exception;
     extension_constructor = T.map_extension_constructor;
+    package_type = T.map_package_type;
     value_description =
       (fun this {pval_name; pval_type; pval_prim; pval_loc;
                  pval_attributes} ->
@@ -691,7 +721,7 @@ let default_mapper =
       (fun this {pms_name; pms_manifest; pms_attributes; pms_loc} ->
          Ms.mk
            (map_loc this pms_name)
-           (map_loc this pms_manifest)
+           (map_loc_lid this pms_manifest)
            ~attrs:(this.attributes this pms_attributes)
            ~loc:(this.location this pms_loc)
       );
@@ -723,7 +753,7 @@ let default_mapper =
 
     open_description =
       (fun this {popen_expr; popen_override; popen_attributes; popen_loc} ->
-         Opn.mk (map_loc this popen_expr)
+         Opn.mk (map_loc_lid this popen_expr)
            ~override:popen_override
            ~loc:(this.location this popen_loc)
            ~attrs:(this.attributes this popen_attributes)
@@ -822,7 +852,10 @@ let default_mapper =
 
     directive_argument =
       (fun this a ->
-         { pdira_desc= a.pdira_desc
+         { pdira_desc= (match a.pdira_desc with
+               | Pdir_ident i -> Pdir_ident (map_lid this i)
+               | x -> x
+             )
          ; pdira_loc= this.location this a.pdira_loc} );
 
     toplevel_directive =
@@ -887,12 +920,13 @@ module PpxContext = struct
   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 "::")
+        (Some (Exp.tuple [None, f x; None, make_list f rest]))
     | [] ->
       Exp.construct (lid "[]") None
 
   let make_pair f1 f2 (x1, x2) =
-    Exp.tuple [f1 x1; f2 x2]
+    Exp.tuple [None, f1 x1; None, f2 x2]
 
   let make_option f opt =
     match opt with
@@ -929,7 +963,7 @@ module PpxContext = struct
         lid "use_vmthreads", make_bool false;
         lid "recursive_types", make_bool !Clflags.recursive_types;
         lid "principal", make_bool !Clflags.principal;
-        lid "transparent_modules", make_bool !Clflags.transparent_modules;
+        lid "no_alias_deps", make_bool !Clflags.no_alias_deps;
         lid "unboxed_types", make_bool !Clflags.unboxed_types;
         lid "unsafe_string", make_bool false; (* kept for compatibility *)
         get_cookies ()
@@ -964,7 +998,8 @@ module PpxContext = struct
       and get_list elem = function
         | {pexp_desc =
              Pexp_construct ({txt = Longident.Lident "::"},
-                             Some {pexp_desc = Pexp_tuple [exp; rest]}) } ->
+                             Some {pexp_desc = Pexp_tuple [None, exp;
+                                                           None, rest]}) } ->
             elem exp :: get_list elem rest
         | {pexp_desc =
              Pexp_construct ({txt = Longident.Lident "[]"}, None)} ->
@@ -972,7 +1007,7 @@ module PpxContext = struct
         | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
                              { %s }] list syntax" name
       and get_pair f1 f2 = function
-        | {pexp_desc = Pexp_tuple [e1; e2]} ->
+        | {pexp_desc = Pexp_tuple [None, e1; None, e2]} ->
             (f1 e1, f2 e2)
         | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
                              { %s }] pair syntax" name
@@ -1022,8 +1057,8 @@ module PpxContext = struct
           Clflags.recursive_types := get_bool payload
       | "principal" ->
           Clflags.principal := get_bool payload
-      | "transparent_modules" ->
-          Clflags.transparent_modules := get_bool payload
+      | "no_alias_deps" ->
+          Clflags.no_alias_deps := get_bool payload
       | "unboxed_types" ->
           Clflags.unboxed_types := get_bool payload
       | "cookies" ->
diff --git a/vendor/parser-standard/asttypes.mli b/vendor/parser-standard/asttypes.mli
index 7a4f1c1913..3e8c0ae0e7 100644
--- a/vendor/parser-standard/asttypes.mli
+++ b/vendor/parser-standard/asttypes.mli
@@ -38,6 +38,8 @@ type private_flag = Private | Public
 
 type mutable_flag = Immutable | Mutable
 
+type atomic_flag = Nonatomic | Atomic
+
 type virtual_flag = Virtual | Concrete
 
 type override_flag = Override | Fresh
@@ -61,6 +63,7 @@ type variance =
   | Covariant
   | Contravariant
   | NoVariance
+  | Bivariant
 
 type injectivity =
   | Injective
diff --git a/vendor/parser-standard/parser.mly b/vendor/parser-standard/parser.mly
index 1c8317c710..8cf3b557bb 100644
--- a/vendor/parser-standard/parser.mly
+++ b/vendor/parser-standard/parser.mly
@@ -50,8 +50,8 @@ let ghost_loc (startpos, endpos) = {
 }
 
 let mktyp ~loc ?attrs d = Typ.mk ~loc:(make_loc loc) ?attrs d
-let mkpat ~loc d = Pat.mk ~loc:(make_loc loc) d
-let mkexp ~loc d = Exp.mk ~loc:(make_loc loc) d
+let mkpat ~loc ?attrs d = Pat.mk ~loc:(make_loc loc) ?attrs d
+let mkexp ~loc ?attrs d = Exp.mk ~loc:(make_loc loc) ?attrs d
 let mkmty ~loc ?attrs d = Mty.mk ~loc:(make_loc loc) ?attrs d
 let mksig ~loc d = Sig.mk ~loc:(make_loc loc) d
 let mkmod ~loc ?attrs d = Mod.mk ~loc:(make_loc loc) ?attrs d
@@ -95,6 +95,8 @@ let mkcf ~loc ?attrs ?docs d =
 let mkrhs rhs loc = mkloc rhs (make_loc loc)
 let ghrhs rhs loc = mkloc rhs (ghost_loc loc)
 
+let ldot lid lid_loc name loc = Ldot (mkrhs lid lid_loc, mkrhs name loc)
+
 let push_loc x acc =
   if x.Location.loc_ghost
   then acc
@@ -136,9 +138,9 @@ let mkpatvar ~loc name =
   AST node, then the location must be real; in all other cases,
   it must be ghost.
 *)
-let ghexp ~loc d = Exp.mk ~loc:(ghost_loc loc) d
-let ghpat ~loc d = Pat.mk ~loc:(ghost_loc loc) d
-let ghtyp ~loc d = Typ.mk ~loc:(ghost_loc loc) d
+let ghexp ~loc ?attrs d = Exp.mk ~loc:(ghost_loc loc) ?attrs d
+let ghpat ~loc ?attrs d = Pat.mk ~loc:(ghost_loc loc) ?attrs d
+let ghtyp ~loc ?attrs d = Typ.mk ~loc:(ghost_loc loc) ?attrs d
 let ghloc ~loc d = { txt = d; loc = ghost_loc loc }
 let ghstr ~loc d = Str.mk ~loc:(ghost_loc loc) d
 let ghsig ~loc d = Sig.mk ~loc:(ghost_loc loc) d
@@ -209,7 +211,9 @@ let rec mktailexp nilloc = let open Location in function
   | e1 :: el ->
       let exp_el, el_loc = mktailexp nilloc el in
       let loc = (e1.pexp_loc.loc_start, snd el_loc) in
-      let arg = ghexp ~loc (Pexp_tuple [e1; ghexp ~loc:el_loc exp_el]) in
+      let arg =
+        ghexp ~loc (Pexp_tuple [None, e1; None, ghexp ~loc:el_loc exp_el])
+      in
       ghexp_cons_desc loc arg, loc
 
 let rec mktailpat nilloc = let open Location in function
@@ -219,7 +223,10 @@ let rec mktailpat nilloc = let open Location in function
   | p1 :: pl ->
       let pat_pl, el_loc = mktailpat nilloc pl in
       let loc = (p1.ppat_loc.loc_start, snd el_loc) in
-      let arg = ghpat ~loc (Ppat_tuple [p1; ghpat ~loc:el_loc pat_pl]) in
+      let arg =
+        ghpat ~loc
+          (Ppat_tuple ([None, p1; None, ghpat ~loc:el_loc pat_pl], Closed))
+      in
       ghpat_cons_desc loc arg, loc
 
 let mkstrexp e attrs =
@@ -321,9 +328,12 @@ type ('dot,'index) array_family = {
 
 }
 
-let bigarray_untuplify = function
-    { pexp_desc = Pexp_tuple explist; pexp_loc = _ } -> explist
-  | exp -> [exp]
+let bigarray_untuplify exp =
+  match exp.pexp_desc with
+  | Pexp_tuple explist
+       when List.for_all (fun (l, _) -> Option.is_none l) explist ->
+     List.map snd explist
+  | _ -> [exp]
 
 let builtin_arraylike_name loc _ ~assign paren_kind n =
   let opname = if assign then "set" else "get" in
@@ -340,8 +350,8 @@ let builtin_arraylike_name loc _ ~assign paren_kind n =
          | Two -> "Array2"
          | Three -> "Array3"
          | Many -> "Genarray" in
-       Ldot(Lident "Bigarray", submodule_name) in
-   ghloc ~loc (Ldot(prefix,opname))
+       Ldot(mknoloc (Lident "Bigarray"), mknoloc submodule_name) in
+   ghloc ~loc (Ldot(mknoloc prefix, mknoloc opname))
 
 let builtin_arraylike_index loc paren_kind index = match paren_kind with
     | Paren | Bracket -> One, [Nolabel, index]
@@ -371,7 +381,7 @@ let user_indexing_operator_name loc (prefix,ext) ~assign paren_kind n =
     String.concat "" ["."; ext; left; mid; right; assign] in
   let lid = match prefix with
     | None -> Lident name
-    | Some p -> Ldot(p,name) in
+    | Some p -> Ldot(mknoloc p,mknoloc name) in
   ghloc ~loc lid
 
 let user_index loc _ index =
@@ -400,9 +410,9 @@ let indexop_unclosed_error loc_s s loc_e =
   let left, right = paren_to_strings s in
   unclosed left loc_s right loc_e
 
-let lapply ~loc p1 p2 =
+let lapply ~loc p1 loc_p1 p2 loc_p2 =
   if !Clflags.applicative_functors
-  then Lapply(p1, p2)
+  then Lapply(mkrhs p1 loc_p1, mkrhs p2 loc_p2)
   else raise (Syntaxerr.Error(
                   Syntaxerr.Applicative_path (make_loc loc)))
 
@@ -905,7 +915,7 @@ The precedences must be listed from low to high.
 %nonassoc AS
 %left     BAR                           /* pattern (p|p|p) */
 %nonassoc below_COMMA
-%left     COMMA                         /* expr/expr_comma_list (e,e,e) */
+%left     COMMA                         /* expr/labeled_tuple (e,e,e) */
 %right    MINUSGREATER                  /* function_type (t -> t -> t) */
 %right    OR BARBAR                     /* expr (e || e || e) */
 %right    AMPERSAND AMPERAMPER          /* expr (e && e && e) */
@@ -2442,7 +2452,8 @@ fun_expr:
         let let_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in
         mkexp ~loc:$sloc (Pexp_letop{ let_; ands; body}) }
   | fun_expr COLONCOLON expr
-      { mkexp_cons ~loc:$sloc $loc($2) (ghexp ~loc:$sloc (Pexp_tuple[$1;$3])) }
+      { mkexp_cons ~loc:$sloc $loc($2)
+          (ghexp ~loc:$sloc (Pexp_tuple[None,$1;None,$3])) }
   | mkrhs(label) LESSMINUS expr
       { mkexp ~loc:$sloc (Pexp_setinstvar($1, $3)) }
   | simple_expr DOT mkrhs(label_longident) LESSMINUS expr
@@ -2507,7 +2518,7 @@ fun_expr:
 %inline expr_:
   | simple_expr nonempty_llist(labeled_simple_expr)
       { Pexp_apply($1, $2) }
-  | expr_comma_list %prec below_COMMA
+  | labeled_tuple %prec below_COMMA
       { Pexp_tuple($1) }
   | mkrhs(constr_longident) simple_expr %prec below_HASH
       { Pexp_construct($1, Some $2) }
@@ -2551,9 +2562,9 @@ simple_expr:
   | NEW ext_attributes mkrhs(class_longident)
       { Pexp_new($3), $2 }
   | LPAREN MODULE ext_attributes module_expr RPAREN
-      { Pexp_pack $4, $3 }
-  | LPAREN MODULE ext_attributes module_expr COLON package_type RPAREN
-      { Pexp_constraint (ghexp ~loc:$sloc (Pexp_pack $4), $6), $3 }
+      { Pexp_pack ($4, None), $3 }
+  | LPAREN MODULE ext_attributes module_expr COLON package_type_ RPAREN
+      { Pexp_pack ($4, Some $6), $3 }
   | LPAREN MODULE ext_attributes module_expr COLON error
       { unclosed "(" $loc($1) ")" $loc($6) }
   | OBJECT ext_attributes class_structure END
@@ -2661,10 +2672,10 @@ simple_expr:
     LBRACKET expr_semi_list error
       { unclosed "[" $loc($3) "]" $loc($5) }
   | od=open_dot_declaration DOT LPAREN MODULE ext_attributes module_expr COLON
-    package_type RPAREN
+    ptyp = package_type_ RPAREN
       { let modexp =
           mkexp_attrs ~loc:($startpos($3), $endpos)
-            (Pexp_constraint (ghexp ~loc:$sloc (Pexp_pack $6), $8)) $5 in
+            (Pexp_pack ($6, Some ptyp)) $5 in
         Pexp_open(od, modexp) }
   | mod_longident DOT
     LPAREN MODULE ext_attributes module_expr COLON error
@@ -2841,9 +2852,84 @@ fun_param_as_list:
 fun_params:
   | nonempty_concat(fun_param_as_list) { $1 }
 ;
-%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 c = type_constraint RPAREN %prec below_HASH
+      { Some label,
+        mkexp_constraint ~loc:($startpos($2), $endpos)
+          (mkexpvar ~loc:$loc(label) label) c }
+;
+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 c = type_constraint RPAREN
+  COMMA
+  x2 = labeled_tuple_element
+  { let x1 =
+      mkexp_constraint ~loc:($startpos($2), $endpos)
+        (mkexpvar ~loc:$loc(l1) l1) c
+    in
+    [ x2; Some l1, x1] }
+;
+%inline labeled_tuple:
+  xs = rev(reversed_labeled_tuple_body)
+    { xs }
 ;
 record_expr_content:
   eo = ioption(terminated(simple_expr, WITH))
@@ -2930,7 +3016,8 @@ pattern_no_exn:
 
 %inline pattern_(self):
   | self COLONCOLON pattern
-      { mkpat_cons ~loc:$sloc $loc($2) (ghpat ~loc:$sloc (Ppat_tuple[$1;$3])) }
+      { mkpat_cons ~loc:$sloc $loc($2)
+          (ghpat ~loc:$sloc (Ppat_tuple ([None, $1; None, $3], Closed))) }
   | self attribute
       { Pat.attr $1 $2 }
   | pattern_gen
@@ -2940,8 +3027,8 @@ 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) }
+    | labeled_tuple_pattern(self)
+        { $1 }
     | self COLONCOLON error
         { expecting $loc($3) "pattern" }
     | self BAR pattern
@@ -3047,10 +3134,66 @@ simple_delimited_pattern:
       { unclosed "[|" $loc($1) "|]" $loc($3) }
   ) { $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" }
+(* 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 lbl_loc = $loc(label) in
+        let pat_loc = $startpos($2), $endpos in
+        let pat = mkpatvar ~loc:lbl_loc label in
+        Some label, mkpat ~loc:pat_loc (Ppat_constraint(pat, cty)) }
+;
+(* If changing this, don't forget to change its copy just above. *)
+%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 lbl_loc = $loc(label) in
+        let pat_loc = $startpos($2), $endpos in
+        let pat = mkpatvar ~loc:lbl_loc label in
+        Some label, mkpat ~loc:pat_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 ] }
+;
+labeled_tuple_pattern(self):
+  | reversed_labeled_tuple_pattern(self)
+      { let closed, pat = $1 in
+        Ppat_tuple(List.rev pat, closed) }
 ;
 %inline pattern_semi_list:
   ps = separated_or_terminated_nonempty_list(SEMI, pattern)
@@ -3260,10 +3403,16 @@ type_variance:
   | INFIXOP2
       { if $1 = "+!" then Covariant, Injective else
         if $1 = "-!" then Contravariant, Injective else
+        if $1 = "+-" then Bivariant, NoInjectivity else
+        if $1 = "-+" then Bivariant, NoInjectivity else
+        if $1 = "+-!" then Bivariant, Injective else
+        if $1 = "-+!" then Bivariant, Injective else
         expecting $loc($1) "type_variance" }
   | PREFIXOP
       { if $1 = "!+" then Covariant, Injective else
         if $1 = "!-" then Contravariant, Injective else
+        if $1 = "!+-" then Bivariant, Injective else
+        if $1 = "!-+" then Bivariant, Injective else
         expecting $loc($1) "type_variance" }
 ;
 
@@ -3550,6 +3699,34 @@ function_type:
         { Ptyp_arrow(label, domain, codomain) }
     )
     { $1 }
+  (* The next two cases are for labled tuples - see comment on [tuple_type]
+     below.
+
+     The first case is 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]
+     It is the same as the previous case, but with [arg_label] specialized to
+     [LIDENT COLON] and the domain type specialized to [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
+      tuple = proper_tuple_type
+      MINUSGREATER
+      codomain = function_type
+        { let ty, ltys = tuple in
+          let tuple_loc = $loc(tuple) in
+          let domain =
+            mktyp ~loc:tuple_loc (Ptyp_tuple ((None, ty) :: ltys))
+          in
+          let domain = extra_rhs_core_type domain ~pos:(snd tuple_loc) in
+          Ptyp_arrow(Labelled label, domain, codomain) }
+    )
+    { $1 }
+  | label = LIDENT COLON proper_tuple_type %prec MINUSGREATER
+    { let ty, ltys = $3 in
+      mktyp ~loc:$sloc (Ptyp_tuple ((Some label, ty) :: ltys))
+    }
 ;
 %inline arg_label:
   | label = optlabel
@@ -3563,16 +3740,33 @@ 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
+   function_type above.  This resolves ambiguities around [x:t1 * t2 -> t3]
+   which must continue to parse as a function with one labeled argument even in
+   the presence 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_WITH
+    { 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
+     { Some label, ty }
 ;
 
 (* Atomic types are the most basic level in the syntax of types.
@@ -3700,10 +3894,12 @@ atomic_type:
       { tys }
 ;
 
-%inline package_type: module_type
+%inline package_type_: module_type
       { let (lid, cstrs, attrs) = package_type_of_module_type $1 in
-        let descr = Ptyp_package (lid, cstrs) in
-        mktyp ~loc:$sloc ~attrs descr }
+        Typ.package_type ~loc:(make_loc $sloc) ~attrs lid cstrs }
+
+%inline package_type: package_type_
+      { mktyp ~loc:$sloc (Ptyp_package $1) }
 ;
 %inline row_field_list:
   separated_nonempty_llist(BAR, row_field)
@@ -3875,13 +4071,13 @@ constr_ident:
 ;
 constr_longident:
     mod_longident       %prec below_DOT  { $1 } /* A.B.x vs (A).B.x */
-  | mod_longident DOT constr_extra_ident { Ldot($1,$3) }
+  | mod_longident DOT constr_extra_ident { ldot $1 $loc($1) $3 $loc($3) }
   | constr_extra_ident                   { Lident $1 }
   | constr_extra_nonprefix_ident         { Lident $1 }
 ;
 mk_longident(prefix,final):
    | final            { Lident $1 }
-   | prefix DOT final { Ldot($1,$3) }
+   | prefix DOT final { ldot $1 $loc($1) $3 $loc($3) }
 ;
 val_longident:
     mk_longident(mod_longident, val_ident) { $1 }
@@ -3904,7 +4100,7 @@ mod_ext_longident:
     mk_longident(mod_ext_longident, UIDENT) { $1 }
   | mod_longident_disam { $1 }
   | mod_ext_longident LPAREN mod_ext_longident RPAREN
-      { lapply ~loc:$sloc $1 $3 }
+      { lapply ~loc:$sloc $1 $loc($1) $3 $loc($3) }
   | mod_ext_longident LPAREN error
       { expecting $loc($3) "module path" }
 ;
@@ -4063,6 +4259,7 @@ single_attr_id:
   | DO { "do" }
   | DONE { "done" }
   | DOWNTO { "downto" }
+  | EFFECT { "effect" }
   | ELSE { "else" }
   | END { "end" }
   | EXCEPTION { "exception" }
diff --git a/vendor/parser-standard/parsetree.mli b/vendor/parser-standard/parsetree.mli
index d03cc95264..dc8b113436 100644
--- a/vendor/parser-standard/parsetree.mli
+++ b/vendor/parser-standard/parsetree.mli
@@ -101,9 +101,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 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].
         *)
@@ -174,10 +179,16 @@ and core_type_desc =
   | Ptyp_open of Longident.t loc * core_type (** [M.(T)] *)
   | Ptyp_extension of extension  (** [[%id]]. *)
 
-and package_type = Longident.t loc * (Longident.t loc * core_type) list
+and package_type =
+    {
+     ppt_path: Longident.t loc;
+     ppt_cstrs: (Longident.t loc * core_type) list;
+     ppt_loc: Location.t;
+     ppt_attrs: attributes;
+    }
 (** As {!package_type} typed values:
-         - [(S, [])] represents [(module S)],
-         - [(S, [(t1, T1) ; ... ; (tn, Tn)])]
+         - [{ppt_path: S; ppt_cstrs: []}] represents [(module S)],
+         - [{ppt_path: S; ppt_cstrs: [(t1, T1) ; ... ; (tn, Tn)]}]
           represents [(module S with type t1 = T1 and ... and tn = Tn)].
        *)
 
@@ -234,11 +245,22 @@ 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 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)]
+
+          [Ppat_tuple(pl, Open)] is similar, but indicates the pattern
+          additionally 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],
@@ -315,8 +337,9 @@ and expression_desc =
       [C] represents a type constraint or coercion placed immediately before the
       arrow, e.g. [fun P1 ... Pn : ty -> ...] when [C = Some (Pconstraint ty)].
 
-      A function must have parameters. [Pexp_function (params, _, body)] must
-      have non-empty [params] or a [Pfunction_cases _] body.
+      A function must have parameters: in [Pexp_function (params, _, body)],
+      if [params] does not contain a [Pparam_val _], [body] must be
+      [Pfunction_cases _].
   *)
   | Pexp_apply of expression * (arg_label * expression) list
       (** [Pexp_apply(E0, [(l1, E1) ; ... ; (ln, En)])]
@@ -333,8 +356,14 @@ 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)]
+  | Pexp_tuple of (string 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]
         *)
@@ -400,11 +429,8 @@ and expression_desc =
            values). *)
   | Pexp_object of class_structure  (** [object ... end] *)
   | Pexp_newtype of string loc * expression  (** [fun (type t) -> E] *)
-  | Pexp_pack of module_expr
-      (** [(module ME)].
-
-           [(module ME : S)] is represented as
-           [Pexp_constraint(Pexp_pack ME, Ptyp_package S)] *)
+  | Pexp_pack of module_expr * package_type option
+      (** [(module ME)] or [(module ME : S)]. *)
   | Pexp_open of open_declaration * expression
       (** - [M.(E)]
             - [let open M in E]
diff --git a/vendor/parser-standard/printast.ml b/vendor/parser-standard/printast.ml
index e874490de9..422ea860c4 100644
--- a/vendor/parser-standard/printast.ml
+++ b/vendor/parser-standard/printast.ml
@@ -38,9 +38,9 @@ let fmt_location f loc =
 let rec fmt_longident_aux f x =
   match x with
   | Longident.Lident (s) -> fprintf f "%s" s
-  | Longident.Ldot (y, s) -> fprintf f "%a.%s" fmt_longident_aux y s
+  | Longident.Ldot (y, s) -> fprintf f "%a.%s" fmt_longident_aux y.txt s.txt
   | Longident.Lapply (y, z) ->
-      fprintf f "%a(%a)" fmt_longident_aux y fmt_longident_aux z
+      fprintf f "%a(%a)" fmt_longident_aux y.txt fmt_longident_aux z.txt
 
 let fmt_longident f x = fprintf f "\"%a\"" fmt_longident_aux x
 
@@ -135,6 +135,10 @@ let arg_label i ppf = function
 let typevars ppf vs =
   List.iter (fun x -> fprintf ppf " %a" Pprintast.tyvar x.txt) vs
 
+let labeled_tuple_element f i ppf (l, ct) =
+  option i string ppf l;
+  f i ppf ct
+
 let rec core_type i ppf x =
   line i ppf "core_type %a\n" fmt_location x.ptyp_loc;
   attributes i ppf x.ptyp_attributes;
@@ -149,7 +153,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_tuple_element 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;
@@ -179,9 +183,9 @@ let rec core_type i ppf x =
   | Ptyp_poly (sl, ct) ->
       line i ppf "Ptyp_poly%a\n" typevars sl;
       core_type i ppf ct;
-  | Ptyp_package (s, l) ->
-      line i ppf "Ptyp_package %a\n" fmt_longident_loc s;
-      list i package_with ppf l;
+  | Ptyp_package ptyp ->
+      line i ppf "Ptyp_package\n";
+      package_type i ppf ptyp;
   | Ptyp_open (mod_ident, t) ->
       line i ppf "Ptyp_open \"%a\"\n" fmt_longident_loc mod_ident;
       core_type i ppf t
@@ -189,6 +193,12 @@ let rec core_type i ppf x =
       line i ppf "Ptyp_extension \"%s\"\n" s.txt;
       payload i ppf arg
 
+and package_type i ppf ptyp =
+  let i = i + 1 in
+  line i ppf "package_type %a\n" fmt_longident_loc ptyp.ppt_path;
+  list i package_with ppf ptyp.ppt_cstrs;
+  attributes i ppf ptyp.ppt_attrs
+
 and package_with i ppf (s, t) =
   line i ppf "with type %a\n" fmt_longident_loc s;
   core_type i ppf t
@@ -210,9 +220,9 @@ and pattern i ppf x =
       line i ppf "Ppat_interval\n";
       fmt_constant i ppf c1;
       fmt_constant i ppf c2;
-  | Ppat_tuple (l) ->
-      line i ppf "Ppat_tuple\n";
-      list i pattern ppf l;
+  | Ppat_tuple (l, c) ->
+      line i ppf "Ppat_tuple\n %a\n" fmt_closed_flag c;
+      list i (labeled_tuple_element pattern) ppf l;
   | Ppat_construct (li, po) ->
       line i ppf "Ppat_construct %a\n" fmt_longident_loc li;
       option i
@@ -291,7 +301,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_tuple_element expression) ppf l;
   | Pexp_construct (li, eo) ->
       line i ppf "Pexp_construct %a\n" fmt_longident_loc li;
       option i expression ppf eo;
@@ -376,9 +386,10 @@ and expression i ppf x =
   | Pexp_newtype (s, e) ->
       line i ppf "Pexp_newtype \"%s\"\n" s.txt;
       expression i ppf e
-  | Pexp_pack me ->
+  | Pexp_pack (me, optyp) ->
       line i ppf "Pexp_pack\n";
-      module_expr i ppf me
+      module_expr i ppf me;
+      option i package_type ppf optyp
   | Pexp_open (o, e) ->
       line i ppf "Pexp_open %a\n" fmt_override_flag o.popen_override;
       module_expr i ppf o.popen_expr;