diff --git a/.ocamlformat-ignore b/.ocamlformat-ignore
index ea0aebcc..273c72fe 100644
--- a/.ocamlformat-ignore
+++ b/.ocamlformat-ignore
@@ -46,6 +46,7 @@ test/driver/non-compressible-suffix/test.ml
 test/driver/transformations/test.ml
 test/driver/transformations/test_412.ml
 test/driver/transformations/test_510.ml
+test/encoding/504/api/test.ml
 test/expand-header-and-footer/test.ml
 test/expansion_helpers/mangle/test.ml
 test/expansion_inside_payloads/test.ml
diff --git a/CHANGES.md b/CHANGES.md
index 56dd74c7..3c16f47b 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,6 +1,10 @@
 unreleased
 ----------
 
+- Add support for OCaml 5.4 labeled tuples, they can now be used alongside
+  ppx-es. Also adds Ast_builder and Ast_pattern utilities to manipulate them.
+  (#607, @NathanReb)
+
 0.37.0
 ------
 
diff --git a/astlib/encoding_504.ml b/astlib/encoding_504.ml
new file mode 100644
index 00000000..64ad2e9d
--- /dev/null
+++ b/astlib/encoding_504.ml
@@ -0,0 +1,366 @@
+module Ext_name = struct
+  let ptyp_labeled_tuple = "ppxlib.migration.ptyp_labeled_tuple_504"
+  let pexp_labeled_tuple = "ppxlib.migration.pexp_labeled_tuple_504"
+  let ppat_labeled_tuple = "ppxlib.migration.ppat_labeled_tuple_504"
+end
+
+let invalid_encoding ~loc name =
+  Location.raise_errorf ~loc "Invalid %s encoding" name
+
+module type AST = sig
+  type payload
+  type core_type
+  type core_type_desc
+  type expression
+  type expression_desc
+  type pattern
+  type pattern_desc
+  type closed_flag
+
+  module Construct : sig
+    val ptyp_extension_desc : string Location.loc -> payload -> core_type_desc
+    val ptyp_tuple : loc:Location.t -> core_type list -> core_type
+    val ptyp_var : loc:Location.t -> string -> core_type
+    val ptyp_any : loc:Location.t -> core_type
+    val ptyp : core_type -> payload
+    val pexp_extension_desc : string Location.loc -> payload -> expression_desc
+    val pexp_tuple : loc:Location.t -> expression list -> expression
+
+    val pexp_variant :
+      loc:Location.t -> string -> expression option -> expression
+
+    val pstr_eval : loc:Location.t -> expression -> payload
+    val ppat_extension_desc : string Location.loc -> payload -> pattern_desc
+    val ppat_tuple : loc:Location.t -> pattern list -> pattern
+    val ppat_var : loc:Location.t -> string -> pattern
+    val ppat_any : loc:Location.t -> pattern
+    val ppat : pattern -> payload
+    val closed_flag_to_string : closed_flag -> string
+  end
+
+  module Destruct : sig
+    val ptyp : payload -> core_type option
+    val ptyp_tuple : core_type -> core_type list option
+    val ptyp_var : core_type -> string option
+    val ptyp_any : core_type -> unit option
+    val pstr_eval : payload -> expression option
+    val pexp_tuple : expression -> expression list option
+    val pexp_variant : expression -> (string * expression option) option
+    val ppat : payload -> pattern option
+    val ppat_tuple : pattern -> pattern list option
+    val ppat_var : pattern -> string option
+    val ppat_any : pattern -> unit option
+    val closed_flag_from_string : string -> closed_flag option
+  end
+end
+
+module Make (X : AST) = struct
+  let encode_ptyp_labeled_tuple ~loc args =
+    let payload =
+      let l =
+        List.map
+          (fun (label_opt, typ) ->
+            let label =
+              match label_opt with
+              | None -> X.Construct.ptyp_any ~loc
+              | Some s -> X.Construct.ptyp_var ~loc s
+            in
+            X.Construct.ptyp_tuple ~loc [ label; typ ])
+          args
+      in
+      X.Construct.ptyp_tuple ~loc l
+    in
+    X.Construct.ptyp_extension_desc
+      { txt = Ext_name.ptyp_labeled_tuple; loc }
+      (X.Construct.ptyp payload)
+
+  let decode_ptyp_labeled_tuple ~loc payload =
+    let open Stdlib0.Option.Op in
+    let res =
+      let* typ = X.Destruct.ptyp payload in
+      let* typ_list = X.Destruct.ptyp_tuple typ in
+      Stdlib0.Option.List.map typ_list ~f:(fun typ ->
+          let* typ_pair = X.Destruct.ptyp_tuple typ in
+          match typ_pair with
+          | [ label; typ ] -> (
+              match (X.Destruct.ptyp_var label, X.Destruct.ptyp_any label) with
+              | Some s, _ -> Some (Some s, typ)
+              | _, Some () -> Some (None, typ)
+              | None, None -> None)
+          | _ -> None)
+    in
+    match res with
+    | Some res -> res
+    | None -> invalid_encoding ~loc Ext_name.ptyp_labeled_tuple
+
+  let encode_pexp_labeled_tuple ~loc args =
+    let payload =
+      let l =
+        List.map
+          (fun (label_opt, expr) ->
+            let label =
+              match label_opt with
+              | None -> X.Construct.pexp_variant ~loc "None" None
+              | Some s ->
+                  let string_as_variant =
+                    X.Construct.pexp_variant ~loc s None
+                  in
+                  X.Construct.pexp_variant ~loc "Some" (Some string_as_variant)
+            in
+            X.Construct.pexp_tuple ~loc [ label; expr ])
+          args
+      in
+      X.Construct.pexp_tuple ~loc l
+    in
+    X.Construct.pexp_extension_desc
+      { txt = Ext_name.pexp_labeled_tuple; loc }
+      (X.Construct.pstr_eval ~loc payload)
+
+  let decode_pexp_labeled_tuple ~loc payload =
+    let open Stdlib0.Option.Op in
+    let res =
+      let* exp = X.Destruct.pstr_eval payload in
+      let* exp_list = X.Destruct.pexp_tuple exp in
+      Stdlib0.Option.List.map exp_list ~f:(fun exp ->
+          let* exp_pair = X.Destruct.pexp_tuple exp in
+          match exp_pair with
+          | [ label; exp ] -> (
+              let* opt_variant = X.Destruct.pexp_variant label in
+              match opt_variant with
+              | "None", None -> Some (None, exp)
+              | "Some", Some exp' -> (
+                  let* label_variant = X.Destruct.pexp_variant exp' in
+                  match label_variant with
+                  | s, None -> Some (Some s, exp)
+                  | _, _ -> None)
+              | _ -> None)
+          | _ -> None)
+    in
+    match res with
+    | Some res -> res
+    | None -> invalid_encoding ~loc Ext_name.pexp_labeled_tuple
+
+  let encode_ppat_labeled_tuple ~loc pats closed_flag =
+    let payload =
+      let flag =
+        let s = X.Construct.closed_flag_to_string closed_flag in
+        X.Construct.ppat_var ~loc s
+      in
+      let pats =
+        let l =
+          List.map
+            (fun (label_opt, pat) ->
+              let label =
+                match label_opt with
+                | None -> X.Construct.ppat_any ~loc
+                | Some s -> X.Construct.ppat_var ~loc s
+              in
+              X.Construct.ppat_tuple ~loc [ label; pat ])
+            pats
+        in
+        X.Construct.ppat_tuple ~loc l
+      in
+      X.Construct.ppat_tuple ~loc [ pats; flag ]
+    in
+    X.Construct.ppat_extension_desc
+      { txt = Ext_name.ppat_labeled_tuple; loc }
+      (X.Construct.ppat payload)
+
+  let decode_ppat_labeled_tuple ~loc payload =
+    let open Stdlib0.Option.Op in
+    let res =
+      let* pat = X.Destruct.ppat payload in
+      let* pats_and_flag = X.Destruct.ppat_tuple pat in
+      match pats_and_flag with
+      | [ pats; flag ] ->
+          let* flag_s = X.Destruct.ppat_var flag in
+          let* closed_flag = X.Destruct.closed_flag_from_string flag_s in
+          let* pat_list = X.Destruct.ppat_tuple pats in
+          let* pats =
+            Stdlib0.Option.List.map pat_list ~f:(fun pat ->
+                let* pat_pair = X.Destruct.ppat_tuple pat in
+                match pat_pair with
+                | [ label; pat ] -> (
+                    match
+                      (X.Destruct.ppat_var label, X.Destruct.ppat_any label)
+                    with
+                    | Some s, _ -> Some (Some s, pat)
+                    | _, Some () -> Some (None, pat)
+                    | None, None -> None)
+                | _ -> None)
+          in
+          Some (pats, closed_flag)
+      | _ -> None
+    in
+    match res with
+    | Some res -> res
+    | None -> invalid_encoding ~loc Ext_name.ppat_labeled_tuple
+end
+
+module Ast_503 = struct
+  include Ast_503.Asttypes
+  include Ast_503.Parsetree
+
+  module Construct = struct
+    let core_type ~loc ptyp_desc =
+      { ptyp_desc; ptyp_loc = loc; ptyp_attributes = []; ptyp_loc_stack = [] }
+
+    let expression ~loc pexp_desc =
+      { pexp_desc; pexp_loc = loc; pexp_attributes = []; pexp_loc_stack = [] }
+
+    let pattern ~loc ppat_desc =
+      { ppat_desc; ppat_loc = loc; ppat_attributes = []; ppat_loc_stack = [] }
+
+    let ptyp_extension_desc name payload = Ptyp_extension (name, payload)
+    let ptyp_tuple ~loc typs = core_type ~loc (Ptyp_tuple typs)
+    let ptyp_var ~loc s = core_type ~loc (Ptyp_var s)
+    let ptyp_any ~loc = core_type ~loc Ptyp_any
+    let ptyp typ = PTyp typ
+    let pexp_extension_desc name payload = Pexp_extension (name, payload)
+    let pexp_tuple ~loc l = expression ~loc (Pexp_tuple l)
+
+    let pexp_variant ~loc v exp_opt =
+      expression ~loc (Pexp_variant (v, exp_opt))
+
+    let pstr_eval ~loc expr =
+      PStr [ { pstr_desc = Pstr_eval (expr, []); pstr_loc = loc } ]
+
+    let ppat_extension_desc name payload = Ppat_extension (name, payload)
+    let ppat_tuple ~loc l = pattern ~loc (Ppat_tuple l)
+    let ppat_var ~loc txt = pattern ~loc (Ppat_var { txt; loc })
+    let ppat_any ~loc = pattern ~loc Ppat_any
+    let ppat pat = PPat (pat, None)
+    let closed_flag_to_string = function Closed -> "closed_" | Open -> "open_"
+  end
+
+  module Destruct = struct
+    let ptyp = function PTyp typ -> Some typ | _ -> None
+
+    let ptyp_tuple = function
+      | { ptyp_desc = Ptyp_tuple typs; _ } -> Some typs
+      | _ -> None
+
+    let ptyp_var = function
+      | { ptyp_desc = Ptyp_var s; _ } -> Some s
+      | _ -> None
+
+    let ptyp_any = function { ptyp_desc = Ptyp_any; _ } -> Some () | _ -> None
+
+    let pstr_eval = function
+      | PStr [ { pstr_desc = Pstr_eval (expr, []); _ } ] -> Some expr
+      | _ -> None
+
+    let pexp_tuple = function
+      | { pexp_desc = Pexp_tuple l; _ } -> Some l
+      | _ -> None
+
+    let pexp_variant = function
+      | { pexp_desc = Pexp_variant (s, e); _ } -> Some (s, e)
+      | _ -> None
+
+    let ppat = function PPat (pat, None) -> Some pat | _ -> None
+
+    let ppat_tuple = function
+      | { ppat_desc = Ppat_tuple pats; _ } -> Some pats
+      | _ -> None
+
+    let ppat_var = function
+      | { ppat_desc = Ppat_var { txt; _ }; _ } -> Some txt
+      | _ -> None
+
+    let ppat_any = function { ppat_desc = Ppat_any; _ } -> Some () | _ -> None
+
+    let closed_flag_from_string = function
+      | "closed_" -> Some Closed
+      | "open_" -> Some Open
+      | _ -> None
+  end
+end
+
+module Ast_502 = struct
+  include Ast_502.Asttypes
+  include Ast_502.Parsetree
+
+  module Construct = struct
+    let core_type ~loc ptyp_desc =
+      { ptyp_desc; ptyp_loc = loc; ptyp_attributes = []; ptyp_loc_stack = [] }
+
+    let expression ~loc pexp_desc =
+      { pexp_desc; pexp_loc = loc; pexp_attributes = []; pexp_loc_stack = [] }
+
+    let pattern ~loc ppat_desc =
+      { ppat_desc; ppat_loc = loc; ppat_attributes = []; ppat_loc_stack = [] }
+
+    let ptyp_extension_desc name payload = Ptyp_extension (name, payload)
+    let ptyp_tuple ~loc typs = core_type ~loc (Ptyp_tuple typs)
+    let ptyp_var ~loc s = core_type ~loc (Ptyp_var s)
+    let ptyp_any ~loc = core_type ~loc Ptyp_any
+    let ptyp typ = PTyp typ
+    let pexp_extension_desc name payload = Pexp_extension (name, payload)
+    let pexp_tuple ~loc l = expression ~loc (Pexp_tuple l)
+
+    let pexp_variant ~loc v exp_opt =
+      expression ~loc (Pexp_variant (v, exp_opt))
+
+    let pstr_eval ~loc expr =
+      PStr [ { pstr_desc = Pstr_eval (expr, []); pstr_loc = loc } ]
+
+    let ppat_extension_desc name payload = Ppat_extension (name, payload)
+    let ppat_tuple ~loc l = pattern ~loc (Ppat_tuple l)
+    let ppat_var ~loc txt = pattern ~loc (Ppat_var { txt; loc })
+    let ppat_any ~loc = pattern ~loc Ppat_any
+    let ppat pat = PPat (pat, None)
+    let closed_flag_to_string = function Closed -> "closed_" | Open -> "open_"
+  end
+
+  module Destruct = struct
+    let ptyp = function PTyp typ -> Some typ | _ -> None
+
+    let ptyp_tuple = function
+      | { ptyp_desc = Ptyp_tuple typs; _ } -> Some typs
+      | _ -> None
+
+    let ptyp_var = function
+      | { ptyp_desc = Ptyp_var s; _ } -> Some s
+      | _ -> None
+
+    let ptyp_any = function { ptyp_desc = Ptyp_any; _ } -> Some () | _ -> None
+
+    let pstr_eval = function
+      | PStr [ { pstr_desc = Pstr_eval (expr, []); _ } ] -> Some expr
+      | _ -> None
+
+    let pexp_tuple = function
+      | { pexp_desc = Pexp_tuple l; _ } -> Some l
+      | _ -> None
+
+    let pexp_variant = function
+      | { pexp_desc = Pexp_variant (s, e); _ } -> Some (s, e)
+      | _ -> None
+
+    let ppat = function PPat (pat, None) -> Some pat | _ -> None
+
+    let ppat_tuple = function
+      | { ppat_desc = Ppat_tuple pats; _ } -> Some pats
+      | _ -> None
+
+    let ppat_var = function
+      | { ppat_desc = Ppat_var { txt; _ }; _ } -> Some txt
+      | _ -> None
+
+    let ppat_any = function { ppat_desc = Ppat_any; _ } -> Some () | _ -> None
+
+    let closed_flag_from_string = function
+      | "closed_" -> Some Closed
+      | "open_" -> Some Open
+      | _ -> None
+  end
+end
+
+module To_503 = struct
+  include Make (Ast_503)
+end
+
+module To_502 = struct
+  include Make (Ast_502)
+end
diff --git a/astlib/encoding_504.mli b/astlib/encoding_504.mli
new file mode 100644
index 00000000..bfb118dd
--- /dev/null
+++ b/astlib/encoding_504.mli
@@ -0,0 +1,57 @@
+module Ext_name : sig
+  val ptyp_labeled_tuple : string
+  val pexp_labeled_tuple : string
+  val ppat_labeled_tuple : string
+end
+
+module To_503 : sig
+  open Ast_503.Asttypes
+  open Ast_503.Parsetree
+
+  val encode_ptyp_labeled_tuple :
+    loc:Location.t -> (string option * core_type) list -> core_type_desc
+
+  val decode_ptyp_labeled_tuple :
+    loc:Location.t -> payload -> (string option * core_type) list
+
+  val encode_pexp_labeled_tuple :
+    loc:Location.t -> (string option * expression) list -> expression_desc
+
+  val decode_pexp_labeled_tuple :
+    loc:Location.t -> payload -> (string option * expression) list
+
+  val encode_ppat_labeled_tuple :
+    loc:Location.t ->
+    (string option * pattern) list ->
+    closed_flag ->
+    pattern_desc
+
+  val decode_ppat_labeled_tuple :
+    loc:Location.t -> payload -> (string option * pattern) list * closed_flag
+end
+
+module To_502 : sig
+  open Ast_502.Asttypes
+  open Ast_502.Parsetree
+
+  val encode_ptyp_labeled_tuple :
+    loc:Location.t -> (string option * core_type) list -> core_type_desc
+
+  val decode_ptyp_labeled_tuple :
+    loc:Location.t -> payload -> (string option * core_type) list
+
+  val encode_pexp_labeled_tuple :
+    loc:Location.t -> (string option * expression) list -> expression_desc
+
+  val decode_pexp_labeled_tuple :
+    loc:Location.t -> payload -> (string option * expression) list
+
+  val encode_ppat_labeled_tuple :
+    loc:Location.t ->
+    (string option * pattern) list ->
+    closed_flag ->
+    pattern_desc
+
+  val decode_ppat_labeled_tuple :
+    loc:Location.t -> payload -> (string option * pattern) list * closed_flag
+end
diff --git a/astlib/migrate_503_504.ml b/astlib/migrate_503_504.ml
index 55237bec..3e5b536b 100644
--- a/astlib/migrate_503_504.ml
+++ b/astlib/migrate_503_504.ml
@@ -179,6 +179,11 @@ and copy_expression_desc_with_loc :
       Ast_504.Parsetree.Pexp_open (copy_open_declaration x0, copy_expression x1)
   | Ast_503.Parsetree.Pexp_letop x0 ->
       Ast_504.Parsetree.Pexp_letop (copy_letop x0)
+  | Ast_503.Parsetree.Pexp_extension ({ txt; loc }, payload)
+    when String.equal txt Encoding_504.Ext_name.pexp_labeled_tuple ->
+      let xs = Encoding_504.To_503.decode_pexp_labeled_tuple ~loc payload in
+      Ast_504.Parsetree.Pexp_tuple
+        (List.map (fun (lbl, exp) -> (lbl, copy_expression exp)) xs)
   | Ast_503.Parsetree.Pexp_extension x0 ->
       Ast_504.Parsetree.Pexp_extension (copy_extension x0)
   | Ast_503.Parsetree.Pexp_unreachable -> Ast_504.Parsetree.Pexp_unreachable
@@ -351,10 +356,14 @@ and copy_pattern_desc_with_loc :
         (copy_loc (fun x -> Option.map (fun x -> x) x) x0)
   | Ast_503.Parsetree.Ppat_exception x0 ->
       Ast_504.Parsetree.Ppat_exception (copy_pattern x0)
-  | Ast_503.Parsetree.Ppat_extension
-      ( { txt = "ppxlib.migration.ppat_effect"; _ },
-        PPat ({ ppat_desc = Ppat_tuple [ e; c ]; _ }, None) ) ->
-      Ast_504.Parsetree.Ppat_effect (copy_pattern e, copy_pattern c)
+  | Ast_503.Parsetree.Ppat_extension ({ txt; loc }, payload)
+    when String.equal txt Encoding_504.Ext_name.ppat_labeled_tuple ->
+      let pats, flag =
+        Encoding_504.To_503.decode_ppat_labeled_tuple ~loc payload
+      in
+      Ast_504.Parsetree.Ppat_tuple
+        ( List.map (fun (lbl, pat) -> (lbl, copy_pattern pat)) pats,
+          copy_closed_flag flag )
   | Ast_503.Parsetree.Ppat_extension x0 ->
       Ast_504.Parsetree.Ppat_extension (copy_extension x0)
   | Ast_503.Parsetree.Ppat_open (x0, x1) ->
@@ -433,6 +442,11 @@ and copy_core_type_desc :
   | Ast_503.Parsetree.Ptyp_open (x0, ty) ->
       Ast_504.Parsetree.Ptyp_open
         (copy_loc copy_Longident_t x0, copy_core_type ty)
+  | Ast_503.Parsetree.Ptyp_extension ({ txt; loc }, payload)
+    when String.equal txt Encoding_504.Ext_name.ptyp_labeled_tuple ->
+      let xs = Encoding_504.To_503.decode_ptyp_labeled_tuple ~loc payload in
+      Ast_504.Parsetree.Ptyp_tuple
+        (List.map (fun (lbl, typ) -> (lbl, copy_core_type typ)) xs)
   | Ast_503.Parsetree.Ptyp_extension x0 ->
       Ast_504.Parsetree.Ptyp_extension (copy_extension x0)
 
diff --git a/astlib/migrate_504_503.ml b/astlib/migrate_504_503.ml
index 1457b612..fcd19373 100644
--- a/astlib/migrate_504_503.ml
+++ b/astlib/migrate_504_503.ml
@@ -55,14 +55,15 @@ and copy_expression :
        Ast_504.Parsetree.pexp_loc_stack;
        Ast_504.Parsetree.pexp_attributes;
      } ->
+  let loc = copy_location pexp_loc in
   {
-    Ast_503.Parsetree.pexp_desc = copy_expression_desc pexp_desc;
-    Ast_503.Parsetree.pexp_loc = copy_location pexp_loc;
+    Ast_503.Parsetree.pexp_desc = copy_expression_desc ~loc pexp_desc;
+    Ast_503.Parsetree.pexp_loc = loc;
     Ast_503.Parsetree.pexp_loc_stack = copy_location_stack pexp_loc_stack;
     Ast_503.Parsetree.pexp_attributes = copy_attributes pexp_attributes;
   }
 
-and copy_expression_desc :
+and copy_expression_desc ~loc :
     Ast_504.Parsetree.expression_desc -> Ast_503.Parsetree.expression_desc =
   function
   | Ast_504.Parsetree.Pexp_ident x0 ->
@@ -90,15 +91,12 @@ and copy_expression_desc :
   | Ast_504.Parsetree.Pexp_try (x0, x1) ->
       Ast_503.Parsetree.Pexp_try (copy_expression x0, List.map copy_case x1)
   | Ast_504.Parsetree.Pexp_tuple x0 ->
-      let args =
-        List.map
-          (function
-            | None, arg -> arg
-            | Some _l, (arg : Ast_504.Parsetree.expression) ->
-                migration_error arg.pexp_loc "labelled tuples")
-          x0
+      let exps =
+        List.map (fun (label, exp) -> (label, copy_expression exp)) x0
       in
-      Ast_503.Parsetree.Pexp_tuple (List.map copy_expression args)
+      if List.exists (function Some _, _ -> true | _ -> false) exps then
+        Encoding_504.To_503.encode_pexp_labeled_tuple ~loc exps
+      else Ast_503.Parsetree.Pexp_tuple (List.map snd exps)
   | Ast_504.Parsetree.Pexp_construct (x0, x1) ->
       Ast_503.Parsetree.Pexp_construct
         (copy_loc copy_Longident_t x0, Option.map copy_expression x1)
@@ -323,15 +321,16 @@ and copy_pattern_desc loc :
       Ast_503.Parsetree.Ppat_constant (copy_constant x0)
   | Ast_504.Parsetree.Ppat_interval (x0, x1) ->
       Ast_503.Parsetree.Ppat_interval (copy_constant x0, copy_constant x1)
-  | Ast_504.Parsetree.Ppat_tuple (x0, _) ->
-      let args =
-        List.map
-          (function
-            | None, arg -> arg
-            | Some l, _ -> migration_error loc "labelled tuples")
-          x0
+  | Ast_504.Parsetree.Ppat_tuple (x0, flag) -> (
+      let flag = copy_closed_flag flag in
+      let args = List.map (fun (lbl, pat) -> (lbl, copy_pattern pat)) x0 in
+      let has_label =
+        List.exists (function Some _, _ -> true | _ -> false) args
       in
-      Ast_503.Parsetree.Ppat_tuple (List.map copy_pattern args)
+      match (has_label, flag) with
+      | true, _ | false, Open ->
+          Encoding_504.To_503.encode_ppat_labeled_tuple ~loc args flag
+      | _, _ -> Ast_503.Parsetree.Ppat_tuple (List.map snd args))
   | Ast_504.Parsetree.Ppat_construct (x0, x1) ->
       Ast_503.Parsetree.Ppat_construct
         ( copy_loc copy_Longident_t x0,
@@ -406,9 +405,10 @@ and copy_core_type : Ast_504.Parsetree.core_type -> Ast_503.Parsetree.core_type
        Ast_504.Parsetree.ptyp_loc_stack;
        Ast_504.Parsetree.ptyp_attributes;
      } ->
+  let loc = copy_location ptyp_loc in
   {
-    Ast_503.Parsetree.ptyp_desc = copy_core_type_desc ptyp_desc;
-    Ast_503.Parsetree.ptyp_loc = copy_location ptyp_loc;
+    Ast_503.Parsetree.ptyp_desc = copy_core_type_desc ~loc ptyp_desc;
+    Ast_503.Parsetree.ptyp_loc = loc;
     Ast_503.Parsetree.ptyp_loc_stack = copy_location_stack ptyp_loc_stack;
     Ast_503.Parsetree.ptyp_attributes = copy_attributes ptyp_attributes;
   }
@@ -417,7 +417,7 @@ and copy_location_stack :
     Ast_504.Parsetree.location_stack -> Ast_503.Parsetree.location_stack =
  fun x -> List.map copy_location x
 
-and copy_core_type_desc :
+and copy_core_type_desc ~loc :
     Ast_504.Parsetree.core_type_desc -> Ast_503.Parsetree.core_type_desc =
   function
   | Ast_504.Parsetree.Ptyp_any -> Ast_503.Parsetree.Ptyp_any
@@ -426,15 +426,13 @@ and copy_core_type_desc :
       Ast_503.Parsetree.Ptyp_arrow
         (copy_arg_label x0, copy_core_type x1, copy_core_type x2)
   | Ast_504.Parsetree.Ptyp_tuple x0 ->
-      let args =
-        List.map
-          (function
-            | None, arg -> arg
-            | Some l, (arg : Ast_504.Parsetree.core_type) ->
-                migration_error arg.ptyp_loc "labelled tuples")
-          x0 (* TODO: Proper migration error *)
+      let typs =
+        List.map (fun (label, typ) -> (label, copy_core_type typ)) x0
       in
-      Ast_503.Parsetree.Ptyp_tuple (List.map copy_core_type args)
+      if List.exists (function Some _, _ -> true | _ -> false) typs then
+        (* At least one element of the tuple is labeled *)
+        Encoding_504.To_503.encode_ptyp_labeled_tuple ~loc typs
+      else Ast_503.Parsetree.Ptyp_tuple (List.map snd typs)
   | Ast_504.Parsetree.Ptyp_constr (x0, x1) ->
       Ast_503.Parsetree.Ptyp_constr
         (copy_loc copy_Longident_t x0, List.map copy_core_type x1)
diff --git a/astlib/stdlib0.ml b/astlib/stdlib0.ml
index fb3efb70..d0b4796e 100644
--- a/astlib/stdlib0.ml
+++ b/astlib/stdlib0.ml
@@ -1,12 +1,6 @@
-module Int = struct
-  let to_string = string_of_int
-end
-
-module Option = struct
-  let map f o = match o with None -> None | Some v -> Some (f v)
-end
-
 module String = struct
+  include String
+
   let is_prefix t ~prefix =
     let rec is_prefix_from t ~prefix ~pos ~len =
       pos >= len
@@ -16,3 +10,23 @@ module String = struct
     String.length t >= String.length prefix
     && is_prefix_from t ~prefix ~pos:0 ~len:(String.length prefix)
 end
+
+module Option = struct
+  include Option
+
+  module Op = struct
+    let ( let* ) = Option.bind
+    let ( let+ ) o f = Option.map f o
+  end
+
+  module List = struct
+    let map ~f l =
+      let rec aux acc l =
+        match l with
+        | [] -> Some (List.rev acc)
+        | hd :: tl -> (
+            match f hd with None -> None | Some x -> aux (x :: acc) tl)
+      in
+      aux [] l
+  end
+end
diff --git a/src/ast_builder.ml b/src/ast_builder.ml
index f8dccfb7..bb5421c2 100644
--- a/src/ast_builder.ml
+++ b/src/ast_builder.ml
@@ -264,6 +264,24 @@ module Default = struct
   let ppat_tuple ~loc l = match l with [ x ] -> x | _ -> ppat_tuple ~loc l
   let ptyp_tuple ~loc l = match l with [ x ] -> x | _ -> ptyp_tuple ~loc l
 
+  let ptyp_labeled_tuple ~loc l =
+    let ptyp_desc =
+      Astlib__.Encoding_504.To_502.encode_ptyp_labeled_tuple ~loc l
+    in
+    { ptyp_desc; ptyp_loc = loc; ptyp_attributes = []; ptyp_loc_stack = [] }
+
+  let pexp_labeled_tuple ~loc l =
+    let pexp_desc =
+      Astlib__.Encoding_504.To_502.encode_pexp_labeled_tuple ~loc l
+    in
+    { pexp_desc; pexp_loc = loc; pexp_attributes = []; pexp_loc_stack = [] }
+
+  let ppat_labeled_tuple ~loc l flag =
+    let ppat_desc =
+      Astlib__.Encoding_504.To_502.encode_ppat_labeled_tuple ~loc l flag
+    in
+    { ppat_desc; ppat_loc = loc; ppat_attributes = []; ppat_loc_stack = [] }
+
   let pexp_tuple_opt ~loc l =
     match l with [] -> None | _ :: _ -> Some (pexp_tuple ~loc l)
 
@@ -555,6 +573,9 @@ end) : S = struct
   let pexp_tuple l = Default.pexp_tuple ~loc l
   let ppat_tuple l = Default.ppat_tuple ~loc l
   let ptyp_tuple l = Default.ptyp_tuple ~loc l
+  let ptyp_labeled_tuple l = Default.ptyp_labeled_tuple ~loc l
+  let pexp_labeled_tuple l = Default.pexp_labeled_tuple ~loc l
+  let ppat_labeled_tuple l flag = Default.ppat_labeled_tuple ~loc l flag
   let pexp_tuple_opt l = Default.pexp_tuple_opt ~loc l
   let ppat_tuple_opt l = Default.ppat_tuple_opt ~loc l
   let ptyp_poly vars ty = Default.ptyp_poly ~loc vars ty
diff --git a/src/ast_builder_intf.ml b/src/ast_builder_intf.ml
index ce3d77a5..d0da6fa7 100644
--- a/src/ast_builder_intf.ml
+++ b/src/ast_builder_intf.ml
@@ -153,6 +153,31 @@ module type Additional_helpers = sig
 
   val eta_reduce_if_possible_and_nonrec :
     expression -> rec_flag:rec_flag -> expression
+
+  (** {2:future-asts Compat functions for future AST nodes}
+
+      The functions in this section provide a safe interface to generate AST
+      nodes that cannot be represented with Ppxlib's own AST but are available
+      with more recent versions of the compiler.
+
+      Note that producing such nodes will make the generated code incompatible
+      with compilers older than the feature you are trying to represent. Those
+      nodes also won't play nicely with the driver's default source output or if
+      printed as source using [Ppxlib.Pprintast]. You can use the
+      --use-compiler-pp flag of the driver to use your current compiler's AST to
+      source printers. *)
+
+  val ptyp_labeled_tuple :
+    ((string option * core_type) list -> core_type) with_loc
+  (** Returns an encoded labeled tuple type as introduced in OCaml 5.4. *)
+
+  val pexp_labeled_tuple :
+    ((string option * expression) list -> expression) with_loc
+  (** Returns an encoded labeled tuple expression as introduced in OCaml 5.4. *)
+
+  val ppat_labeled_tuple :
+    ((string option * pattern) list -> closed_flag -> pattern) with_loc
+  (** Returns an encoded labeled tuple pattern as introduced in OCaml 5.4. *)
 end
 
 module type Located = sig
diff --git a/src/ast_pattern.ml b/src/ast_pattern.ml
index 8efafda6..87bbd7ce 100644
--- a/src/ast_pattern.ml
+++ b/src/ast_pattern.ml
@@ -275,3 +275,54 @@ let esequence (T f) =
 
 let of_func f = T f
 let to_func (T f) = f
+
+let ptyp_labeled_tuple (T f0) =
+  T
+    (fun ctx _loc x k ->
+      let loc = x.ptyp_loc in
+      let x = x.ptyp_desc in
+      match x with
+      | Ptyp_extension ({ txt; _ }, payload)
+        when String.equal txt Astlib__.Encoding_504.Ext_name.ptyp_labeled_tuple
+        ->
+          let x0 =
+            Astlib__.Encoding_504.To_502.decode_ptyp_labeled_tuple ~loc payload
+          in
+          ctx.matched <- ctx.matched + 1;
+          let k = f0 ctx loc x0 k in
+          k
+      | _ -> fail loc "labeled tuple")
+
+let pexp_labeled_tuple (T f0) =
+  T
+    (fun ctx _loc x k ->
+      let loc = x.pexp_loc in
+      let x = x.pexp_desc in
+      match x with
+      | Pexp_extension ({ txt; _ }, payload)
+        when String.equal txt Astlib__.Encoding_504.Ext_name.pexp_labeled_tuple
+        ->
+          let x0 =
+            Astlib__.Encoding_504.To_502.decode_pexp_labeled_tuple ~loc payload
+          in
+          ctx.matched <- ctx.matched + 1;
+          let k = f0 ctx loc x0 k in
+          k
+      | _ -> fail loc "labeled tuple")
+
+let ppat_labeled_tuple (T f0) =
+  T
+    (fun ctx _loc x k ->
+      let loc = x.ppat_loc in
+      let x = x.ppat_desc in
+      match x with
+      | Ppat_extension ({ txt; _ }, payload)
+        when String.equal txt Astlib__.Encoding_504.Ext_name.ppat_labeled_tuple
+        ->
+          let x0 =
+            Astlib__.Encoding_504.To_502.decode_ppat_labeled_tuple ~loc payload
+          in
+          ctx.matched <- ctx.matched + 1;
+          let k = f0 ctx loc x0 k in
+          k
+      | _ -> fail loc "labeled tuple")
diff --git a/src/ast_pattern.mli b/src/ast_pattern.mli
index 5f42a691..885e7ce8 100644
--- a/src/ast_pattern.mli
+++ b/src/ast_pattern.mli
@@ -214,3 +214,33 @@ val to_func : ('a, 'b, 'c) t -> context -> Location.t -> 'a -> 'b -> 'c
 val fail : Location.t -> string -> _
 (** Call from [of_func]'s argument when the pattern does not match. The string
     should describe the expected shape of the AST where the match failed. *)
+
+(** {2:future-asts Compat functions for future AST nodes}
+
+    The functions in this section provide a safe interface to match over AST
+    nodes that cannot be represented with Ppxlib's own AST but are available
+    with more recent versions of the compiler. *)
+
+val ptyp_labeled_tuple :
+  ((string option * core_type) list, 'a, 'b) t -> (core_type, 'a, 'b) t
+(** Match over an encoded OCaml 5.4 labeled tuple type.
+
+    It will fail on a regular tuple type and as a consequence, if it matches, at
+    least one type in the tuple is guaranteed to be labeled. *)
+
+val pexp_labeled_tuple :
+  ((string option * expression) list, 'a, 'b) t -> (expression, 'a, 'b) t
+(** Match over an encoded OCaml 5.4 labeled tuple expression.
+
+    It will fail on a regular tuple expression and as a consequence, if it
+    matches, at least one expression in the tuple is guaranteed to be labeled.
+*)
+
+val ppat_labeled_tuple :
+  ((string option * pattern) list * closed_flag, 'a, 'b) t ->
+  (pattern, 'a, 'b) t
+(** Match over an encoded OCaml 5.4 labeled tuple pattern.
+
+    It will fail on a regular tuple expression and as a consequence, if it
+    matches, either at least one pattern in the tuple is guaranteed to be
+    labeled or the flag to be [Open]. *)
diff --git a/test/encoding/504/api/dune b/test/encoding/504/api/dune
new file mode 100644
index 00000000..a8f58dca
--- /dev/null
+++ b/test/encoding/504/api/dune
@@ -0,0 +1,14 @@
+(rule
+ (package ppxlib)
+ (alias runtest)
+ (enabled_if
+  (>= %{ocaml_version} 5.4))
+ (deps
+  (:test test.ml)
+  (package ppxlib))
+ (action
+  (chdir
+   %{project_root}
+   (progn
+    (run expect-test %{test})
+    (diff? %{test} %{test}.corrected)))))
diff --git a/test/encoding/504/api/test.ml b/test/encoding/504/api/test.ml
new file mode 100644
index 00000000..bb47974f
--- /dev/null
+++ b/test/encoding/504/api/test.ml
@@ -0,0 +1,148 @@
+open Ppxlib_ast
+
+module To_ocaml = Convert (Js) (Compiler_version)
+module From_ocaml = Convert (Compiler_version) (Js)
+
+open Ppxlib
+
+#install_printer Pprintast.core_type;;
+#install_printer Pprintast.expression;;
+#install_printer Pprintast.pattern;;
+
+module Builder = Ast_builder.Make(struct let loc = Location.none end)
+
+let ptyp_int = Builder.(ptyp_constr (Located.mk (Longident.parse "int")) [])
+let ptyp_string =
+  Builder.(ptyp_constr (Located.mk (Longident.parse "string")) []);;
+[%%ignore]
+
+(* Generate an encoded labeled tuple type *)
+let encoded_labeled_tuple_type =
+  Builder.ptyp_labeled_tuple
+    [ Some "a", ptyp_int
+    ; Some "b", ptyp_int
+    ; None, ptyp_string
+    ]
+
+(* Migrate it to the current compiler (>= 5.4, as per dune rules) *)
+let labeled_tuple_type = To_ocaml.copy_core_type encoded_labeled_tuple_type;;
+[%%ignore]
+
+let as_source =
+  Format.asprintf "%a" Astlib.Compiler_pprintast.core_type labeled_tuple_type;;
+[%%expect{|
+val as_source : string = "(a:int * b:int * string)"
+|}]
+
+(* Migrate back to ppxlib's AST *)
+let encoded_by_migration = From_ocaml.copy_core_type labeled_tuple_type
+
+let pattern = Ast_pattern.(ptyp_labeled_tuple __);;
+[%%ignore]
+
+(* Destruct both the migration and Ast_builder generated encodings with
+   the Ast_pattern function. *)
+let destruct_from_migration =
+  Ast_pattern.parse_res pattern Location.none encoded_by_migration (fun x -> x);;
+[%%expect{|
+val destruct_from_migration :
+  ((string option * core_type) list, Location.Error.t Stdppx.NonEmptyList.t)
+  result = Ok [(Some "a", int); (Some "b", int); (None, string)]
+|}]
+
+let destruct =
+  Ast_pattern.parse_res pattern Location.none
+    encoded_labeled_tuple_type (fun x -> x);;
+[%%expect{|
+val destruct :
+  ((string option * core_type) list, Location.Error.t Stdppx.NonEmptyList.t)
+  result = Ok [(Some "a", int); (Some "b", int); (None, string)]
+|}]
+
+(* -------- Same tests with labeled tuples expressions ---------- *)
+
+let encoded_labeled_tuple_expr =
+  Builder.pexp_labeled_tuple
+    [ Some "a", Builder.eint 0
+    ; Some "b", Builder.eint 1
+    ; None, Builder.estring "abc"
+    ]
+
+let labeled_tuple_expr = To_ocaml.copy_expression encoded_labeled_tuple_expr;;
+[%%ignore]
+
+let as_source =
+  Format.asprintf "%a" Astlib.Compiler_pprintast.expression
+    labeled_tuple_expr;;
+[%%expect{|
+val as_source : string = "(~a:0, ~b:1, \"abc\")"
+|}]
+
+let encoded_by_migration = From_ocaml.copy_expression labeled_tuple_expr
+
+let pattern = Ast_pattern.(pexp_labeled_tuple __);;
+[%%ignore]
+
+let destruct_from_migration =
+  Ast_pattern.parse_res pattern Location.none encoded_by_migration
+    (fun x -> x);;
+[%%expect{|
+val destruct_from_migration :
+  ((string option * expression) list, Location.Error.t Stdppx.NonEmptyList.t)
+  result = Ok [(Some "a", 0); (Some "b", 1); (None, "abc")]
+|}]
+
+let destruct =
+  Ast_pattern.parse_res pattern Location.none encoded_labeled_tuple_expr
+    (fun x -> x);;
+[%%expect{|
+val destruct :
+  ((string option * expression) list, Location.Error.t Stdppx.NonEmptyList.t)
+  result = Ok [(Some "a", 0); (Some "b", 1); (None, "abc")]
+|}]
+
+(* -------- Same tests with labeled tuples patterns ---------- *)
+
+let encoded_labeled_tuple_pat =
+  Builder.ppat_labeled_tuple
+    [ Some "a", Builder.(ppat_var (Located.mk "a"))
+    ; Some "b", Builder.ppat_any
+    ; None, Builder.(ppat_var (Located.mk "c"))
+    ]
+    Open
+
+let labeled_tuple_pat = To_ocaml.copy_pattern encoded_labeled_tuple_pat;;
+[%%ignore]
+
+let as_source =
+  Format.asprintf "%a" Astlib.Compiler_pprintast.pattern labeled_tuple_pat;;
+[%%expect{|
+val as_source : string = "(~a, ~b:_, c, ..)"
+|}]
+
+let encoded_by_migration = From_ocaml.copy_pattern labeled_tuple_pat
+
+let pattern = Ast_pattern.(ppat_labeled_tuple __);;
+[%%ignore]
+
+let destruct_from_migration =
+  Ast_pattern.parse_res pattern Location.none encoded_by_migration
+    (fun x -> x);;
+[%%expect{|
+val destruct_from_migration :
+  ((string option * pattern) list * closed_flag,
+   Location.Error.t Stdppx.NonEmptyList.t)
+  result =
+  Ok ([(Some "a", a); (Some "b", _); (None, c)], Ppxlib__.Import.Open)
+|}]
+
+let destruct =
+  Ast_pattern.parse_res pattern Location.none encoded_by_migration
+    (fun x -> x);;
+[%%expect{|
+val destruct :
+  ((string option * pattern) list * closed_flag,
+   Location.Error.t Stdppx.NonEmptyList.t)
+  result =
+  Ok ([(Some "a", a); (Some "b", _); (None, c)], Ppxlib__.Import.Open)
+|}]
diff --git a/test/encoding/504/migrations/dune b/test/encoding/504/migrations/dune
new file mode 100644
index 00000000..c8362087
--- /dev/null
+++ b/test/encoding/504/migrations/dune
@@ -0,0 +1,10 @@
+(executable
+ (name id_driver)
+ (modules id_driver)
+ (libraries ppxlib))
+
+(cram
+ (package ppxlib)
+ (enabled_if
+  (>= %{ocaml_version} 5.4))
+ (deps id_driver.exe))
diff --git a/test/encoding/504/migrations/id_driver.ml b/test/encoding/504/migrations/id_driver.ml
new file mode 100644
index 00000000..e3cba404
--- /dev/null
+++ b/test/encoding/504/migrations/id_driver.ml
@@ -0,0 +1 @@
+let () = Ppxlib.Driver.standalone ()
diff --git a/test/encoding/504/migrations/run.t b/test/encoding/504/migrations/run.t
new file mode 100644
index 00000000..32439687
--- /dev/null
+++ b/test/encoding/504/migrations/run.t
@@ -0,0 +1,44 @@
+This test checks that labeled tuple types are correctly encoded
+when migrated down to our 5.2 AST
+
+  $ cat > type.ml << EOF
+  > type t = (a: int * b: int * string)
+  > EOF
+
+  $ ./id_driver.exe type.ml
+  type t =
+    [%ppxlib.migration.ptyp_labeled_tuple_504 :
+      (('a * int) * ('b * int) * (_ * string))]
+
+And that it is correctly decoded when migrated back up to 5.4+ ASTS:
+
+  $ ./id_driver.exe type.ml --use-compiler-pp
+  type t = (a:int * b:int * string)
+
+Same for expressions:
+
+  $ cat > expression.ml << EOF
+  > let x = (~a:0, ~b:1, "abc")
+  > EOF
+
+  $ ./id_driver.exe expression.ml
+  let x =
+    [%ppxlib.migration.pexp_labeled_tuple_504
+      (((`Some `a), 0), ((`Some `b), 1), (`None, "abc"))]
+
+  $ ./id_driver.exe expression.ml --use-compiler-pp
+  let x = (~a:0, ~b:1, "abc")
+
+And same for patterns:
+
+  $ cat > pattern.ml << EOF
+  > let (~a, ~b:_, c, ..) = x
+  > EOF
+
+  $ ./id_driver.exe pattern.ml
+  let [%ppxlib.migration.ppat_labeled_tuple_504 ?
+        (((a, a), (b, _), (_, c)), open_)]
+    = x
+
+  $ ./id_driver.exe pattern.ml --use-compiler-pp
+  let (~a, ~b:_, c, ..) = x