From fd175eb431343d0113a8b765773d7ebe6c9009c7 Mon Sep 17 00:00:00 2001
From: Antal Spector-Zabusky <antal.b.sz@gmail.com>
Date: Thu, 10 Aug 2023 16:42:56 -0400
Subject: [PATCH 01/31] Expose migration etc. for all AST types needed by
 `Pprintast`

Signed-off-by: Antal Spector-Zabusky <antal.b.sz@gmail.com>
---
 CHANGES.md                             |   2 +
 ast/cinaps/ast_cinaps_helpers.ml       |  28 +----
 ast/cinaps/dune                        |   2 +-
 ast/import.ml                          | 120 ++++++++++++++++--
 ast/versions.ml                        | 162 +++++++++++++++++++++++++
 ast/versions.mli                       |  36 ++++++
 astlib/cinaps/astlib_cinaps_helpers.ml |  34 ++++++
 astlib/migrate_414_500.ml              | 106 +++++++++++-----
 astlib/migrate_500_414.ml              | 106 +++++++++++-----
 9 files changed, 505 insertions(+), 91 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index e2d1dab2a..d30021973 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -7,6 +7,8 @@ unreleased
 
 - Restore the "path_arg" functionality in the V3 API (#431, @ELLIOTTCABLE)
 
+- Expose migration/copying/etc. functions for all AST types needed by `Pprintast` (#454, @antalsz)
+
 0.30.0 (20/06/2023)
 -------------------
 
diff --git a/ast/cinaps/ast_cinaps_helpers.ml b/ast/cinaps/ast_cinaps_helpers.ml
index 237c572af..f1d9a0882 100644
--- a/ast/cinaps/ast_cinaps_helpers.ml
+++ b/ast/cinaps/ast_cinaps_helpers.ml
@@ -3,33 +3,13 @@
 include StdLabels
 include Printf
 
-let nl () = printf "\n"
-
-let qualified_types =
-  [
-    ( "Parsetree",
-      [
-        "structure";
-        "signature";
-        "toplevel_phrase";
-        "core_type";
-        "expression";
-        "pattern";
-        "case";
-        "type_declaration";
-        "type_extension";
-        "extension_constructor";
-      ] );
-  ]
+let nl = Astlib_cinaps_helpers.nl
+let qualified_types = Astlib_cinaps_helpers.qualified_types
+let foreach_module = Astlib_cinaps_helpers.foreach_module
+let foreach_type = Astlib_cinaps_helpers.foreach_type
 
 let all_types = List.concat (List.map ~f:snd qualified_types)
 
-let foreach_module f =
-  nl ();
-  List.iter qualified_types ~f:(fun (m, types) -> f m types)
-
-let foreach_type f = foreach_module (fun m -> List.iter ~f:(f m))
-
 let foreach_version f =
   nl ();
   List.iter Supported_version.all ~f:(fun v ->
diff --git a/ast/cinaps/dune b/ast/cinaps/dune
index 0b5e453a8..b40d6d415 100644
--- a/ast/cinaps/dune
+++ b/ast/cinaps/dune
@@ -1,3 +1,3 @@
 (library
  (name ast_cinaps_helpers)
- (libraries supported_version))
+ (libraries supported_version astlib_cinaps_helpers))
diff --git a/ast/import.ml b/ast/import.ml
index 7ed293b81..915535809 100644
--- a/ast/import.ml
+++ b/ast/import.ml
@@ -4,6 +4,8 @@
    It must be opened in all modules, especially the ones coming from the compiler.
 *)
 
+(*$ open Ast_cinaps_helpers $*)
+
 module Js = Versions.OCaml_500
 module Ocaml = Versions.OCaml_current
 
@@ -12,18 +14,43 @@ module Select_ast (Ocaml : Versions.OCaml_version) = struct
 
   module Type = struct
     type ('js, 'ocaml) t =
-      | Signature
-          : (Js.Ast.Parsetree.signature, Ocaml.Ast.Parsetree.signature) t
+      (*$ foreach_type (fun _ s ->
+            printf
+              "      | %s\n\
+              \          : ( Js.Ast.Parsetree.%s,\n\
+              \              Ocaml.Ast.Parsetree.%s )\n\
+              \            t\n"
+              (String.capitalize_ascii s) s s
+          )
+      *)
       | Structure
-          : (Js.Ast.Parsetree.structure, Ocaml.Ast.Parsetree.structure) t
+          : ( Js.Ast.Parsetree.structure,
+              Ocaml.Ast.Parsetree.structure )
+            t
+      | Signature
+          : ( Js.Ast.Parsetree.signature,
+              Ocaml.Ast.Parsetree.signature )
+            t
       | Toplevel_phrase
           : ( Js.Ast.Parsetree.toplevel_phrase,
               Ocaml.Ast.Parsetree.toplevel_phrase )
             t
-      | Expression
-          : (Js.Ast.Parsetree.expression, Ocaml.Ast.Parsetree.expression) t
       | Core_type
-          : (Js.Ast.Parsetree.core_type, Ocaml.Ast.Parsetree.core_type) t
+          : ( Js.Ast.Parsetree.core_type,
+              Ocaml.Ast.Parsetree.core_type )
+            t
+      | Expression
+          : ( Js.Ast.Parsetree.expression,
+              Ocaml.Ast.Parsetree.expression )
+            t
+      | Pattern
+          : ( Js.Ast.Parsetree.pattern,
+              Ocaml.Ast.Parsetree.pattern )
+            t
+      | Case
+          : ( Js.Ast.Parsetree.case,
+              Ocaml.Ast.Parsetree.case )
+            t
       | Type_declaration
           : ( Js.Ast.Parsetree.type_declaration,
               Ocaml.Ast.Parsetree.type_declaration )
@@ -36,6 +63,43 @@ module Select_ast (Ocaml : Versions.OCaml_version) = struct
           : ( Js.Ast.Parsetree.extension_constructor,
               Ocaml.Ast.Parsetree.extension_constructor )
             t
+      | Class_expr
+          : ( Js.Ast.Parsetree.class_expr,
+              Ocaml.Ast.Parsetree.class_expr )
+            t
+      | Class_field
+          : ( Js.Ast.Parsetree.class_field,
+              Ocaml.Ast.Parsetree.class_field )
+            t
+      | Class_type
+          : ( Js.Ast.Parsetree.class_type,
+              Ocaml.Ast.Parsetree.class_type )
+            t
+      | Class_signature
+          : ( Js.Ast.Parsetree.class_signature,
+              Ocaml.Ast.Parsetree.class_signature )
+            t
+      | Class_type_field
+          : ( Js.Ast.Parsetree.class_type_field,
+              Ocaml.Ast.Parsetree.class_type_field )
+            t
+      | Module_expr
+          : ( Js.Ast.Parsetree.module_expr,
+              Ocaml.Ast.Parsetree.module_expr )
+            t
+      | Module_type
+          : ( Js.Ast.Parsetree.module_type,
+              Ocaml.Ast.Parsetree.module_type )
+            t
+      | Signature_item
+          : ( Js.Ast.Parsetree.signature_item,
+              Ocaml.Ast.Parsetree.signature_item )
+            t
+      | Structure_item
+          : ( Js.Ast.Parsetree.structure_item,
+              Ocaml.Ast.Parsetree.structure_item )
+            t
+(*$*)
       | List : ('a, 'b) t -> ('a list, 'b list) t
       | Pair : ('a, 'b) t * ('c, 'd) t -> ('a * 'c, 'b * 'd) t
   end
@@ -48,14 +112,32 @@ module Select_ast (Ocaml : Versions.OCaml_version) = struct
     let open Of_ocaml in
     fun node ->
       match node with
-      | Signature -> copy_signature
+      (*$ foreach_type (fun _ s ->
+            printf
+              "      | %s -> copy_%s\n"
+              (String.capitalize_ascii s) s
+          )
+      *)
       | Structure -> copy_structure
+      | Signature -> copy_signature
       | Toplevel_phrase -> copy_toplevel_phrase
-      | Expression -> copy_expression
       | Core_type -> copy_core_type
+      | Expression -> copy_expression
+      | Pattern -> copy_pattern
+      | Case -> copy_case
       | Type_declaration -> copy_type_declaration
       | Type_extension -> copy_type_extension
       | Extension_constructor -> copy_extension_constructor
+      | Class_expr -> copy_class_expr
+      | Class_field -> copy_class_field
+      | Class_type -> copy_class_type
+      | Class_signature -> copy_class_signature
+      | Class_type_field -> copy_class_type_field
+      | Module_expr -> copy_module_expr
+      | Module_type -> copy_module_type
+      | Signature_item -> copy_signature_item
+      | Structure_item -> copy_structure_item
+(*$*)
       | List t -> List.map (of_ocaml t)
       | Pair (a, b) ->
           let f = of_ocaml a in
@@ -66,14 +148,32 @@ module Select_ast (Ocaml : Versions.OCaml_version) = struct
     let open To_ocaml in
     fun node ->
       match node with
-      | Signature -> copy_signature
+      (*$ foreach_type (fun _ s ->
+            printf
+              "      | %s -> copy_%s\n"
+              (String.capitalize_ascii s) s
+          )
+      *)
       | Structure -> copy_structure
+      | Signature -> copy_signature
       | Toplevel_phrase -> copy_toplevel_phrase
-      | Expression -> copy_expression
       | Core_type -> copy_core_type
+      | Expression -> copy_expression
+      | Pattern -> copy_pattern
+      | Case -> copy_case
       | Type_declaration -> copy_type_declaration
       | Type_extension -> copy_type_extension
       | Extension_constructor -> copy_extension_constructor
+      | Class_expr -> copy_class_expr
+      | Class_field -> copy_class_field
+      | Class_type -> copy_class_type
+      | Class_signature -> copy_class_signature
+      | Class_type_field -> copy_class_type_field
+      | Module_expr -> copy_module_expr
+      | Module_type -> copy_module_type
+      | Signature_item -> copy_signature_item
+      | Structure_item -> copy_structure_item
+(*$*)
       | List t -> List.map (to_ocaml t)
       | Pair (a, b) ->
           let f = to_ocaml a in
diff --git a/ast/versions.ml b/ast/versions.ml
index cf7bb2081..58598030b 100644
--- a/ast/versions.ml
+++ b/ast/versions.ml
@@ -46,6 +46,15 @@ module type Ast = sig
     type type_declaration
     type type_extension
     type extension_constructor
+    type class_expr
+    type class_field
+    type class_type
+    type class_signature
+    type class_type_field
+    type module_expr
+    type module_type
+    type signature_item
+    type structure_item
   end
 (*$*)
   module Config : sig
@@ -69,6 +78,15 @@ type 'a _types = 'a constraint 'a
     type_declaration      : _;
     type_extension        : _;
     extension_constructor : _;
+    class_expr            : _;
+    class_field           : _;
+    class_type            : _;
+    class_signature       : _;
+    class_type_field      : _;
+    module_expr           : _;
+    module_type           : _;
+    signature_item        : _;
+    structure_item        : _;
 (*$*)
   >
 ;;
@@ -97,6 +115,24 @@ type 'a get_type_extension =
   'x constraint 'a _types = < type_extension : 'x; .. >
 type 'a get_extension_constructor =
   'x constraint 'a _types = < extension_constructor : 'x; .. >
+type 'a get_class_expr =
+  'x constraint 'a _types = < class_expr : 'x; .. >
+type 'a get_class_field =
+  'x constraint 'a _types = < class_field : 'x; .. >
+type 'a get_class_type =
+  'x constraint 'a _types = < class_type : 'x; .. >
+type 'a get_class_signature =
+  'x constraint 'a _types = < class_signature : 'x; .. >
+type 'a get_class_type_field =
+  'x constraint 'a _types = < class_type_field : 'x; .. >
+type 'a get_module_expr =
+  'x constraint 'a _types = < module_expr : 'x; .. >
+type 'a get_module_type =
+  'x constraint 'a _types = < module_type : 'x; .. >
+type 'a get_signature_item =
+  'x constraint 'a _types = < signature_item : 'x; .. >
+type 'a get_structure_item =
+  'x constraint 'a _types = < structure_item : 'x; .. >
 (*$*)
 
 module type OCaml_version = sig
@@ -115,6 +151,15 @@ module type OCaml_version = sig
     type_declaration      : Ast.Parsetree.type_declaration;
     type_extension        : Ast.Parsetree.type_extension;
     extension_constructor : Ast.Parsetree.extension_constructor;
+    class_expr            : Ast.Parsetree.class_expr;
+    class_field           : Ast.Parsetree.class_field;
+    class_type            : Ast.Parsetree.class_type;
+    class_signature       : Ast.Parsetree.class_signature;
+    class_type_field      : Ast.Parsetree.class_type_field;
+    module_expr           : Ast.Parsetree.module_expr;
+    module_type           : Ast.Parsetree.module_type;
+    signature_item        : Ast.Parsetree.signature_item;
+    structure_item        : Ast.Parsetree.structure_item;
 (*$*)
   > _types
   type _ witnesses += Version : types witnesses
@@ -135,6 +180,15 @@ struct
     type_declaration      : Ast.Parsetree.type_declaration;
     type_extension        : Ast.Parsetree.type_extension;
     extension_constructor : Ast.Parsetree.extension_constructor;
+    class_expr            : Ast.Parsetree.class_expr;
+    class_field           : Ast.Parsetree.class_field;
+    class_type            : Ast.Parsetree.class_type;
+    class_signature       : Ast.Parsetree.class_signature;
+    class_type_field      : Ast.Parsetree.class_type_field;
+    module_expr           : Ast.Parsetree.module_expr;
+    module_type           : Ast.Parsetree.module_type;
+    signature_item        : Ast.Parsetree.signature_item;
+    structure_item        : Ast.Parsetree.structure_item;
 (*$*)
   > _types
   type _ witnesses += Version : types witnesses
@@ -157,6 +211,15 @@ type 'types ocaml_version =
      and type Ast.Parsetree.type_declaration = 'types get_type_declaration
      and type Ast.Parsetree.type_extension = 'types get_type_extension
      and type Ast.Parsetree.extension_constructor = 'types get_extension_constructor
+     and type Ast.Parsetree.class_expr = 'types get_class_expr
+     and type Ast.Parsetree.class_field = 'types get_class_field
+     and type Ast.Parsetree.class_type = 'types get_class_type
+     and type Ast.Parsetree.class_signature = 'types get_class_signature
+     and type Ast.Parsetree.class_type_field = 'types get_class_type_field
+     and type Ast.Parsetree.module_expr = 'types get_module_expr
+     and type Ast.Parsetree.module_type = 'types get_module_type
+     and type Ast.Parsetree.signature_item = 'types get_signature_item
+     and type Ast.Parsetree.structure_item = 'types get_structure_item
 (*$*)
   )
 
@@ -173,6 +236,15 @@ type ('from, 'to_) migration_functions = {
   copy_type_declaration: 'from get_type_declaration -> 'to_ get_type_declaration;
   copy_type_extension: 'from get_type_extension -> 'to_ get_type_extension;
   copy_extension_constructor: 'from get_extension_constructor -> 'to_ get_extension_constructor;
+  copy_class_expr: 'from get_class_expr -> 'to_ get_class_expr;
+  copy_class_field: 'from get_class_field -> 'to_ get_class_field;
+  copy_class_type: 'from get_class_type -> 'to_ get_class_type;
+  copy_class_signature: 'from get_class_signature -> 'to_ get_class_signature;
+  copy_class_type_field: 'from get_class_type_field -> 'to_ get_class_type_field;
+  copy_module_expr: 'from get_module_expr -> 'to_ get_module_expr;
+  copy_module_type: 'from get_module_type -> 'to_ get_module_type;
+  copy_signature_item: 'from get_signature_item -> 'to_ get_signature_item;
+  copy_structure_item: 'from get_structure_item -> 'to_ get_structure_item;
 (*$*)
 }
 
@@ -189,6 +261,15 @@ let migration_identity : ('a, 'a) migration_functions = {
   copy_type_declaration = id;
   copy_type_extension = id;
   copy_extension_constructor = id;
+  copy_class_expr = id;
+  copy_class_field = id;
+  copy_class_type = id;
+  copy_class_signature = id;
+  copy_class_type_field = id;
+  copy_module_expr = id;
+  copy_module_type = id;
+  copy_signature_item = id;
+  copy_structure_item = id;
 (*$*)
 }
 
@@ -206,6 +287,15 @@ let migration_compose (ab : ('a, 'b) migration_functions) (bc : ('b, 'c) migrati
   copy_type_declaration      = compose bc.copy_type_declaration      ab.copy_type_declaration;
   copy_type_extension        = compose bc.copy_type_extension        ab.copy_type_extension;
   copy_extension_constructor = compose bc.copy_extension_constructor ab.copy_extension_constructor;
+  copy_class_expr            = compose bc.copy_class_expr            ab.copy_class_expr;
+  copy_class_field           = compose bc.copy_class_field           ab.copy_class_field;
+  copy_class_type            = compose bc.copy_class_type            ab.copy_class_type;
+  copy_class_signature       = compose bc.copy_class_signature       ab.copy_class_signature;
+  copy_class_type_field      = compose bc.copy_class_type_field      ab.copy_class_type_field;
+  copy_module_expr           = compose bc.copy_module_expr           ab.copy_module_expr;
+  copy_module_type           = compose bc.copy_module_type           ab.copy_module_type;
+  copy_signature_item        = compose bc.copy_signature_item        ab.copy_signature_item;
+  copy_structure_item        = compose bc.copy_structure_item        ab.copy_structure_item;
 (*$*)
 }
 
@@ -226,6 +316,15 @@ module type Migrate_module = sig
   val copy_type_declaration     : From.Parsetree.type_declaration -> To.Parsetree.type_declaration
   val copy_type_extension       : From.Parsetree.type_extension -> To.Parsetree.type_extension
   val copy_extension_constructor: From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor
+  val copy_class_expr           : From.Parsetree.class_expr -> To.Parsetree.class_expr
+  val copy_class_field          : From.Parsetree.class_field -> To.Parsetree.class_field
+  val copy_class_type           : From.Parsetree.class_type -> To.Parsetree.class_type
+  val copy_class_signature      : From.Parsetree.class_signature -> To.Parsetree.class_signature
+  val copy_class_type_field     : From.Parsetree.class_type_field -> To.Parsetree.class_type_field
+  val copy_module_expr          : From.Parsetree.module_expr -> To.Parsetree.module_expr
+  val copy_module_type          : From.Parsetree.module_type -> To.Parsetree.module_type
+  val copy_signature_item       : From.Parsetree.signature_item -> To.Parsetree.signature_item
+  val copy_structure_item       : From.Parsetree.structure_item -> To.Parsetree.structure_item
 (*$*)
 end
 
@@ -248,6 +347,15 @@ struct
       copy_type_declaration;
       copy_type_extension;
       copy_extension_constructor;
+      copy_class_expr;
+      copy_class_field;
+      copy_class_type;
+      copy_class_signature;
+      copy_class_type_field;
+      copy_module_expr;
+      copy_module_type;
+      copy_signature_item;
+      copy_structure_item;
 (*$*)
     }
 end
@@ -292,6 +400,15 @@ let immediate_migration
     (type type_declaration)
     (type type_extension)
     (type extension_constructor)
+    (type class_expr)
+    (type class_field)
+    (type class_type)
+    (type class_signature)
+    (type class_type_field)
+    (type module_expr)
+    (type module_type)
+    (type signature_item)
+    (type structure_item)
 (*$*)
     ((module A) : <
      (*$ foreach_type (fun _ s -> printf  "     %-21s : %s;\n" s s) *)
@@ -305,6 +422,15 @@ let immediate_migration
      type_declaration      : type_declaration;
      type_extension        : type_extension;
      extension_constructor : extension_constructor;
+     class_expr            : class_expr;
+     class_field           : class_field;
+     class_type            : class_type;
+     class_signature       : class_signature;
+     class_type_field      : class_type_field;
+     module_expr           : module_expr;
+     module_type           : module_type;
+     signature_item        : signature_item;
+     structure_item        : structure_item;
 (*$*)
      > ocaml_version)
     direction
@@ -330,6 +456,15 @@ let migrate
     (type type_declaration1) (type type_declaration2)
     (type type_extension1) (type type_extension2)
     (type extension_constructor1) (type extension_constructor2)
+    (type class_expr1) (type class_expr2)
+    (type class_field1) (type class_field2)
+    (type class_type1) (type class_type2)
+    (type class_signature1) (type class_signature2)
+    (type class_type_field1) (type class_type_field2)
+    (type module_expr1) (type module_expr2)
+    (type module_type1) (type module_type2)
+    (type signature_item1) (type signature_item2)
+    (type structure_item1) (type structure_item2)
 (*$*)
     ((module A) : <
      (*$ foreach_type (fun _ s -> printf "     %-21s : %s1;\n" s s) *)
@@ -343,6 +478,15 @@ let migrate
      type_declaration      : type_declaration1;
      type_extension        : type_extension1;
      extension_constructor : extension_constructor1;
+     class_expr            : class_expr1;
+     class_field           : class_field1;
+     class_type            : class_type1;
+     class_signature       : class_signature1;
+     class_type_field      : class_type_field1;
+     module_expr           : module_expr1;
+     module_type           : module_type1;
+     signature_item        : signature_item1;
+     structure_item        : structure_item1;
 (*$*)
      > ocaml_version)
     ((module B) : <
@@ -357,6 +501,15 @@ let migrate
      type_declaration      : type_declaration2;
      type_extension        : type_extension2;
      extension_constructor : extension_constructor2;
+     class_expr            : class_expr2;
+     class_field           : class_field2;
+     class_type            : class_type2;
+     class_signature       : class_signature2;
+     class_type_field      : class_type_field2;
+     module_expr           : module_expr2;
+     module_type           : module_type2;
+     signature_item        : signature_item2;
+     structure_item        : structure_item2;
 (*$*)
      > ocaml_version)
   : (A.types, B.types) migration_functions
@@ -392,6 +545,15 @@ module Convert (A : OCaml_version) (B : OCaml_version) = struct
     copy_type_declaration;
     copy_type_extension;
     copy_extension_constructor;
+    copy_class_expr;
+    copy_class_field;
+    copy_class_type;
+    copy_class_signature;
+    copy_class_type_field;
+    copy_module_expr;
+    copy_module_type;
+    copy_signature_item;
+    copy_structure_item;
 (*$*)
   } : (A.types, B.types) migration_functions =
     migrate (module A) (module B)
diff --git a/ast/versions.mli b/ast/versions.mli
index 83b2ea78f..782c0a856 100644
--- a/ast/versions.mli
+++ b/ast/versions.mli
@@ -37,6 +37,15 @@ module type Ast = sig
     type type_declaration
     type type_extension
     type extension_constructor
+    type class_expr
+    type class_field
+    type class_type
+    type class_signature
+    type class_type_field
+    type module_expr
+    type module_type
+    type signature_item
+    type structure_item
   end
 (*$*)
   module Config : sig
@@ -60,6 +69,15 @@ type 'a _types = 'a constraint 'a
     type_declaration      : _;
     type_extension        : _;
     extension_constructor : _;
+    class_expr            : _;
+    class_field           : _;
+    class_type            : _;
+    class_signature       : _;
+    class_type_field      : _;
+    module_expr           : _;
+    module_type           : _;
+    signature_item        : _;
+    structure_item        : _;
 (*$*)
   >
 ;;
@@ -98,6 +116,15 @@ module type OCaml_version = sig
     type_declaration      : Ast.Parsetree.type_declaration;
     type_extension        : Ast.Parsetree.type_extension;
     extension_constructor : Ast.Parsetree.extension_constructor;
+    class_expr            : Ast.Parsetree.class_expr;
+    class_field           : Ast.Parsetree.class_field;
+    class_type            : Ast.Parsetree.class_type;
+    class_signature       : Ast.Parsetree.class_signature;
+    class_type_field      : Ast.Parsetree.class_type_field;
+    module_expr           : Ast.Parsetree.module_expr;
+    module_type           : Ast.Parsetree.module_type;
+    signature_item        : Ast.Parsetree.signature_item;
+    structure_item        : Ast.Parsetree.structure_item;
 (*$*)
   > _types
 
@@ -155,6 +182,15 @@ module Convert (A : OCaml_version) (B : OCaml_version) : sig
   val copy_type_declaration      : A.Ast.Parsetree.type_declaration      -> B.Ast.Parsetree.type_declaration
   val copy_type_extension        : A.Ast.Parsetree.type_extension        -> B.Ast.Parsetree.type_extension
   val copy_extension_constructor : A.Ast.Parsetree.extension_constructor -> B.Ast.Parsetree.extension_constructor
+  val copy_class_expr            : A.Ast.Parsetree.class_expr            -> B.Ast.Parsetree.class_expr
+  val copy_class_field           : A.Ast.Parsetree.class_field           -> B.Ast.Parsetree.class_field
+  val copy_class_type            : A.Ast.Parsetree.class_type            -> B.Ast.Parsetree.class_type
+  val copy_class_signature       : A.Ast.Parsetree.class_signature       -> B.Ast.Parsetree.class_signature
+  val copy_class_type_field      : A.Ast.Parsetree.class_type_field      -> B.Ast.Parsetree.class_type_field
+  val copy_module_expr           : A.Ast.Parsetree.module_expr           -> B.Ast.Parsetree.module_expr
+  val copy_module_type           : A.Ast.Parsetree.module_type           -> B.Ast.Parsetree.module_type
+  val copy_signature_item        : A.Ast.Parsetree.signature_item        -> B.Ast.Parsetree.signature_item
+  val copy_structure_item        : A.Ast.Parsetree.structure_item        -> B.Ast.Parsetree.structure_item
 (*$*)
 end
 
diff --git a/astlib/cinaps/astlib_cinaps_helpers.ml b/astlib/cinaps/astlib_cinaps_helpers.ml
index 550c84021..7760b4fd8 100644
--- a/astlib/cinaps/astlib_cinaps_helpers.ml
+++ b/astlib/cinaps/astlib_cinaps_helpers.ml
@@ -37,3 +37,37 @@ let foreach_version_pair f =
     | [ _ ] | [] -> ()
   in
   aux supported_versions
+
+(* Just for 4.14 <-> 5.00, mostly used by [ast_cinaps_helpers] *)
+
+let qualified_types =
+  [
+    ( "Parsetree",
+      [
+        "structure";
+        "signature";
+        "toplevel_phrase";
+        "core_type";
+        "expression";
+        "pattern";
+        "case";
+        "type_declaration";
+        "type_extension";
+        "extension_constructor";
+        "class_expr";
+        "class_field";
+        "class_type";
+        "class_signature";
+        "class_type_field";
+        "module_expr";
+        "module_type";
+        "signature_item";
+        "structure_item";
+      ] );
+  ]
+
+let foreach_module f =
+  nl ();
+  List.iter qualified_types ~f:(fun (m, types) -> f m types)
+
+let foreach_type f = foreach_module (fun m -> List.iter ~f:(f m))
diff --git a/astlib/migrate_414_500.ml b/astlib/migrate_414_500.ml
index 6a81b0736..084692807 100644
--- a/astlib/migrate_414_500.ml
+++ b/astlib/migrate_414_500.ml
@@ -1,40 +1,90 @@
 module From = Ast_414
 module To = Ast_500
 
-let copy_structure : Ast_414.Parsetree.structure -> Ast_500.Parsetree.structure
-    =
- fun x -> x
+(*$ open Astlib_cinaps_helpers $*)
 
-let copy_signature : Ast_414.Parsetree.signature -> Ast_500.Parsetree.signature
-    =
- fun x -> x
+(*$ foreach_type (fun _ s ->
+      Printf.printf
+        "let copy_%s\n\
+        \  : Ast_414.Parsetree.%s -> Ast_500.Parsetree.%s\n\
+        \  = fun x -> x\n\n"
+        s s s
+  )
+*)
+let copy_structure
+  : Ast_414.Parsetree.structure -> Ast_500.Parsetree.structure
+  = fun x -> x
 
-let copy_toplevel_phrase :
-    Ast_414.Parsetree.toplevel_phrase -> Ast_500.Parsetree.toplevel_phrase =
- fun x -> x
+let copy_signature
+  : Ast_414.Parsetree.signature -> Ast_500.Parsetree.signature
+  = fun x -> x
 
-let copy_core_type : Ast_414.Parsetree.core_type -> Ast_500.Parsetree.core_type
-    =
- fun x -> x
+let copy_toplevel_phrase
+  : Ast_414.Parsetree.toplevel_phrase -> Ast_500.Parsetree.toplevel_phrase
+  = fun x -> x
 
-let copy_expression :
-    Ast_414.Parsetree.expression -> Ast_500.Parsetree.expression =
- fun x -> x
+let copy_core_type
+  : Ast_414.Parsetree.core_type -> Ast_500.Parsetree.core_type
+  = fun x -> x
 
-let copy_pattern : Ast_414.Parsetree.pattern -> Ast_500.Parsetree.pattern =
- fun x -> x
+let copy_expression
+  : Ast_414.Parsetree.expression -> Ast_500.Parsetree.expression
+  = fun x -> x
 
-let copy_case : Ast_414.Parsetree.case -> Ast_500.Parsetree.case = fun x -> x
+let copy_pattern
+  : Ast_414.Parsetree.pattern -> Ast_500.Parsetree.pattern
+  = fun x -> x
 
-let copy_type_declaration :
-    Ast_414.Parsetree.type_declaration -> Ast_500.Parsetree.type_declaration =
- fun x -> x
+let copy_case
+  : Ast_414.Parsetree.case -> Ast_500.Parsetree.case
+  = fun x -> x
 
-let copy_type_extension :
-    Ast_414.Parsetree.type_extension -> Ast_500.Parsetree.type_extension =
- fun x -> x
+let copy_type_declaration
+  : Ast_414.Parsetree.type_declaration -> Ast_500.Parsetree.type_declaration
+  = fun x -> x
 
-let copy_extension_constructor :
-    Ast_414.Parsetree.extension_constructor ->
-    Ast_500.Parsetree.extension_constructor =
- fun x -> x
+let copy_type_extension
+  : Ast_414.Parsetree.type_extension -> Ast_500.Parsetree.type_extension
+  = fun x -> x
+
+let copy_extension_constructor
+  : Ast_414.Parsetree.extension_constructor -> Ast_500.Parsetree.extension_constructor
+  = fun x -> x
+
+let copy_class_expr
+  : Ast_414.Parsetree.class_expr -> Ast_500.Parsetree.class_expr
+  = fun x -> x
+
+let copy_class_field
+  : Ast_414.Parsetree.class_field -> Ast_500.Parsetree.class_field
+  = fun x -> x
+
+let copy_class_type
+  : Ast_414.Parsetree.class_type -> Ast_500.Parsetree.class_type
+  = fun x -> x
+
+let copy_class_signature
+  : Ast_414.Parsetree.class_signature -> Ast_500.Parsetree.class_signature
+  = fun x -> x
+
+let copy_class_type_field
+  : Ast_414.Parsetree.class_type_field -> Ast_500.Parsetree.class_type_field
+  = fun x -> x
+
+let copy_module_expr
+  : Ast_414.Parsetree.module_expr -> Ast_500.Parsetree.module_expr
+  = fun x -> x
+
+let copy_module_type
+  : Ast_414.Parsetree.module_type -> Ast_500.Parsetree.module_type
+  = fun x -> x
+
+let copy_signature_item
+  : Ast_414.Parsetree.signature_item -> Ast_500.Parsetree.signature_item
+  = fun x -> x
+
+let copy_structure_item
+  : Ast_414.Parsetree.structure_item -> Ast_500.Parsetree.structure_item
+  = fun x -> x
+
+(*$*)
diff --git a/astlib/migrate_500_414.ml b/astlib/migrate_500_414.ml
index ac0f27bdc..6b625e209 100644
--- a/astlib/migrate_500_414.ml
+++ b/astlib/migrate_500_414.ml
@@ -1,40 +1,90 @@
 module From = Ast_500
 module To = Ast_414
 
-let copy_structure : Ast_500.Parsetree.structure -> Ast_414.Parsetree.structure
-    =
- fun x -> x
+(*$ open Astlib_cinaps_helpers $*)
 
-let copy_signature : Ast_500.Parsetree.signature -> Ast_414.Parsetree.signature
-    =
- fun x -> x
+(*$ foreach_type (fun _ s ->
+      Printf.printf
+        "let copy_%s\n\
+        \  : Ast_500.Parsetree.%s -> Ast_414.Parsetree.%s\n\
+        \  = fun x -> x\n\n"
+        s s s
+  )
+*)
+let copy_structure
+  : Ast_500.Parsetree.structure -> Ast_414.Parsetree.structure
+  = fun x -> x
 
-let copy_toplevel_phrase :
-    Ast_500.Parsetree.toplevel_phrase -> Ast_414.Parsetree.toplevel_phrase =
- fun x -> x
+let copy_signature
+  : Ast_500.Parsetree.signature -> Ast_414.Parsetree.signature
+  = fun x -> x
 
-let copy_core_type : Ast_500.Parsetree.core_type -> Ast_414.Parsetree.core_type
-    =
- fun x -> x
+let copy_toplevel_phrase
+  : Ast_500.Parsetree.toplevel_phrase -> Ast_414.Parsetree.toplevel_phrase
+  = fun x -> x
 
-let copy_expression :
-    Ast_500.Parsetree.expression -> Ast_414.Parsetree.expression =
- fun x -> x
+let copy_core_type
+  : Ast_500.Parsetree.core_type -> Ast_414.Parsetree.core_type
+  = fun x -> x
 
-let copy_pattern : Ast_500.Parsetree.pattern -> Ast_414.Parsetree.pattern =
- fun x -> x
+let copy_expression
+  : Ast_500.Parsetree.expression -> Ast_414.Parsetree.expression
+  = fun x -> x
 
-let copy_case : Ast_500.Parsetree.case -> Ast_414.Parsetree.case = fun x -> x
+let copy_pattern
+  : Ast_500.Parsetree.pattern -> Ast_414.Parsetree.pattern
+  = fun x -> x
 
-let copy_type_declaration :
-    Ast_500.Parsetree.type_declaration -> Ast_414.Parsetree.type_declaration =
- fun x -> x
+let copy_case
+  : Ast_500.Parsetree.case -> Ast_414.Parsetree.case
+  = fun x -> x
 
-let copy_type_extension :
-    Ast_500.Parsetree.type_extension -> Ast_414.Parsetree.type_extension =
- fun x -> x
+let copy_type_declaration
+  : Ast_500.Parsetree.type_declaration -> Ast_414.Parsetree.type_declaration
+  = fun x -> x
 
-let copy_extension_constructor :
-    Ast_500.Parsetree.extension_constructor ->
-    Ast_414.Parsetree.extension_constructor =
- fun x -> x
+let copy_type_extension
+  : Ast_500.Parsetree.type_extension -> Ast_414.Parsetree.type_extension
+  = fun x -> x
+
+let copy_extension_constructor
+  : Ast_500.Parsetree.extension_constructor -> Ast_414.Parsetree.extension_constructor
+  = fun x -> x
+
+let copy_class_expr
+  : Ast_500.Parsetree.class_expr -> Ast_414.Parsetree.class_expr
+  = fun x -> x
+
+let copy_class_field
+  : Ast_500.Parsetree.class_field -> Ast_414.Parsetree.class_field
+  = fun x -> x
+
+let copy_class_type
+  : Ast_500.Parsetree.class_type -> Ast_414.Parsetree.class_type
+  = fun x -> x
+
+let copy_class_signature
+  : Ast_500.Parsetree.class_signature -> Ast_414.Parsetree.class_signature
+  = fun x -> x
+
+let copy_class_type_field
+  : Ast_500.Parsetree.class_type_field -> Ast_414.Parsetree.class_type_field
+  = fun x -> x
+
+let copy_module_expr
+  : Ast_500.Parsetree.module_expr -> Ast_414.Parsetree.module_expr
+  = fun x -> x
+
+let copy_module_type
+  : Ast_500.Parsetree.module_type -> Ast_414.Parsetree.module_type
+  = fun x -> x
+
+let copy_signature_item
+  : Ast_500.Parsetree.signature_item -> Ast_414.Parsetree.signature_item
+  = fun x -> x
+
+let copy_structure_item
+  : Ast_500.Parsetree.structure_item -> Ast_414.Parsetree.structure_item
+  = fun x -> x
+
+(*$*)

From e748f504db1ed849771d7736d991444e99688412 Mon Sep 17 00:00:00 2001
From: Antal Spector-Zabusky <antal.b.sz@gmail.com>
Date: Thu, 10 Aug 2023 17:28:09 -0400
Subject: [PATCH 02/31] Formatting

Signed-off-by: Antal Spector-Zabusky <antal.b.sz@gmail.com>
---
 .ocamlformat-ignore              | 5 ++++-
 ast/cinaps/ast_cinaps_helpers.ml | 1 -
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/.ocamlformat-ignore b/.ocamlformat-ignore
index 64cd1004a..1e7f6979a 100644
--- a/.ocamlformat-ignore
+++ b/.ocamlformat-ignore
@@ -18,10 +18,13 @@ astlib/ast_413.ml
 astlib/ast_414.ml
 astlib/ast_501.ml
 
-# Files that use cinaps to generate bode blocks from other code blocks work well,
+# Files that use cinaps to generate code blocks from other code blocks work well,
 # but files that inject freely formatted code via cinaps must be excluded
 ast/versions.ml
 ast/versions.mli
+ast/import.ml
+astlib/migrate_414_500.ml
+astlib/migrate_500_414.ml
 
 # Currently our expect-test lexer is too strict for our expect tests to
 # work well with ocamlformat
diff --git a/ast/cinaps/ast_cinaps_helpers.ml b/ast/cinaps/ast_cinaps_helpers.ml
index f1d9a0882..daad29607 100644
--- a/ast/cinaps/ast_cinaps_helpers.ml
+++ b/ast/cinaps/ast_cinaps_helpers.ml
@@ -7,7 +7,6 @@ let nl = Astlib_cinaps_helpers.nl
 let qualified_types = Astlib_cinaps_helpers.qualified_types
 let foreach_module = Astlib_cinaps_helpers.foreach_module
 let foreach_type = Astlib_cinaps_helpers.foreach_type
-
 let all_types = List.concat (List.map ~f:snd qualified_types)
 
 let foreach_version f =

From 95baecb29a89478d3b48b8ea22cdcf032f45be17 Mon Sep 17 00:00:00 2001
From: Antal Spector-Zabusky <antal.b.sz@gmail.com>
Date: Thu, 10 Aug 2023 17:30:28 -0400
Subject: [PATCH 03/31] Support versions below 4.05

Signed-off-by: Antal Spector-Zabusky <antal.b.sz@gmail.com>
---
 ast/cinaps/ast_cinaps_helpers.ml | 3 +++
 ast/cinaps/dune                  | 2 +-
 ast/import.ml                    | 6 +++---
 3 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/ast/cinaps/ast_cinaps_helpers.ml b/ast/cinaps/ast_cinaps_helpers.ml
index daad29607..ce120a969 100644
--- a/ast/cinaps/ast_cinaps_helpers.ml
+++ b/ast/cinaps/ast_cinaps_helpers.ml
@@ -3,6 +3,9 @@
 include StdLabels
 include Printf
 
+let capitalize_ascii = Stdppx.String.capitalize_ascii
+
+(* Reexports from [Astlib_cinaps_helpers] *)
 let nl = Astlib_cinaps_helpers.nl
 let qualified_types = Astlib_cinaps_helpers.qualified_types
 let foreach_module = Astlib_cinaps_helpers.foreach_module
diff --git a/ast/cinaps/dune b/ast/cinaps/dune
index b40d6d415..4ece19d35 100644
--- a/ast/cinaps/dune
+++ b/ast/cinaps/dune
@@ -1,3 +1,3 @@
 (library
  (name ast_cinaps_helpers)
- (libraries supported_version astlib_cinaps_helpers))
+ (libraries stdppx supported_version astlib_cinaps_helpers))
diff --git a/ast/import.ml b/ast/import.ml
index 915535809..57168b7fd 100644
--- a/ast/import.ml
+++ b/ast/import.ml
@@ -20,7 +20,7 @@ module Select_ast (Ocaml : Versions.OCaml_version) = struct
               \          : ( Js.Ast.Parsetree.%s,\n\
               \              Ocaml.Ast.Parsetree.%s )\n\
               \            t\n"
-              (String.capitalize_ascii s) s s
+              (capitalize_ascii s) s s
           )
       *)
       | Structure
@@ -115,7 +115,7 @@ module Select_ast (Ocaml : Versions.OCaml_version) = struct
       (*$ foreach_type (fun _ s ->
             printf
               "      | %s -> copy_%s\n"
-              (String.capitalize_ascii s) s
+              (capitalize_ascii s) s
           )
       *)
       | Structure -> copy_structure
@@ -151,7 +151,7 @@ module Select_ast (Ocaml : Versions.OCaml_version) = struct
       (*$ foreach_type (fun _ s ->
             printf
               "      | %s -> copy_%s\n"
-              (String.capitalize_ascii s) s
+              (capitalize_ascii s) s
           )
       *)
       | Structure -> copy_structure

From d1442b0be9f31f922e3aced222006fa96c13d0ff Mon Sep 17 00:00:00 2001
From: Nick Roberts <nroberts@janestreet.com>
Date: Fri, 30 Jun 2023 16:31:10 -0400
Subject: [PATCH 04/31] Preserve quoted attributes on antiquoted constructs

Signed-off-by: Nick Roberts <nroberts@janestreet.com>
---
 metaquot/dune               |   2 +-
 metaquot/ppxlib_metaquot.ml | 134 ++++++++++++++++++--
 test/metaquot/test.ml       | 243 ++++++++++++++++++++++++++++++++++++
 test/metaquot/test_510.ml   | 243 ++++++++++++++++++++++++++++++++++++
 4 files changed, 608 insertions(+), 14 deletions(-)

diff --git a/metaquot/dune b/metaquot/dune
index a85cfb2db..dc1169ce6 100644
--- a/metaquot/dune
+++ b/metaquot/dune
@@ -4,5 +4,5 @@
  (kind ppx_rewriter)
  (flags
   (:standard -safe-string))
- (libraries ppxlib ppxlib_traverse_builtins ppxlib_metaquot_lifters)
+ (libraries astlib ppxlib ppxlib_traverse_builtins ppxlib_metaquot_lifters)
  (ppx_runtime_libraries ppxlib_ast))
diff --git a/metaquot/ppxlib_metaquot.ml b/metaquot/ppxlib_metaquot.ml
index dac00dd60..de0a395cf 100644
--- a/metaquot/ppxlib_metaquot.ml
+++ b/metaquot/ppxlib_metaquot.ml
@@ -3,11 +3,26 @@ open Ast_builder.Default
 module E = Extension
 module A = Ast_pattern
 
+type quoted_attributes =
+  { quoted_attributes : attributes
+  (* The attributes that appear quoted, e.g. [@foo] in [%expr [%e e] [@foo]] *)
+  ; field_name : string
+  (* The field name where attributes are stored for the kind of ASt the quoted attributes
+     are placed on, e.g. pexp_attributes. *)
+  }
+
 module Make (M : sig
   type result
 
   val annotate : result -> core_type -> result
-  val cast : extension -> result
+
+  val cast
+    :  < attributes : attributes -> result; .. >
+      (* The instance of the [std_lifters] class being used. *)
+    -> extension
+    -> quoted_attributes option
+    -> result
+
   val location : location -> result
   val location_stack : (location -> result) option
   val attributes : (location -> result) option
@@ -48,49 +63,75 @@ struct
       method! expression e =
         match e.pexp_desc with
         | Pexp_extension (({ txt = "e"; _ }, _) as ext) ->
-            self#typed (M.cast ext) "expression"
+            let attributes =
+              { quoted_attributes = e.pexp_attributes
+              ; field_name = "pexp_attributes"
+              }
+            in
+            self#typed (M.cast self ext (Some attributes)) "expression"
         | _ -> super#expression e
 
       method! pattern p =
         match p.ppat_desc with
         | Ppat_extension (({ txt = "p"; _ }, _) as ext) ->
-            self#typed (M.cast ext) "pattern"
+            let attributes =
+              { quoted_attributes = p.ppat_attributes
+              ; field_name = "ppat_attributes"
+              }
+            in
+            self#typed (M.cast self ext (Some attributes)) "pattern"
         | _ -> super#pattern p
 
       method! core_type t =
         match t.ptyp_desc with
         | Ptyp_extension (({ txt = "t"; _ }, _) as ext) ->
-            self#typed (M.cast ext) "core_type"
+            let attributes =
+              { quoted_attributes = t.ptyp_attributes
+              ; field_name = "ptyp_attributes"
+              }
+            in
+            self#typed (M.cast self ext (Some attributes)) "core_type"
         | _ -> super#core_type t
 
       method! module_expr m =
         match m.pmod_desc with
         | Pmod_extension (({ txt = "m"; _ }, _) as ext) ->
-            self#typed (M.cast ext) "module_expr"
+            let attributes =
+              { quoted_attributes = m.pmod_attributes
+              ; field_name = "pmod_attributes"
+              }
+            in
+            self#typed (M.cast self ext (Some attributes)) "module_expr"
         | _ -> super#module_expr m
 
       method! module_type m =
         match m.pmty_desc with
         | Pmty_extension (({ txt = "m"; _ }, _) as ext) ->
-            self#typed (M.cast ext) "module_type"
+            let attributes =
+              { quoted_attributes = m.pmty_attributes
+              ; field_name = "pmty_attributes"
+              }
+            in
+            self#typed (M.cast self ext (Some attributes)) "module_type"
         | _ -> super#module_type m
 
       method! structure_item i =
         match i.pstr_desc with
         | Pstr_extension ((({ txt = "i"; _ }, _) as ext), attrs) ->
             assert_no_attributes attrs;
-            self#typed (M.cast ext) "structure_item"
+            self#typed (M.cast self ext None) "structure_item"
         | _ -> super#structure_item i
 
       method! signature_item i =
         match i.psig_desc with
         | Psig_extension ((({ txt = "i"; _ }, _) as ext), attrs) ->
             assert_no_attributes attrs;
-            self#typed (M.cast ext) "signature_item"
+            self#typed (M.cast self ext None) "signature_item"
         | _ -> super#signature_item i
     end
 end
 
+
 module Expr = Make (struct
   type result = expression
 
@@ -102,11 +143,66 @@ module Expr = Make (struct
 
   let annotate e core_type = pexp_constraint ~loc:core_type.ptyp_loc e core_type
 
-  let cast ext =
+  let fresh_name =
+    let counter = ref 0 in
+    fun () ->
+      let var = "_ppx_metaquot_helper_var%d" ^ Int.to_string !counter in
+      incr counter;
+      var
+
+  (* Append the quoted attributes to the attributes present on the
+     antiquoted construct. Take this as example:
+
+     [%expr [%e e] [@attr]]
+
+     Suppose e has pexp_attributes = [attr1]. Then the resulting attributes
+     are [ attr1; [@attr] ]. The decision to put outer attributes (here,
+     [@attr]) at the end of the list is consistent with other parts of ppxlib
+     that accumulate attributes.
+  *)
+  let add_quoted_attributes self e { quoted_attributes; field_name } ~loc =
+    match quoted_attributes with
+    | [] -> e
+    | _ :: _ ->
+      let open Ppxlib_ast.Ast_helper in
+      let loc = { loc with loc_ghost = true } in
+      let mkloc x = Located.mk x ~loc in
+      let var = fresh_name () in
+      let var_expr = Exp.ident (mkloc (Lident var)) in
+      let field_name = mkloc (Lident field_name) in
+      let reified_attrs = self#attributes quoted_attributes in
+      (* append arg1 arg2 = [%expr Stdlib.List.append [%e arg1] [%e arg2]] *)
+      let append arg1 arg2 =
+        Exp.apply
+          (Exp.ident
+             (mkloc (Ldot (Ldot (Lident "Stdlib", "List"), "append"))))
+          [ Nolabel, arg1; Nolabel, arg2 ]
+      in
+      (* [%expr
+         let [%p var] = [%e e] in
+         { [%e var] with field_name =
+         [%e append [%expr [%e var].field_name] reified_attrs]
+         ]
+
+         This comment lies a little bit: field_name is actually some other
+         literal string.
+      *)
+      Exp.let_
+        Nonrecursive
+        [ Vb.mk (Pat.var (mkloc var)) e ]
+        (Exp.record
+           [ field_name, append (Exp.field var_expr field_name) reified_attrs ]
+           (Some var_expr))
+
+  let cast self ext attrs =
     match snd ext with
-    | PStr [ { pstr_desc = Pstr_eval (e, attrs); _ } ] ->
-        assert_no_attributes attrs;
-        e
+    | PStr [ { pstr_desc = Pstr_eval (e, inner_attrs); _ } ] ->
+      assert_no_attributes inner_attrs;
+      (match attrs with
+       | None -> e
+       | Some quoted_attrs ->
+         add_quoted_attributes self e quoted_attrs
+           ~loc:(loc_of_extension ext))
     | _ ->
         Ast_builder.Default.(
           pexp_extension ~loc:(loc_of_extension ext)
@@ -128,7 +224,19 @@ module Patt = Make (struct
 
   let annotate p core_type = ppat_constraint ~loc:core_type.ptyp_loc p core_type
 
-  let cast ext =
+  let cast _ ext attrs =
+    begin
+      match attrs with
+      | None -> ()
+      | Some { quoted_attributes; field_name = _ } ->
+          (* In theory, we could create a pattern where [quoted_attributes]
+             is consed to the front of [p.ppat_attributes]. But this is
+             inconsistent with [Expression.add_quoted_attributes], which appends
+             quoted attributes to the end -- and this wouldn't be a legal
+             pattern.
+          *)
+          assert_no_attributes quoted_attributes
+    end;
     match snd ext with
     | PPat (p, None) -> p
     | PPat (_, Some e) ->
diff --git a/test/metaquot/test.ml b/test/metaquot/test.ml
index 148ab4ade..b56d98e5d 100644
--- a/test/metaquot/test.ml
+++ b/test/metaquot/test.ml
@@ -292,6 +292,243 @@ let _ = [%sig: include S]
     loc_ghost = true}}]
 |}]
 
+(* attributes *)
+
+let _ =
+  let e = [%expr (() [@attr1])] in
+  [%expr [%e e] [@attr2]].pexp_attributes
+[%%expect{|
+- : Ppxlib_ast.Ast.attributes =
+[{Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr1";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}};
+ {Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr2";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}}]
+|}]
+
+let _ =
+  let p = [%pat? (() [@attr1])] in
+  [%pat? [%p p] [@attr2]].ppat_attributes
+[%%expect{|
+- : Ppxlib_ast.Ast.attributes =
+[{Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr1";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}};
+ {Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr2";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}}]
+|}]
+
+let _ =
+  let t = [%type: (unit [@attr1])] in
+  [%type: [%t t] [@attr2]].ptyp_attributes
+[%%expect{|
+- : Ppxlib_ast.Ast.attributes =
+[{Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr1";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}};
+ {Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr2";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}}]
+|}]
+
+let _ =
+  let extract_module_M m =
+    match m with
+    | [%stri module M = [%m? m]] -> m
+    | _ -> assert false
+  in
+  let m = extract_module_M [%stri module M = (struct end [@attr1])] in
+  (extract_module_M [%stri module M = [%m m] [@attr2]]).pmod_attributes
+[%%expect{|
+- : Ppxlib_ast.Ast.attributes =
+[{Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr1";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}};
+ {Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr2";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}}]
+|}]
+
+let _ =
+  let extract_module_ty_S s =
+    match s with
+    | [%stri module type S = [%m? s]] -> s
+    | _ -> assert false
+  in
+  let s = extract_module_ty_S [%stri module type S = (sig end [@attr1])] in
+  (extract_module_ty_S [%stri module type S = [%m s] [@attr2]]).pmty_attributes
+[%%expect{|
+- : Ppxlib_ast.Ast.attributes =
+[{Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr1";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}};
+ {Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr2";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}}]
+|}]
+
 (* mistyped escapes (not producing ASTs at all) *)
 
 let _ = [%expr [%e ()]]
@@ -328,3 +565,9 @@ Line _, characters 21-23:
 Error: This expression should not be a unit literal, the expected type is
        Ppxlib_ast.Ast.signature_item
 |}]
+
+let _ = [%expr [%e ()] [@attr]]
+[%%expect{|
+Line _:
+Error: This expression has type unit which is not a record type.
+|}]
diff --git a/test/metaquot/test_510.ml b/test/metaquot/test_510.ml
index a4cae3339..949876c41 100644
--- a/test/metaquot/test_510.ml
+++ b/test/metaquot/test_510.ml
@@ -292,6 +292,243 @@ let _ = [%sig: include S]
     loc_ghost = true}}]
 |}]
 
+(* attributes *)
+
+let _ =
+  let e = [%expr (() [@attr1])] in
+  [%expr [%e e] [@attr2]].pexp_attributes
+[%%expect{|
+- : Ppxlib_ast.Ast.attributes =
+[{Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr1";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}};
+ {Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr2";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}}]
+|}]
+
+let _ =
+  let p = [%pat? (() [@attr1])] in
+  [%pat? [%p p] [@attr2]].ppat_attributes
+[%%expect{|
+- : Ppxlib_ast.Ast.attributes =
+[{Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr1";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}};
+ {Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr2";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}}]
+|}]
+
+let _ =
+  let t = [%type: (unit [@attr1])] in
+  [%type: [%t t] [@attr2]].ptyp_attributes
+[%%expect{|
+- : Ppxlib_ast.Ast.attributes =
+[{Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr1";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}};
+ {Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr2";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}}]
+|}]
+
+let _ =
+  let extract_module_M m =
+    match m with
+    | [%stri module M = [%m? m]] -> m
+    | _ -> assert false
+  in
+  let m = extract_module_M [%stri module M = (struct end [@attr1])] in
+  (extract_module_M [%stri module M = [%m m] [@attr2]]).pmod_attributes
+[%%expect{|
+- : Ppxlib_ast.Ast.attributes =
+[{Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr1";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}};
+ {Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr2";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}}]
+|}]
+
+let _ =
+  let extract_module_ty_S s =
+    match s with
+    | [%stri module type S = [%m? s]] -> s
+    | _ -> assert false
+  in
+  let s = extract_module_ty_S [%stri module type S = (sig end [@attr1])] in
+  (extract_module_ty_S [%stri module type S = [%m s] [@attr2]]).pmty_attributes
+[%%expect{|
+- : Ppxlib_ast.Ast.attributes =
+[{Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr1";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}};
+ {Ppxlib_ast.Ast.attr_name =
+   {Ppxlib_ast.Ast.txt = "attr2";
+    loc =
+     {Ppxlib_ast.Ast.loc_start =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_end =
+       {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+        pos_cnum = -1};
+      loc_ghost = true}};
+  attr_payload = Ppxlib_ast.Ast.PStr [];
+  attr_loc =
+   {Ppxlib_ast.Ast.loc_start =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_end =
+     {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0;
+      pos_cnum = -1};
+    loc_ghost = true}}]
+|}]
+
 (* mistyped escapes (not producing ASTs at all) *)
 
 let _ = [%expr [%e ()]]
@@ -332,3 +569,9 @@ Line _, characters 21-23:
 Error: This expression should not be a unit literal, the expected type is
        Ppxlib_ast.Ast.signature_item
 |}]
+
+let _ = [%expr [%e ()] [@attr]]
+[%%expect{|
+Line _:
+Error: This expression has type unit which is not a record type.
+|}]

From 19b61b269c089e79ab81d48f1a1c1cc35ccff639 Mon Sep 17 00:00:00 2001
From: Nick Roberts <nroberts@janestreet.com>
Date: Fri, 30 Jun 2023 17:59:40 -0400
Subject: [PATCH 05/31] Use more idiomatic Ast_builder, fix formatting,
 annotate types better

Signed-off-by: Nick Roberts <nroberts@janestreet.com>
---
 metaquot/ppxlib_metaquot.ml | 184 +++++++++++++++++++-----------------
 test/metaquot/test.ml       |  35 ++++++-
 test/metaquot/test_510.ml   |  37 ++++++++
 3 files changed, 169 insertions(+), 87 deletions(-)

diff --git a/metaquot/ppxlib_metaquot.ml b/metaquot/ppxlib_metaquot.ml
index de0a395cf..3c3e17a94 100644
--- a/metaquot/ppxlib_metaquot.ml
+++ b/metaquot/ppxlib_metaquot.ml
@@ -3,25 +3,32 @@ open Ast_builder.Default
 module E = Extension
 module A = Ast_pattern
 
-type quoted_attributes =
-  { quoted_attributes : attributes
-  (* The attributes that appear quoted, e.g. [@foo] in [%expr [%e e] [@foo]] *)
-  ; field_name : string
-  (* The field name where attributes are stored for the kind of ASt the quoted attributes
-     are placed on, e.g. pexp_attributes. *)
-  }
+type quoted_attributes = {
+  quoted_attributes : attributes;
+      (* The attributes that appear quoted, e.g. [@foo] in [%expr [%e e] [@foo]] *)
+  field_name : string;
+      (* The field name where attributes are stored for the kind of AST the quoted
+         attributes are placed on, e.g. pexp_attributes. *)
+}
 
 module Make (M : sig
   type result
 
   val annotate : result -> core_type -> result
 
-  val cast
-    :  < attributes : attributes -> result; .. >
-      (* The instance of the [std_lifters] class being used. *)
-    -> extension
-    -> quoted_attributes option
-    -> result
+  val cast :
+    (* The instance of the [std_lifters] class being used. *)
+    < attributes : attributes -> result
+    ; typed : result -> string -> result
+    ; .. > ->
+    extension ->
+    quoted_attributes option ->
+    (* e.g. [expression]; the callee is responsible for calling
+       [self#typed ast type_name] on the AST to add a type annotation
+       that constrains its type.
+    *)
+    type_name:string ->
+    result
 
   val location : location -> result
   val location_stack : (location -> result) option
@@ -64,74 +71,78 @@ struct
         match e.pexp_desc with
         | Pexp_extension (({ txt = "e"; _ }, _) as ext) ->
             let attributes =
-              { quoted_attributes = e.pexp_attributes
-              ; field_name = "pexp_attributes"
+              {
+                quoted_attributes = e.pexp_attributes;
+                field_name = "pexp_attributes";
               }
             in
-            self#typed (M.cast self ext (Some attributes)) "expression"
+            M.cast self ext (Some attributes) ~type_name:"expression"
         | _ -> super#expression e
 
       method! pattern p =
         match p.ppat_desc with
         | Ppat_extension (({ txt = "p"; _ }, _) as ext) ->
             let attributes =
-              { quoted_attributes = p.ppat_attributes
-              ; field_name = "ppat_attributes"
+              {
+                quoted_attributes = p.ppat_attributes;
+                field_name = "ppat_attributes";
               }
             in
-            self#typed (M.cast self ext (Some attributes)) "pattern"
+            M.cast self ext (Some attributes) ~type_name:"pattern"
         | _ -> super#pattern p
 
       method! core_type t =
         match t.ptyp_desc with
         | Ptyp_extension (({ txt = "t"; _ }, _) as ext) ->
             let attributes =
-              { quoted_attributes = t.ptyp_attributes
-              ; field_name = "ptyp_attributes"
+              {
+                quoted_attributes = t.ptyp_attributes;
+                field_name = "ptyp_attributes";
               }
             in
-            self#typed (M.cast self ext (Some attributes)) "core_type"
+            M.cast self ext (Some attributes) ~type_name:"core_type"
         | _ -> super#core_type t
 
       method! module_expr m =
         match m.pmod_desc with
         | Pmod_extension (({ txt = "m"; _ }, _) as ext) ->
             let attributes =
-              { quoted_attributes = m.pmod_attributes
-              ; field_name = "pmod_attributes"
+              {
+                quoted_attributes = m.pmod_attributes;
+                field_name = "pmod_attributes";
               }
             in
-            self#typed (M.cast self ext (Some attributes)) "module_expr"
+            M.cast self ext (Some attributes) ~type_name:"module_expr"
         | _ -> super#module_expr m
 
       method! module_type m =
         match m.pmty_desc with
         | Pmty_extension (({ txt = "m"; _ }, _) as ext) ->
             let attributes =
-              { quoted_attributes = m.pmty_attributes
-              ; field_name = "pmty_attributes"
+              {
+                quoted_attributes = m.pmty_attributes;
+                field_name = "pmty_attributes";
               }
             in
-            self#typed (M.cast self ext (Some attributes)) "module_type"
+            M.cast self ext (Some attributes) ~type_name:"module_type"
         | _ -> super#module_type m
 
       method! structure_item i =
         match i.pstr_desc with
         | Pstr_extension ((({ txt = "i"; _ }, _) as ext), attrs) ->
             assert_no_attributes attrs;
-            self#typed (M.cast self ext None) "structure_item"
+            M.cast self ext None ~type_name:"structure_item"
         | _ -> super#structure_item i
 
       method! signature_item i =
         match i.psig_desc with
         | Psig_extension ((({ txt = "i"; _ }, _) as ext), attrs) ->
             assert_no_attributes attrs;
-            self#typed (M.cast self ext None) "signature_item"
+            M.cast self ext None ~type_name:"signature_item"
         | _ -> super#signature_item i
     end
 end
 
-
 module Expr = Make (struct
   type result = expression
 
@@ -160,49 +171,55 @@ module Expr = Make (struct
      [@attr]) at the end of the list is consistent with other parts of ppxlib
      that accumulate attributes.
   *)
-  let add_quoted_attributes self e { quoted_attributes; field_name } ~loc =
+  let add_quoted_attributes self e { quoted_attributes; field_name } ~type_name
+      ~loc =
     match quoted_attributes with
-    | [] -> e
+    | [] -> self#typed e type_name
     | _ :: _ ->
-      let open Ppxlib_ast.Ast_helper in
-      let loc = { loc with loc_ghost = true } in
-      let mkloc x = Located.mk x ~loc in
-      let var = fresh_name () in
-      let var_expr = Exp.ident (mkloc (Lident var)) in
-      let field_name = mkloc (Lident field_name) in
-      let reified_attrs = self#attributes quoted_attributes in
-      (* append arg1 arg2 = [%expr Stdlib.List.append [%e arg1] [%e arg2]] *)
-      let append arg1 arg2 =
-        Exp.apply
-          (Exp.ident
-             (mkloc (Ldot (Ldot (Lident "Stdlib", "List"), "append"))))
-          [ Nolabel, arg1; Nolabel, arg2 ]
-      in
-      (* [%expr
-         let [%p var] = [%e e] in
-         { [%e var] with field_name =
-         [%e append [%expr [%e var].field_name] reified_attrs]
-         ]
-
-         This comment lies a little bit: field_name is actually some other
-         literal string.
-      *)
-      Exp.let_
-        Nonrecursive
-        [ Vb.mk (Pat.var (mkloc var)) e ]
-        (Exp.record
-           [ field_name, append (Exp.field var_expr field_name) reified_attrs ]
-           (Some var_expr))
-
-  let cast self ext attrs =
+        let loc = { loc with loc_ghost = true } in
+        let open (val Ast_builder.make loc) in
+        let var = fresh_name () in
+        let var_expr = pexp_ident (Located.mk (Lident var)) in
+        let field_name = Located.mk (Lident field_name) in
+        let reified_attrs = self#attributes quoted_attributes in
+        (* append arg1 arg2 = [%expr Stdlib.List.append [%e arg1] [%e arg2]] *)
+        let append arg1 arg2 =
+          pexp_apply
+            (pexp_ident
+               (Located.mk (Ldot (Ldot (Lident "Stdlib", "List"), "append"))))
+            [ (Nolabel, arg1); (Nolabel, arg2) ]
+        in
+        (*
+         Morally,
+         {[
+           let var = ([%expr e] : [%type: type_name]) in
+           { var
+             with pexp_attributes = var.pexp_attributes @ [%e reified_attrs ]
+           }
+         ]}
+        *)
+        pexp_let Nonrecursive
+          [
+            value_binding
+              ~pat:(ppat_var (Located.mk var))
+              ~expr:(self#typed e type_name);
+          ]
+          (pexp_record
+             [
+               ( field_name,
+                 append (pexp_field var_expr field_name) reified_attrs );
+             ]
+             (Some var_expr))
+
+  let cast self ext attrs ~type_name =
     match snd ext with
-    | PStr [ { pstr_desc = Pstr_eval (e, inner_attrs); _ } ] ->
-      assert_no_attributes inner_attrs;
-      (match attrs with
-       | None -> e
-       | Some quoted_attrs ->
-         add_quoted_attributes self e quoted_attrs
-           ~loc:(loc_of_extension ext))
+    | PStr [ { pstr_desc = Pstr_eval (e, inner_attrs); _ } ] -> (
+        assert_no_attributes inner_attrs;
+        match attrs with
+        | None -> self#typed e type_name
+        | Some quoted_attrs ->
+            add_quoted_attributes self e quoted_attrs ~type_name
+              ~loc:(loc_of_extension ext))
     | _ ->
         Ast_builder.Default.(
           pexp_extension ~loc:(loc_of_extension ext)
@@ -224,21 +241,18 @@ module Patt = Make (struct
 
   let annotate p core_type = ppat_constraint ~loc:core_type.ptyp_loc p core_type
 
-  let cast _ ext attrs =
-    begin
-      match attrs with
-      | None -> ()
-      | Some { quoted_attributes; field_name = _ } ->
-          (* In theory, we could create a pattern where [quoted_attributes]
-             is consed to the front of [p.ppat_attributes]. But this is
-             inconsistent with [Expression.add_quoted_attributes], which appends
-             quoted attributes to the end -- and this wouldn't be a legal
-             pattern.
-          *)
-          assert_no_attributes quoted_attributes
-    end;
+  let cast self ext attrs ~type_name =
     match snd ext with
-    | PPat (p, None) -> p
+    | PPat (p, None) ->
+      (match attrs with
+       | None -> ()
+       | Some { quoted_attributes; field_name = _ } ->
+         (* We can't construct a pattern that searches for [quoted_attributes]
+            at the end of [p]'s attribute list -- the pattern language isn't
+            expressive enough. Instead, we fail.
+         *)
+         assert_no_attributes quoted_attributes);
+      self#typed p type_name
     | PPat (_, Some e) ->
         Ast_builder.Default.(
           ppat_extension ~loc:e.pexp_loc
diff --git a/test/metaquot/test.ml b/test/metaquot/test.ml
index b56d98e5d..026e8dc2e 100644
--- a/test/metaquot/test.ml
+++ b/test/metaquot/test.ml
@@ -566,8 +566,39 @@ Error: This expression should not be a unit literal, the expected type is
        Ppxlib_ast.Ast.signature_item
 |}]
 
+(* mistyped escapes (not producing ASTs at all) with attributes *)
+
 let _ = [%expr [%e ()] [@attr]]
 [%%expect{|
-Line _:
-Error: This expression has type unit which is not a record type.
+Line _, characters 19-21:
+Error: This expression should not be a unit literal, the expected type is
+       Ppxlib_ast.Ast.expression
+|}]
+
+let _ = [%pat? [%p ()] [@attr]]
+[%%expect{|
+Line _, characters 19-21:
+Error: This expression should not be a unit literal, the expected type is
+       Ppxlib_ast.Ast.pattern
+|}]
+
+let _ = [%type: [%t ()] [@attr]]
+[%%expect{|
+Line _, characters 20-22:
+Error: This expression should not be a unit literal, the expected type is
+       Ppxlib_ast.Ast.core_type
+|}]
+
+let _ = [%stri module M = [%m ()] [@attr]]
+[%%expect{|
+Line _, characters 30-32:
+Error: This expression should not be a unit literal, the expected type is
+       Ppxlib_ast.Ast.module_expr
+|}]
+
+let _ = [%sigi: module type M = [%m ()] [@attr]]
+[%%expect{|
+Line _, characters 36-38:
+Error: This expression should not be a unit literal, the expected type is
+       Ppxlib_ast.Ast.module_type
 |}]
diff --git a/test/metaquot/test_510.ml b/test/metaquot/test_510.ml
index 949876c41..6382a965f 100644
--- a/test/metaquot/test_510.ml
+++ b/test/metaquot/test_510.ml
@@ -575,3 +575,40 @@ let _ = [%expr [%e ()] [@attr]]
 Line _:
 Error: This expression has type unit which is not a record type.
 |}]
+
+(* mistyped escapes (not producing ASTs at all) with attributes *)
+
+let _ = [%expr [%e ()] [@attr]]
+[%%expect{|
+Line _, characters 19-21:
+Error: This expression should not be a unit literal, the expected type is
+       Ppxlib_ast.Ast.expression
+|}]
+
+let _ = [%pat? [%p ()] [@attr]]
+[%%expect{|
+Line _, characters 19-21:
+Error: This expression should not be a unit literal, the expected type is
+       Ppxlib_ast.Ast.pattern
+|}]
+
+let _ = [%type: [%t ()] [@attr]]
+[%%expect{|
+Line _, characters 20-22:
+Error: This expression should not be a unit literal, the expected type is
+       Ppxlib_ast.Ast.core_type
+|}]
+
+let _ = [%stri module M = [%m ()] [@attr]]
+[%%expect{|
+Line _, characters 30-32:
+Error: This expression should not be a unit literal, the expected type is
+       Ppxlib_ast.Ast.module_expr
+|}]
+
+let _ = [%sigi: module type M = [%m ()] [@attr]]
+[%%expect{|
+Line _, characters 36-38:
+Error: This expression should not be a unit literal, the expected type is
+       Ppxlib_ast.Ast.module_type
+|}]

From 0e0b552103e00dab5d183bc97a59abbddb3c711b Mon Sep 17 00:00:00 2001
From: Nick Roberts <nroberts@janestreet.com>
Date: Mon, 3 Jul 2023 12:23:05 -0400
Subject: [PATCH 06/31] Fix formatting and 510 test

Signed-off-by: Nick Roberts <nroberts@janestreet.com>
---
 metaquot/ppxlib_metaquot.ml | 18 +++++++++---------
 test/metaquot/test_510.ml   | 11 +++++------
 2 files changed, 14 insertions(+), 15 deletions(-)

diff --git a/metaquot/ppxlib_metaquot.ml b/metaquot/ppxlib_metaquot.ml
index 3c3e17a94..a7ffe4fe9 100644
--- a/metaquot/ppxlib_metaquot.ml
+++ b/metaquot/ppxlib_metaquot.ml
@@ -244,15 +244,15 @@ module Patt = Make (struct
   let cast self ext attrs ~type_name =
     match snd ext with
     | PPat (p, None) ->
-      (match attrs with
-       | None -> ()
-       | Some { quoted_attributes; field_name = _ } ->
-         (* We can't construct a pattern that searches for [quoted_attributes]
-            at the end of [p]'s attribute list -- the pattern language isn't
-            expressive enough. Instead, we fail.
-         *)
-         assert_no_attributes quoted_attributes);
-      self#typed p type_name
+        (match attrs with
+        | None -> ()
+        | Some { quoted_attributes; field_name = _ } ->
+            (* We can't construct a pattern that searches for [quoted_attributes]
+               at the end of [p]'s attribute list -- the pattern language isn't
+               expressive enough. Instead, we fail.
+            *)
+            assert_no_attributes quoted_attributes);
+        self#typed p type_name
     | PPat (_, Some e) ->
         Ast_builder.Default.(
           ppat_extension ~loc:e.pexp_loc
diff --git a/test/metaquot/test_510.ml b/test/metaquot/test_510.ml
index 6382a965f..4b6e64d18 100644
--- a/test/metaquot/test_510.ml
+++ b/test/metaquot/test_510.ml
@@ -570,16 +570,11 @@ Error: This expression should not be a unit literal, the expected type is
        Ppxlib_ast.Ast.signature_item
 |}]
 
-let _ = [%expr [%e ()] [@attr]]
-[%%expect{|
-Line _:
-Error: This expression has type unit which is not a record type.
-|}]
-
 (* mistyped escapes (not producing ASTs at all) with attributes *)
 
 let _ = [%expr [%e ()] [@attr]]
 [%%expect{|
+
 Line _, characters 19-21:
 Error: This expression should not be a unit literal, the expected type is
        Ppxlib_ast.Ast.expression
@@ -587,6 +582,7 @@ Error: This expression should not be a unit literal, the expected type is
 
 let _ = [%pat? [%p ()] [@attr]]
 [%%expect{|
+
 Line _, characters 19-21:
 Error: This expression should not be a unit literal, the expected type is
        Ppxlib_ast.Ast.pattern
@@ -594,6 +590,7 @@ Error: This expression should not be a unit literal, the expected type is
 
 let _ = [%type: [%t ()] [@attr]]
 [%%expect{|
+
 Line _, characters 20-22:
 Error: This expression should not be a unit literal, the expected type is
        Ppxlib_ast.Ast.core_type
@@ -601,6 +598,7 @@ Error: This expression should not be a unit literal, the expected type is
 
 let _ = [%stri module M = [%m ()] [@attr]]
 [%%expect{|
+
 Line _, characters 30-32:
 Error: This expression should not be a unit literal, the expected type is
        Ppxlib_ast.Ast.module_expr
@@ -608,6 +606,7 @@ Error: This expression should not be a unit literal, the expected type is
 
 let _ = [%sigi: module type M = [%m ()] [@attr]]
 [%%expect{|
+
 Line _, characters 36-38:
 Error: This expression should not be a unit literal, the expected type is
        Ppxlib_ast.Ast.module_type

From 5acaab50cd98640b4689ea01934cf4beaec25ad2 Mon Sep 17 00:00:00 2001
From: Nick Roberts <nroberts@janestreet.com>
Date: Wed, 5 Jul 2023 09:39:05 -0400
Subject: [PATCH 07/31] Fix CI error for OCaml 4.04

Signed-off-by: Nick Roberts <nroberts@janestreet.com>
---
 metaquot/ppxlib_metaquot.ml | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/metaquot/ppxlib_metaquot.ml b/metaquot/ppxlib_metaquot.ml
index a7ffe4fe9..66f7eb6a3 100644
--- a/metaquot/ppxlib_metaquot.ml
+++ b/metaquot/ppxlib_metaquot.ml
@@ -157,7 +157,7 @@ module Expr = Make (struct
   let fresh_name =
     let counter = ref 0 in
     fun () ->
-      let var = "_ppx_metaquot_helper_var%d" ^ Int.to_string !counter in
+      let var = "_ppx_metaquot_helper_var%d" ^ string_of_int !counter in
       incr counter;
       var
 
@@ -177,7 +177,8 @@ module Expr = Make (struct
     | [] -> self#typed e type_name
     | _ :: _ ->
         let loc = { loc with loc_ghost = true } in
-        let open (val Ast_builder.make loc) in
+        let module Ast_builder_with_loc = (val Ast_builder.make loc) in
+        let open Ast_builder_with_loc in
         let var = fresh_name () in
         let var_expr = pexp_ident (Located.mk (Lident var)) in
         let field_name = Located.mk (Lident field_name) in

From 37ec811b2627f1e2e59c406572a171734c956042 Mon Sep 17 00:00:00 2001
From: Nick Roberts <nroberts@janestreet.com>
Date: Thu, 6 Jul 2023 09:48:58 -0400
Subject: [PATCH 08/31] Add Changes

Signed-off-by: Nick Roberts <nroberts@janestreet.com>
---
 CHANGES.md | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/CHANGES.md b/CHANGES.md
index d30021973..3186a4e24 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -9,6 +9,8 @@ unreleased
 
 - Expose migration/copying/etc. functions for all AST types needed by `Pprintast` (#454, @antalsz)
 
+- Preserve quoted attributes on antiquotes in metaquot (#441, @ncik-roberts)
+
 0.30.0 (20/06/2023)
 -------------------
 

From 63345cee62c0038b29e2874a1d9bfdd6c05e4458 Mon Sep 17 00:00:00 2001
From: Nick Roberts <nroberts@janestreet.com>
Date: Wed, 16 Aug 2023 17:26:50 -0400
Subject: [PATCH 09/31] Respond to review comments

Signed-off-by: Nick Roberts <nroberts@janestreet.com>
---
 metaquot/ppxlib_metaquot.ml | 39 ++++++++++++++-----------------------
 1 file changed, 15 insertions(+), 24 deletions(-)

diff --git a/metaquot/ppxlib_metaquot.ml b/metaquot/ppxlib_metaquot.ml
index 66f7eb6a3..2fb96b0f3 100644
--- a/metaquot/ppxlib_metaquot.ml
+++ b/metaquot/ppxlib_metaquot.ml
@@ -154,13 +154,6 @@ module Expr = Make (struct
 
   let annotate e core_type = pexp_constraint ~loc:core_type.ptyp_loc e core_type
 
-  let fresh_name =
-    let counter = ref 0 in
-    fun () ->
-      let var = "_ppx_metaquot_helper_var%d" ^ string_of_int !counter in
-      incr counter;
-      var
-
   (* Append the quoted attributes to the attributes present on the
      antiquoted construct. Take this as example:
 
@@ -177,17 +170,16 @@ module Expr = Make (struct
     | [] -> self#typed e type_name
     | _ :: _ ->
         let loc = { loc with loc_ghost = true } in
-        let module Ast_builder_with_loc = (val Ast_builder.make loc) in
-        let open Ast_builder_with_loc in
-        let var = fresh_name () in
-        let var_expr = pexp_ident (Located.mk (Lident var)) in
-        let field_name = Located.mk (Lident field_name) in
+        let var = gen_symbol ~prefix:"_ppx_metaquot_helper_var" () in
+        let var_expr = pexp_ident ~loc (Located.mk ~loc (Lident var)) in
+        let field_name = Located.mk ~loc (Lident field_name) in
         let reified_attrs = self#attributes quoted_attributes in
         (* append arg1 arg2 = [%expr Stdlib.List.append [%e arg1] [%e arg2]] *)
         let append arg1 arg2 =
-          pexp_apply
-            (pexp_ident
-               (Located.mk (Ldot (Ldot (Lident "Stdlib", "List"), "append"))))
+          pexp_apply ~loc
+            (pexp_ident ~loc
+               (Located.mk ~loc
+                  (Ldot (Ldot (Lident "Stdlib", "List"), "append"))))
             [ (Nolabel, arg1); (Nolabel, arg2) ]
         in
         (*
@@ -199,16 +191,16 @@ module Expr = Make (struct
            }
          ]}
         *)
-        pexp_let Nonrecursive
+        pexp_let Nonrecursive ~loc
           [
-            value_binding
-              ~pat:(ppat_var (Located.mk var))
+            value_binding ~loc
+              ~pat:(ppat_var ~loc (Located.mk ~loc var))
               ~expr:(self#typed e type_name);
           ]
-          (pexp_record
+          (pexp_record ~loc
              [
                ( field_name,
-                 append (pexp_field var_expr field_name) reified_attrs );
+                 append (pexp_field ~loc var_expr field_name) reified_attrs );
              ]
              (Some var_expr))
 
@@ -222,10 +214,9 @@ module Expr = Make (struct
             add_quoted_attributes self e quoted_attrs ~type_name
               ~loc:(loc_of_extension ext))
     | _ ->
-        Ast_builder.Default.(
-          pexp_extension ~loc:(loc_of_extension ext)
-            (Location.error_extensionf ~loc:(loc_of_extension ext)
-               "expression expected"))
+        pexp_extension ~loc:(loc_of_extension ext)
+          (Location.error_extensionf ~loc:(loc_of_extension ext)
+             "expression expected")
 end)
 
 module Patt = Make (struct

From 81cf1281c2ef79dcce6bcc124640e6c318c46fae Mon Sep 17 00:00:00 2001
From: Nick Roberts <nroberts02@gmail.com>
Date: Wed, 23 Aug 2023 09:21:05 -0400
Subject: [PATCH 10/31] Update metaquot/ppxlib_metaquot.ml

Co-authored-by: panglesd <peada@free.fr>
Signed-off-by: Nick Roberts <nroberts@janestreet.com>
---
 metaquot/ppxlib_metaquot.ml | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/metaquot/ppxlib_metaquot.ml b/metaquot/ppxlib_metaquot.ml
index 2fb96b0f3..1de3eeff4 100644
--- a/metaquot/ppxlib_metaquot.ml
+++ b/metaquot/ppxlib_metaquot.ml
@@ -239,10 +239,6 @@ module Patt = Make (struct
         (match attrs with
         | None -> ()
         | Some { quoted_attributes; field_name = _ } ->
-            (* We can't construct a pattern that searches for [quoted_attributes]
-               at the end of [p]'s attribute list -- the pattern language isn't
-               expressive enough. Instead, we fail.
-            *)
             assert_no_attributes quoted_attributes);
         self#typed p type_name
     | PPat (_, Some e) ->

From fc172c5d99ad7aecf0f49ceabd39967308080f17 Mon Sep 17 00:00:00 2001
From: Nick Roberts <nroberts@janestreet.com>
Date: Thu, 6 Jul 2023 12:24:57 -0400
Subject: [PATCH 11/31] Add support for reserving subnamespaces, like foo.bar

Signed-off-by: Nick Roberts <nroberts@janestreet.com>
---
 src/name.ml                    | 55 ++++++++++++++++++++++++++-----
 test/driver/attributes/test.ml | 60 ++++++++++++++++++++++++++++++++++
 2 files changed, 106 insertions(+), 9 deletions(-)

diff --git a/src/name.ml b/src/name.ml
index 413b7bee8..3d9a35cb8 100644
--- a/src/name.ml
+++ b/src/name.ml
@@ -44,10 +44,15 @@ module Pattern = struct
   let matches t matched = String.Set.mem matched t.dot_suffixes
 end
 
-let get_outer_namespace name =
+(* On the namespace "a.NAMESPACE", return the pair ("a", NAMESPACE) *)
+let split_outer_namespace name =
   match String.index_opt name '.' with
   | None -> None
-  | Some i -> Some (String.sub name ~pos:0 ~len:i)
+  | Some i ->
+      let n = String.length name in
+      let before_dot = String.sub name ~pos:0 ~len:i in
+      let after_dot = String.sub name ~pos:(i + 1) ~len:(n - i - 1) in
+      Some (before_dot, after_dot)
 
 module Allowlisted = struct
   (* Allow list the following attributes, as well as all their dot suffixes.
@@ -114,8 +119,45 @@ module Allowlisted = struct
 end
 
 module Reserved_namespaces = struct
-  let tbl : (string, unit) Hashtbl.t = Hashtbl.create 16
-  let reserve ns = Hashtbl.add_exn tbl ~key:ns ~data:()
+  type reserved = (string, sub_namespaces) Hashtbl.t
+  and sub_namespaces = All | Sub_namespaces of reserved
+
+  (* If [tbl] contains a mapping from "x" to [All], then "x" and all paths that
+   * start with "x." are reserved with respect to [tbl]
+   *
+   * If [tbl] contains a mapping from "x" to [Sub_namespaces tbl'], and P is
+   * reserved with respect to [tbl'], then all paths "x.P" are reserved with
+   * respect to [tbl].
+   *)
+  let create_reserved () : reserved = Hashtbl.create 16
+
+  let rec reserve ns tbl =
+    match split_outer_namespace ns with
+    | None -> Hashtbl.add_exn tbl ~key:ns ~data:All
+    | Some (outer_ns, rest_ns) -> (
+        match
+          Hashtbl.find_or_add tbl outer_ns ~default:(fun () ->
+              Sub_namespaces (create_reserved ()))
+        with
+        | Sub_namespaces rest_tbl -> reserve rest_ns rest_tbl
+        | All -> ())
+
+  let rec is_in_reserved_namespaces name tbl =
+    match split_outer_namespace name with
+    | Some (ns, rest) -> (
+        match Hashtbl.find_opt tbl ns with
+        | Some (Sub_namespaces rest_tbl) ->
+            is_in_reserved_namespaces rest rest_tbl
+        | Some All -> true
+        | None -> false)
+    | None -> (
+        match Hashtbl.find_opt tbl name with
+        | Some All -> true
+        | Some (Sub_namespaces _) | None -> false)
+
+  let tbl = create_reserved ()
+  let reserve ns = reserve ns tbl
+  let is_in_reserved_namespaces name = is_in_reserved_namespaces name tbl
   let () = reserve "merlin"
   let () = reserve "reason"
   let () = reserve "refmt" (* reason *)
@@ -124,11 +166,6 @@ module Reserved_namespaces = struct
   let () = reserve "metaocaml"
   let () = reserve "ocamlformat"
 
-  let is_in_reserved_namespaces name =
-    match get_outer_namespace name with
-    | Some ns -> Hashtbl.mem tbl ns
-    | None -> Hashtbl.mem tbl name
-
   let check_not_reserved ~kind name =
     let kind, list =
       match kind with
diff --git a/test/driver/attributes/test.ml b/test/driver/attributes/test.ml
index 51b983a96..3b45a0b0e 100644
--- a/test/driver/attributes/test.ml
+++ b/test/driver/attributes/test.ml
@@ -92,3 +92,63 @@ type t2 = <  >
 Line _, characters 17-20:
 Error: Attribute `foo' was not used
 |}]
+
+(* Reserved Namespaces *)
+
+(* ppxlib checks that unreserved attributes aren't dropped *)
+
+let x = (42 [@bar])
+[%%expect{|
+Line _, characters 14-17:
+Error: Attribute `bar' was silently dropped
+|}]
+
+let x = (42 [@bar.baz])
+[%%expect{|
+Line _, characters 14-21:
+Error: Attribute `bar.baz' was silently dropped
+|}]
+
+(* But reserving a namespace disables those checks. *)
+
+let () = Reserved_namespaces.reserve "bar"
+
+let x = (42 [@bar])
+let x = (42 [@bar.baz])
+[%%expect{|
+val x : int = 42
+val x : int = 42
+|}]
+
+let x = (42 [@bar_not_proper_sub_namespace])
+[%%expect{|
+Line _, characters 14-42:
+Error: Attribute `bar_not_proper_sub_namespace' was silently dropped
+|}]
+
+(* The namespace reservation process understands dots as namespace
+   separators. *)
+
+let () = Reserved_namespaces.reserve "baz.qux"
+
+let x = (42 [@baz])
+[%%expect{|
+Line _, characters 14-17:
+Error: Attribute `baz' was silently dropped
+|}]
+
+let x = (42 [@baz.qux])
+[%%expect{|
+val x : int = 42
+|}]
+
+let x = (42 [@baz.qux.quux])
+[%%expect{|
+val x : int = 42
+|}]
+
+let x = (42 [@baz.qux_not_proper_sub_namespace])
+[%%expect{|
+Line _, characters 14-46:
+Error: Attribute `baz.qux_not_proper_sub_namespace' was silently dropped
+|}]

From e2e2cdab099a043a3d3b71d93b45e66a53edec43 Mon Sep 17 00:00:00 2001
From: Nick Roberts <nroberts@janestreet.com>
Date: Thu, 6 Jul 2023 12:27:32 -0400
Subject: [PATCH 12/31] Add a test for multiple subnamespaces

Signed-off-by: Nick Roberts <nroberts@janestreet.com>
---
 test/driver/attributes/test.ml | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

diff --git a/test/driver/attributes/test.ml b/test/driver/attributes/test.ml
index 3b45a0b0e..22bfacdff 100644
--- a/test/driver/attributes/test.ml
+++ b/test/driver/attributes/test.ml
@@ -152,3 +152,20 @@ let x = (42 [@baz.qux_not_proper_sub_namespace])
 Line _, characters 14-46:
 Error: Attribute `baz.qux_not_proper_sub_namespace' was silently dropped
 |}]
+
+(* You can reserve multiple subnamespaces under the same namespace *)
+
+let () = Reserved_namespaces.reserve "baz.qux2"
+
+let x = (42 [@baz.qux])
+let x = (42 [@baz.qux2])
+[%%expect{|
+val x : int = 42
+val x : int = 42
+|}]
+
+let x = (42 [@baz.qux3])
+[%%expect{|
+Line _, characters 14-22:
+Error: Attribute `baz.qux3' was silently dropped
+|}]

From 434ec2bb161a59b7d3818cb0f6b901ede9a9480a Mon Sep 17 00:00:00 2001
From: Nick Roberts <nroberts@janestreet.com>
Date: Thu, 6 Jul 2023 13:59:23 -0400
Subject: [PATCH 13/31] Add 5.1.0 tests

Signed-off-by: Nick Roberts <nroberts@janestreet.com>
---
 test/driver/attributes/test_510.ml | 89 ++++++++++++++++++++++++++++++
 1 file changed, 89 insertions(+)

diff --git a/test/driver/attributes/test_510.ml b/test/driver/attributes/test_510.ml
index d8b6bed7e..a007312a7 100644
--- a/test/driver/attributes/test_510.ml
+++ b/test/driver/attributes/test_510.ml
@@ -103,3 +103,92 @@ type t2 = <  >
 Line _, characters 17-20:
 Error: Attribute `foo' was not used
 |}]
+
+(* Reserved Namespaces *)
+
+(* ppxlib checks that unreserved attributes aren't dropped *)
+
+let x = (42 [@bar])
+[%%expect{|
+
+Line _, characters 14-17:
+Error: Attribute `bar' was silently dropped
+|}]
+
+let x = (42 [@bar.baz])
+[%%expect{|
+
+Line _, characters 14-21:
+Error: Attribute `bar.baz' was silently dropped
+|}]
+
+(* But reserving a namespace disables those checks. *)
+
+let () = Reserved_namespaces.reserve "bar"
+
+let x = (42 [@bar])
+let x = (42 [@bar.baz])
+[%%expect{|
+
+val x : int = 42
+
+val x : int = 42
+|}]
+
+let x = (42 [@bar_not_proper_sub_namespace])
+[%%expect{|
+
+Line _, characters 14-42:
+Error: Attribute `bar_not_proper_sub_namespace' was silently dropped
+|}]
+
+(* The namespace reservation process understands dots as namespace
+   separators. *)
+
+let () = Reserved_namespaces.reserve "baz.qux"
+
+let x = (42 [@baz])
+[%%expect{|
+
+Line _, characters 14-17:
+Error: Attribute `baz' was silently dropped
+|}]
+
+let x = (42 [@baz.qux])
+[%%expect{|
+
+val x : int = 42
+|}]
+
+let x = (42 [@baz.qux.quux])
+[%%expect{|
+
+val x : int = 42
+|}]
+
+let x = (42 [@baz.qux_not_proper_sub_namespace])
+[%%expect{|
+
+Line _, characters 14-46:
+Error: Attribute `baz.qux_not_proper_sub_namespace' was silently dropped
+|}]
+
+(* You can reserve multiple subnamespaces under the same namespace *)
+
+let () = Reserved_namespaces.reserve "baz.qux2"
+
+let x = (42 [@baz.qux])
+let x = (42 [@baz.qux2])
+[%%expect{|
+
+val x : int = 42
+
+val x : int = 42
+|}]
+
+let x = (42 [@baz.qux3])
+[%%expect{|
+
+Line _, characters 14-22:
+Error: Attribute `baz.qux3' was silently dropped
+|}]

From 3e137a093f62f61287d8ef204ef6ea868166cf12 Mon Sep 17 00:00:00 2001
From: Sonja Heinze <sonjaleaheinze@gmail.com>
Date: Mon, 18 Sep 2023 21:12:22 +0200
Subject: [PATCH 14/31] Add changelog entry

Signed-off-by: Sonja Heinze <sonjaleaheinze@gmail.com>
---
 CHANGES.md | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/CHANGES.md b/CHANGES.md
index 3186a4e24..41310895b 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -11,6 +11,8 @@ unreleased
 
 - Preserve quoted attributes on antiquotes in metaquot (#441, @ncik-roberts)
 
+- Attribute namespaces: Fix semantics of reserving multi-component namespaces (#443, @ncik-roberts)
+
 0.30.0 (20/06/2023)
 -------------------
 

From ea93e632a4c4941881e79b91815d3ee46a1183fc Mon Sep 17 00:00:00 2001
From: Sonja Heinze <sonjaleaheinze@gmail.com>
Date: Fri, 23 Jun 2023 12:18:45 +0200
Subject: [PATCH 15/31] Make the migration tests deterministic

Signed-off-by: Sonja Heinze <sonjaleaheinze@gmail.com>
---
 test/501_migrations/normal_migrations.t | 135 +++++++++++++-----------
 1 file changed, 76 insertions(+), 59 deletions(-)

diff --git a/test/501_migrations/normal_migrations.t b/test/501_migrations/normal_migrations.t
index c9d2c8d42..b49cf18c8 100644
--- a/test/501_migrations/normal_migrations.t
+++ b/test/501_migrations/normal_migrations.t
@@ -6,92 +6,105 @@ AST's resulting from
 We only expect a diff in one special case.
 
   $ echo "let x : int = 5" > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
   $ echo "let (x) : int = 5" > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
   $ echo "let _ : int = 5" > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
   $ echo "let f : type a b c. a -> b -> c = fun x y -> assert false" > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
   $ echo "let f = (fun (type a) (type b) (type c) -> (fun x y -> assert false : a -> b -> c))" > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
   $ echo "let _ = (fun (type a) (type b) (type c) -> (fun x y -> assert false : a -> b -> c))" > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
   $ echo "let f : type a . a -> a = fun x -> x" > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
   $ echo "let (x, y) : (int * int) = assert false" > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
   $ echo "let f : type a . a = assert false" > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
   $ echo 'let x : [`A] :> [`A | `B] = `A' > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
   $ echo 'let x : [`A | `B] = (`A : [`A] :> [`A | `B])' > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
   $ echo 'let x : <m:int; n:int> :> <m:int> = object method m = 0 method n = 1 end' > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
   $ echo 'let x :> <m:int> = object method m = 0 method n = 1 end' > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
 
 Here might be a problem in the upward migration: the 5.1.0 parser parses the constraint as a pattern constraint.
 However, the upward migration makes a value binding constraint out of it.
   $ echo "let ((x,y) : (int*int)) = (assert false: int * int)" > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
-  6,25c6,23
-  <         pattern (file.ml[1,0+4]..[1,0+23])
-  <           Ppat_constraint
-  <           pattern (file.ml[1,0+5]..[1,0+10])
-  <             Ppat_tuple
-  <             [
-  <               pattern (file.ml[1,0+6]..[1,0+7])
-  <                 Ppat_var "x" (file.ml[1,0+6]..[1,0+7])
-  <               pattern (file.ml[1,0+8]..[1,0+9])
-  <                 Ppat_var "y" (file.ml[1,0+8]..[1,0+9])
-  <             ]
-  <           core_type (file.ml[1,0+14]..[1,0+21])
-  <             Ptyp_tuple
-  <             [
-  <               core_type (file.ml[1,0+14]..[1,0+17])
-  <                 Ptyp_constr "int" (file.ml[1,0+14]..[1,0+17])
-  <                 []
-  <               core_type (file.ml[1,0+18]..[1,0+21])
-  <                 Ptyp_constr "int" (file.ml[1,0+18]..[1,0+21])
-  <                 []
-  <             ]
-  ---
-  >         pattern (file.ml[1,0+5]..[1,0+10])
-  >           Ppat_tuple
-  >           [
-  >             pattern (file.ml[1,0+6]..[1,0+7])
-  >               Ppat_var "x" (file.ml[1,0+6]..[1,0+7])
-  >             pattern (file.ml[1,0+8]..[1,0+9])
-  >               Ppat_var "y" (file.ml[1,0+8]..[1,0+9])
-  >           ]
-  >         core_type (file.ml[1,0+14]..[1,0+21])
-  >           Ptyp_tuple
-  >           [
-  >             core_type (file.ml[1,0+14]..[1,0+17])
-  >               Ptyp_constr "int" (file.ml[1,0+14]..[1,0+17])
-  >               []
-  >             core_type (file.ml[1,0+18]..[1,0+21])
-  >               Ptyp_constr "int" (file.ml[1,0+18]..[1,0+21])
-  >               []
-  >           ]
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  @@ -6,20 +6,18 @@
+  -        pattern (file.ml[1,0+4]..[1,0+23])
+  -          Ppat_constraint
+  -          pattern (file.ml[1,0+5]..[1,0+10])
+  -            Ppat_tuple
+  -            [
+  -              pattern (file.ml[1,0+6]..[1,0+7])
+  -                Ppat_var "x" (file.ml[1,0+6]..[1,0+7])
+  -              pattern (file.ml[1,0+8]..[1,0+9])
+  -                Ppat_var "y" (file.ml[1,0+8]..[1,0+9])
+  -            ]
+  -          core_type (file.ml[1,0+14]..[1,0+21])
+  -            Ptyp_tuple
+  -            [
+  -              core_type (file.ml[1,0+14]..[1,0+17])
+  -                Ptyp_constr "int" (file.ml[1,0+14]..[1,0+17])
+  -                []
+  -              core_type (file.ml[1,0+18]..[1,0+21])
+  -                Ptyp_constr "int" (file.ml[1,0+18]..[1,0+21])
+  -                []
+  -            ]
+  +        pattern (file.ml[1,0+5]..[1,0+10])
+  +          Ppat_tuple
+  +          [
+  +            pattern (file.ml[1,0+6]..[1,0+7])
+  +              Ppat_var "x" (file.ml[1,0+6]..[1,0+7])
+  +            pattern (file.ml[1,0+8]..[1,0+9])
+  +              Ppat_var "y" (file.ml[1,0+8]..[1,0+9])
+  +          ]
+  +        core_type (file.ml[1,0+14]..[1,0+21])
+  +          Ptyp_tuple
+  +          [
+  +            core_type (file.ml[1,0+14]..[1,0+17])
+  +              Ptyp_constr "int" (file.ml[1,0+14]..[1,0+17])
+  +              []
+  +            core_type (file.ml[1,0+18]..[1,0+21])
+  +              Ptyp_constr "int" (file.ml[1,0+18]..[1,0+21])
+  +              []
+  +          ]
 
   $ echo "let f: type a. a option -> _ = assert false" > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
 
 Here we may expect a diff (downwards migrating should yield the same as in the example right above).
@@ -100,11 +113,13 @@ However, those case are recoverable.
 First, both
 
   $ echo "let f : 'a . 'a = (fun (type a) -> (assert false : a))" > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
 and
   $ echo "let f : type a . a = assert false" > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
 are translated to the same 5.0 AST tree. But the locations on the expression
 constraint and pattern constraint are only the same in the second case.
@@ -113,12 +128,14 @@ Thus, we can distinguish between the two.
 Similarly, the syntactic translation for
 
   $ echo 'let x :> [`A | `B] = `A' > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
 and
 
   $ echo 'let x : [`A | `B] = (`A :> [ `A | `B ] )' > file.ml
-  $ ./compare_on.exe file.ml ./identity_driver.exe
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
 
 are pretty close: The former is translated to "let (x: ø .  [`A | `B]) = (`A :> [`A | `B])"
 whereas the latter is mapped to "let (x: ø .  [`A | `B]) = ((`A :> [`A | `B]): [`A | `B]) ".

From 9fbedce3e6fb9a2dcf0625193f71ed3febcc1fdd Mon Sep 17 00:00:00 2001
From: Sonja Heinze <sonjaleaheinze@gmail.com>
Date: Fri, 23 Jun 2023 13:05:00 +0200
Subject: [PATCH 16/31] 5.1 migrations: Add tests for generative functors

Signed-off-by: Sonja Heinze <sonjaleaheinze@gmail.com>
---
 test/501_migrations/normal_migrations.t  |  41 +-
 test/501_migrations/one_migration.t      | 558 +++++++++++++++++++++++
 test/501_migrations/reverse_migrations.t |  30 ++
 3 files changed, 628 insertions(+), 1 deletion(-)

diff --git a/test/501_migrations/normal_migrations.t b/test/501_migrations/normal_migrations.t
index b49cf18c8..faf2289fb 100644
--- a/test/501_migrations/normal_migrations.t
+++ b/test/501_migrations/normal_migrations.t
@@ -3,7 +3,10 @@ The 501 parsetree contains a parsing modificacion.
 AST's resulting from
 1. parsing <file> on 5.1.0 directly
 2. parsing <file> on 5.1.0, migrating down to 5.0.0 and migrating back to 5.1.0
-We only expect a diff in one special case.
+
+------------------
+
+Tests for the Parsetree change for type constraints in value bindings
 
   $ echo "let x : int = 5" > file.ml
   $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
@@ -146,3 +149,39 @@ Let's make sure that in the examples with diffs,
 the location invariants are still fulfilled.
   $ echo "let ((x,y) : (int*int)) = (assert false: int * int)" > file.ml
   $ ./identity_driver.exe -check -locations-check file.ml > /dev/null
+
+------------------
+
+Tests for the Parsetree change for generative functor applications
+
+
+  $ cat > file.ml << EOF
+  > module F () = struct end
+  > module M = F ()
+  > EOF
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  @@ -14 +14 @@
+  -        Pmod_apply_unit
+  +        Pmod_apply
+  @@ -16,0 +17,3 @@
+  +        module_expr (_none_[0,0+-1]..[0,0+-1]) ghost
+  +          Pmod_structure
+  +          []
+  @@ -18,0 +22,3 @@
+  +File "_none_", line 1:
+  +Warning 73 [generative-application-expects-unit]: A generative functor
+  +should be applied to '()'; using '(struct end)' is deprecated.
+
+  $ cat > file.ml << EOF
+  > module F () = struct end
+  > module M = F(struct end)
+  > EOF
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
+
+  $ cat > file.ml << EOF
+  > module F (N : sig end) = struct end
+  > module M = F (struct end)
+  > EOF
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
diff --git a/test/501_migrations/one_migration.t b/test/501_migrations/one_migration.t
index 70a549b1f..48e844466 100644
--- a/test/501_migrations/one_migration.t
+++ b/test/501_migrations/one_migration.t
@@ -570,3 +570,561 @@ So let's only keep one example.
      ((loc_start ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 0)))
       (loc_end ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 15)))
       (loc_ghost false)))))
+
+  $ cat > file.ml << EOF
+  > module F () = struct end
+  > module M = F ()
+  > EOF
+  $ ./identity_driver.exe -dparsetree file.ml
+  (((pstr_desc
+     (Pstr_attribute
+      ((attr_name
+        ((txt ocaml.ppx.context)
+         (loc
+          ((loc_start
+            ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1)))
+           (loc_end
+            ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1)))
+           (loc_ghost true)))))
+       (attr_payload
+        (PStr
+         (((pstr_desc
+            (Pstr_eval
+             ((pexp_desc
+               (Pexp_record
+                ((((txt (Lident tool_name))
+                   (loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true))))
+                  ((pexp_desc
+                    (Pexp_constant
+                     (Pconst_string ppxlib_driver
+                      ((loc_start
+                        ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                         (pos_cnum -1)))
+                       (loc_end
+                        ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                         (pos_cnum -1)))
+                       (loc_ghost true))
+                      ())))
+                   (pexp_loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true)))
+                   (pexp_loc_stack ()) (pexp_attributes ())))
+                 (((txt (Lident include_dirs))
+                   (loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true))))
+                  ((pexp_desc
+                    (Pexp_construct
+                     ((txt (Lident []))
+                      (loc
+                       ((loc_start
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_end
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_ghost true))))
+                     ()))
+                   (pexp_loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true)))
+                   (pexp_loc_stack ()) (pexp_attributes ())))
+                 (((txt (Lident load_path))
+                   (loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true))))
+                  ((pexp_desc
+                    (Pexp_construct
+                     ((txt (Lident []))
+                      (loc
+                       ((loc_start
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_end
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_ghost true))))
+                     ()))
+                   (pexp_loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true)))
+                   (pexp_loc_stack ()) (pexp_attributes ())))
+                 (((txt (Lident open_modules))
+                   (loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true))))
+                  ((pexp_desc
+                    (Pexp_construct
+                     ((txt (Lident []))
+                      (loc
+                       ((loc_start
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_end
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_ghost true))))
+                     ()))
+                   (pexp_loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true)))
+                   (pexp_loc_stack ()) (pexp_attributes ())))
+                 (((txt (Lident for_package))
+                   (loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true))))
+                  ((pexp_desc
+                    (Pexp_construct
+                     ((txt (Lident None))
+                      (loc
+                       ((loc_start
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_end
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_ghost true))))
+                     ()))
+                   (pexp_loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true)))
+                   (pexp_loc_stack ()) (pexp_attributes ())))
+                 (((txt (Lident debug))
+                   (loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true))))
+                  ((pexp_desc
+                    (Pexp_construct
+                     ((txt (Lident false))
+                      (loc
+                       ((loc_start
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_end
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_ghost true))))
+                     ()))
+                   (pexp_loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true)))
+                   (pexp_loc_stack ()) (pexp_attributes ())))
+                 (((txt (Lident use_threads))
+                   (loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true))))
+                  ((pexp_desc
+                    (Pexp_construct
+                     ((txt (Lident false))
+                      (loc
+                       ((loc_start
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_end
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_ghost true))))
+                     ()))
+                   (pexp_loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true)))
+                   (pexp_loc_stack ()) (pexp_attributes ())))
+                 (((txt (Lident use_vmthreads))
+                   (loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true))))
+                  ((pexp_desc
+                    (Pexp_construct
+                     ((txt (Lident false))
+                      (loc
+                       ((loc_start
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_end
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_ghost true))))
+                     ()))
+                   (pexp_loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true)))
+                   (pexp_loc_stack ()) (pexp_attributes ())))
+                 (((txt (Lident recursive_types))
+                   (loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true))))
+                  ((pexp_desc
+                    (Pexp_construct
+                     ((txt (Lident false))
+                      (loc
+                       ((loc_start
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_end
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_ghost true))))
+                     ()))
+                   (pexp_loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true)))
+                   (pexp_loc_stack ()) (pexp_attributes ())))
+                 (((txt (Lident principal))
+                   (loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true))))
+                  ((pexp_desc
+                    (Pexp_construct
+                     ((txt (Lident false))
+                      (loc
+                       ((loc_start
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_end
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_ghost true))))
+                     ()))
+                   (pexp_loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true)))
+                   (pexp_loc_stack ()) (pexp_attributes ())))
+                 (((txt (Lident transparent_modules))
+                   (loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true))))
+                  ((pexp_desc
+                    (Pexp_construct
+                     ((txt (Lident false))
+                      (loc
+                       ((loc_start
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_end
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_ghost true))))
+                     ()))
+                   (pexp_loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true)))
+                   (pexp_loc_stack ()) (pexp_attributes ())))
+                 (((txt (Lident unboxed_types))
+                   (loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true))))
+                  ((pexp_desc
+                    (Pexp_construct
+                     ((txt (Lident false))
+                      (loc
+                       ((loc_start
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_end
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_ghost true))))
+                     ()))
+                   (pexp_loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true)))
+                   (pexp_loc_stack ()) (pexp_attributes ())))
+                 (((txt (Lident unsafe_string))
+                   (loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true))))
+                  ((pexp_desc
+                    (Pexp_construct
+                     ((txt (Lident false))
+                      (loc
+                       ((loc_start
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_end
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_ghost true))))
+                     ()))
+                   (pexp_loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true)))
+                   (pexp_loc_stack ()) (pexp_attributes ())))
+                 (((txt (Lident cookies))
+                   (loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true))))
+                  ((pexp_desc
+                    (Pexp_construct
+                     ((txt (Lident []))
+                      (loc
+                       ((loc_start
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_end
+                         ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                          (pos_cnum -1)))
+                        (loc_ghost true))))
+                     ()))
+                   (pexp_loc
+                    ((loc_start
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_end
+                      ((pos_fname _none_) (pos_lnum 0) (pos_bol 0)
+                       (pos_cnum -1)))
+                     (loc_ghost true)))
+                   (pexp_loc_stack ()) (pexp_attributes ()))))
+                ()))
+              (pexp_loc
+               ((loc_start
+                 ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1)))
+                (loc_end
+                 ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1)))
+                (loc_ghost true)))
+              (pexp_loc_stack ()) (pexp_attributes ()))
+             ()))
+           (pstr_loc
+            ((loc_start
+              ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1)))
+             (loc_end
+              ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1)))
+             (loc_ghost true)))))))
+       (attr_loc
+        ((loc_start
+          ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1)))
+         (loc_end ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1)))
+         (loc_ghost true))))))
+    (pstr_loc
+     ((loc_start ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1)))
+      (loc_end ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1)))
+      (loc_ghost true))))
+   ((pstr_desc
+     (Pstr_module
+      ((pmb_name
+        ((txt (F))
+         (loc
+          ((loc_start
+            ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 7)))
+           (loc_end
+            ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 8)))
+           (loc_ghost false)))))
+       (pmb_expr
+        ((pmod_desc
+          (Pmod_functor Unit
+           ((pmod_desc (Pmod_structure ()))
+            (pmod_loc
+             ((loc_start
+               ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 14)))
+              (loc_end
+               ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 24)))
+              (loc_ghost false)))
+            (pmod_attributes ()))))
+         (pmod_loc
+          ((loc_start
+            ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 9)))
+           (loc_end
+            ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 24)))
+           (loc_ghost false)))
+         (pmod_attributes ())))
+       (pmb_attributes ())
+       (pmb_loc
+        ((loc_start
+          ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 0)))
+         (loc_end ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 24)))
+         (loc_ghost false))))))
+    (pstr_loc
+     ((loc_start ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 0)))
+      (loc_end ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 24)))
+      (loc_ghost false))))
+   ((pstr_desc
+     (Pstr_module
+      ((pmb_name
+        ((txt (M))
+         (loc
+          ((loc_start
+            ((pos_fname file.ml) (pos_lnum 2) (pos_bol 25) (pos_cnum 32)))
+           (loc_end
+            ((pos_fname file.ml) (pos_lnum 2) (pos_bol 25) (pos_cnum 33)))
+           (loc_ghost false)))))
+       (pmb_expr
+        ((pmod_desc
+          (Pmod_apply
+           ((pmod_desc
+             (Pmod_ident
+              ((txt (Lident F))
+               (loc
+                ((loc_start
+                  ((pos_fname file.ml) (pos_lnum 2) (pos_bol 25) (pos_cnum 36)))
+                 (loc_end
+                  ((pos_fname file.ml) (pos_lnum 2) (pos_bol 25) (pos_cnum 37)))
+                 (loc_ghost false))))))
+            (pmod_loc
+             ((loc_start
+               ((pos_fname file.ml) (pos_lnum 2) (pos_bol 25) (pos_cnum 36)))
+              (loc_end
+               ((pos_fname file.ml) (pos_lnum 2) (pos_bol 25) (pos_cnum 37)))
+              (loc_ghost false)))
+            (pmod_attributes ()))
+           ((pmod_desc (Pmod_structure ()))
+            (pmod_loc
+             ((loc_start
+               ((pos_fname file.ml) (pos_lnum 2) (pos_bol 25) (pos_cnum 36)))
+              (loc_end
+               ((pos_fname file.ml) (pos_lnum 2) (pos_bol 25) (pos_cnum 40)))
+              (loc_ghost false)))
+            (pmod_attributes ()))))
+         (pmod_loc
+          ((loc_start
+            ((pos_fname file.ml) (pos_lnum 2) (pos_bol 25) (pos_cnum 36)))
+           (loc_end
+            ((pos_fname file.ml) (pos_lnum 2) (pos_bol 25) (pos_cnum 40)))
+           (loc_ghost false)))
+         (pmod_attributes ())))
+       (pmb_attributes ())
+       (pmb_loc
+        ((loc_start
+          ((pos_fname file.ml) (pos_lnum 2) (pos_bol 25) (pos_cnum 25)))
+         (loc_end
+          ((pos_fname file.ml) (pos_lnum 2) (pos_bol 25) (pos_cnum 40)))
+         (loc_ghost false))))))
+    (pstr_loc
+     ((loc_start ((pos_fname file.ml) (pos_lnum 2) (pos_bol 25) (pos_cnum 25)))
+      (loc_end ((pos_fname file.ml) (pos_lnum 2) (pos_bol 25) (pos_cnum 40)))
+      (loc_ghost false)))))
diff --git a/test/501_migrations/reverse_migrations.t b/test/501_migrations/reverse_migrations.t
index 9120ed91e..0e3dda23f 100644
--- a/test/501_migrations/reverse_migrations.t
+++ b/test/501_migrations/reverse_migrations.t
@@ -4,6 +4,10 @@ AST's resulting from
 1. parsing <file> on 5.0.0 directly
 2. parsing <file> on 5.0.0, migrating up to 5.1.0 and migrating back to 5.0.0
 
+------------------
+
+Tests for the Parsetree change for type constraints in value bindings
+
   $ echo "let x : int = 5" > file.ml
   $ ./compare_on.exe file.ml ./reverse_migrations.exe   | grep -v "without_migrations" | grep -v "with_migrations"
   [1]
@@ -162,3 +166,29 @@ the location invariants are still fulfilled.
 
   $ echo "let (x) : int = 5" > file.ml
   $ ./reverse_migrations.exe -check -locations-check file.ml > /dev/null
+
+
+------------------
+
+Tests for the Parsetree change for generative functor applications
+
+  $ cat > file.ml << EOF
+  > module F () = struct end
+  > module M = F ()
+  > EOF
+  $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
+
+  $ cat > file.ml << EOF
+  > module F () = struct end
+  > module M = F(struct end)
+  > EOF
+  $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
+
+  $ cat > file.ml << EOF
+  > module F (N : sig end) = struct end
+  > module M = F (struct end)
+  > EOF
+  $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]

From 59e0193ce4a351990823bce27d36d1128e8aa806 Mon Sep 17 00:00:00 2001
From: Paul-Elliot <peada@free.fr>
Date: Wed, 6 Sep 2023 12:35:49 +0200
Subject: [PATCH 17/31] Fix generative functor location in 501 -> 500 migration

Signed-off-by: Paul-Elliot <peada@free.fr>
---
 astlib/migrate_501_500.ml               | 11 ++++++-----
 test/501_migrations/normal_migrations.t |  8 +++++---
 test/code_path/test_510.ml              |  2 +-
 3 files changed, 12 insertions(+), 9 deletions(-)

diff --git a/astlib/migrate_501_500.ml b/astlib/migrate_501_500.ml
index ac53b3203..344a8887f 100644
--- a/astlib/migrate_501_500.ml
+++ b/astlib/migrate_501_500.ml
@@ -769,14 +769,15 @@ and copy_module_expr :
        Ast_501.Parsetree.pmod_desc;
        Ast_501.Parsetree.pmod_loc;
        Ast_501.Parsetree.pmod_attributes;
-     } ->
+   } ->
+ let loc = copy_location pmod_loc in
   {
-    Ast_500.Parsetree.pmod_desc = copy_module_expr_desc pmod_desc;
-    Ast_500.Parsetree.pmod_loc = copy_location pmod_loc;
+    Ast_500.Parsetree.pmod_desc = copy_module_expr_desc loc pmod_desc;
+    Ast_500.Parsetree.pmod_loc = loc;
     Ast_500.Parsetree.pmod_attributes = copy_attributes pmod_attributes;
   }
 
-and copy_module_expr_desc :
+and copy_module_expr_desc loc :
     Ast_501.Parsetree.module_expr_desc -> Ast_500.Parsetree.module_expr_desc =
   function
   | Ast_501.Parsetree.Pmod_ident x0 ->
@@ -793,7 +794,7 @@ and copy_module_expr_desc :
         Ast_500.Parsetree.
           {
             pmod_desc = Pmod_structure [];
-            pmod_loc = Location.none;
+            pmod_loc = loc;
             pmod_attributes = [];
           }
       in
diff --git a/test/501_migrations/normal_migrations.t b/test/501_migrations/normal_migrations.t
index faf2289fb..e2cd2608f 100644
--- a/test/501_migrations/normal_migrations.t
+++ b/test/501_migrations/normal_migrations.t
@@ -164,11 +164,13 @@ Tests for the Parsetree change for generative functor applications
   -        Pmod_apply_unit
   +        Pmod_apply
   @@ -16,0 +17,3 @@
-  +        module_expr (_none_[0,0+-1]..[0,0+-1]) ghost
+  +        module_expr (file.ml[2,25+11]..[2,25+15])
   +          Pmod_structure
   +          []
-  @@ -18,0 +22,3 @@
-  +File "_none_", line 1:
+  @@ -18,0 +22,5 @@
+  +File "file.ml", line 2, characters 11-15:
+  +2 | module M = F ()
+  +               ^^^^
   +Warning 73 [generative-application-expects-unit]: A generative functor
   +should be applied to '()'; using '(struct end)' is deprecated.
 
diff --git a/test/code_path/test_510.ml b/test/code_path/test_510.ml
index 976aac8ef..7be253b88 100644
--- a/test/code_path/test_510.ml
+++ b/test/code_path/test_510.ml
@@ -91,7 +91,7 @@ end
 let _ = let module M = Functor() in !M.code_path
 [%%expect{|
 module Functor : functor () -> sig val code_path : string ref end
-Line _:
+Line _, characters 23-32:
 Error (warning 73 [generative-application-expects-unit]): A generative functor
 should be applied to '()'; using '(struct end)' is deprecated.
 |}]

From 1adb6f82f95efa38c928387a7dc1be259c9cb763 Mon Sep 17 00:00:00 2001
From: Paul-Elliot <peada@free.fr>
Date: Wed, 6 Sep 2023 13:44:48 +0200
Subject: [PATCH 18/31] Migration: Use an attribute for generative functor
 migration

Two 501 constructs are represented the same way in 500. One of them
raise a warning.
During the 501 -> 500 -> 501 migration, we need to be careful to keep
the warning where it was originally.
We use attributes to remember which 501 representation to choose. The
reserved namespace is "ppxlib.migration".

Signed-off-by: Paul-Elliot <peada@free.fr>
---
 astlib/migrate_500_501.ml                | 22 ++++++++++++++++++++-
 astlib/migrate_501_500.ml                | 25 +++++++++++++++++++++---
 src/name.ml                              |  1 +
 src/name.mli                             |  3 ++-
 test/501_migrations/normal_migrations.t  | 14 +------------
 test/501_migrations/reverse_migrations.t | 11 +++++++++--
 6 files changed, 56 insertions(+), 20 deletions(-)

diff --git a/astlib/migrate_500_501.ml b/astlib/migrate_500_501.ml
index bb26e4f38..c3cd1499e 100644
--- a/astlib/migrate_500_501.ml
+++ b/astlib/migrate_500_501.ml
@@ -751,7 +751,27 @@ and copy_module_expr_desc :
       Ast_501.Parsetree.Pmod_functor
         (copy_functor_parameter x0, copy_module_expr x1)
   | Ast_500.Parsetree.Pmod_apply (x0, x1) ->
-      Ast_501.Parsetree.Pmod_apply (copy_module_expr x0, copy_module_expr x1)
+      let x1, is_unit =
+        match x1.pmod_desc with
+        | Pmod_structure [] ->
+            let rec extract_attr acc : Ast_500.Parsetree.attributes -> _ =
+              function
+              | [] -> (List.rev acc, true)
+              | {
+                  attr_name = { txt = "ppxlib.migration.keep_structure"; _ };
+                  _;
+                }
+                :: q ->
+                  (List.rev_append acc q, false)
+              | hd :: tl -> extract_attr (hd :: acc) tl
+            in
+            let pmod_attributes, b = extract_attr [] x1.pmod_attributes in
+            ({ x1 with pmod_attributes }, b)
+        | _ -> (x1, false)
+      in
+      if is_unit then Ast_501.Parsetree.Pmod_apply_unit (copy_module_expr x0)
+      else
+        Ast_501.Parsetree.Pmod_apply (copy_module_expr x0, copy_module_expr x1)
   | Ast_500.Parsetree.Pmod_constraint (x0, x1) ->
       Ast_501.Parsetree.Pmod_constraint
         (copy_module_expr x0, copy_module_type x1)
diff --git a/astlib/migrate_501_500.ml b/astlib/migrate_501_500.ml
index 344a8887f..da4759ab8 100644
--- a/astlib/migrate_501_500.ml
+++ b/astlib/migrate_501_500.ml
@@ -769,8 +769,8 @@ and copy_module_expr :
        Ast_501.Parsetree.pmod_desc;
        Ast_501.Parsetree.pmod_loc;
        Ast_501.Parsetree.pmod_attributes;
-   } ->
- let loc = copy_location pmod_loc in
+     } ->
+  let loc = copy_location pmod_loc in
   {
     Ast_500.Parsetree.pmod_desc = copy_module_expr_desc loc pmod_desc;
     Ast_500.Parsetree.pmod_loc = loc;
@@ -788,7 +788,26 @@ and copy_module_expr_desc loc :
       Ast_500.Parsetree.Pmod_functor
         (copy_functor_parameter x0, copy_module_expr x1)
   | Ast_501.Parsetree.Pmod_apply (x0, x1) ->
-      Ast_500.Parsetree.Pmod_apply (copy_module_expr x0, copy_module_expr x1)
+      let x1 = copy_module_expr x1 in
+      let x1 =
+        match x1.pmod_desc with
+        | Pmod_structure [] ->
+            let pmod_attributes =
+              {
+                Ast_500.Parsetree.attr_name =
+                  {
+                    txt = "ppxlib.migration.keep_structure";
+                    loc = { x1.pmod_loc with loc_ghost = true };
+                  };
+                attr_payload = Ast_500.Parsetree.PStr [];
+                attr_loc = Location.none;
+              }
+              :: x1.pmod_attributes
+            in
+            { x1 with pmod_attributes }
+        | _ -> x1
+      in
+      Ast_500.Parsetree.Pmod_apply (copy_module_expr x0, x1)
   | Ast_501.Parsetree.Pmod_apply_unit x0 ->
       let empty_struct =
         Ast_500.Parsetree.
diff --git a/src/name.ml b/src/name.ml
index 3d9a35cb8..357b7a1c0 100644
--- a/src/name.ml
+++ b/src/name.ml
@@ -165,6 +165,7 @@ module Reserved_namespaces = struct
   let () = reserve "res" (* rescript *)
   let () = reserve "metaocaml"
   let () = reserve "ocamlformat"
+  let () = reserve "ppxlib.migration"
 
   let check_not_reserved ~kind name =
     let kind, list =
diff --git a/src/name.mli b/src/name.mli
index d8b5c25aa..0ec02f8fd 100644
--- a/src/name.mli
+++ b/src/name.mli
@@ -109,7 +109,8 @@ module Reserved_namespaces : sig
       This is here to insure that the rewriter cohabits well with other rewriter
       or tools (e.g. merlin) which might leave attribute on the AST.
 
-      N.B. the "merlin" namespace is reserved by default. *)
+      N.B. the following namespaces are reserved by default: [merlin], [reason],
+      [refmt] [ns], [res], [metaocaml], [ocamlformat] and [ppxlib]. *)
 
   val is_in_reserved_namespaces : string -> bool
 end
diff --git a/test/501_migrations/normal_migrations.t b/test/501_migrations/normal_migrations.t
index e2cd2608f..78965c17a 100644
--- a/test/501_migrations/normal_migrations.t
+++ b/test/501_migrations/normal_migrations.t
@@ -160,19 +160,7 @@ Tests for the Parsetree change for generative functor applications
   > module M = F ()
   > EOF
   $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
-  @@ -14 +14 @@
-  -        Pmod_apply_unit
-  +        Pmod_apply
-  @@ -16,0 +17,3 @@
-  +        module_expr (file.ml[2,25+11]..[2,25+15])
-  +          Pmod_structure
-  +          []
-  @@ -18,0 +22,5 @@
-  +File "file.ml", line 2, characters 11-15:
-  +2 | module M = F ()
-  +               ^^^^
-  +Warning 73 [generative-application-expects-unit]: A generative functor
-  +should be applied to '()'; using '(struct end)' is deprecated.
+  [1]
 
   $ cat > file.ml << EOF
   > module F () = struct end
diff --git a/test/501_migrations/reverse_migrations.t b/test/501_migrations/reverse_migrations.t
index 0e3dda23f..81bee9734 100644
--- a/test/501_migrations/reverse_migrations.t
+++ b/test/501_migrations/reverse_migrations.t
@@ -179,16 +179,23 @@ Tests for the Parsetree change for generative functor applications
   $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations"
   [1]
 
+When going up, F(struct end) is turned into F(), which makes the location be lost.
+It could be stored in an attribute, or turned into F(struct end [@warning "-73"]).
+
   $ cat > file.ml << EOF
   > module F () = struct end
   > module M = F(struct end)
   > EOF
   $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations"
-  [1]
+  @@ -17 +17 @@
+  -        module_expr (file.ml[2,25+13]..[2,25+23])
+  +        module_expr (file.ml[2,25+11]..[2,25+24])
 
   $ cat > file.ml << EOF
   > module F (N : sig end) = struct end
   > module M = F (struct end)
   > EOF
   $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations"
-  [1]
+  @@ -20 +20 @@
+  -        module_expr (file.ml[2,36+14]..[2,36+24])
+  +        module_expr (file.ml[2,36+11]..[2,36+25])

From f882c41bb29022f8695a31671a7431ddb0e59579 Mon Sep 17 00:00:00 2001
From: Paul-Elliot <peada@free.fr>
Date: Wed, 6 Sep 2023 14:05:23 +0200
Subject: [PATCH 19/31] test is now identical between 510 and earlier

Signed-off-by: Paul-Elliot <peada@free.fr>
---
 test/code_path/dune        |  22 +-----
 test/code_path/test_510.ml | 152 -------------------------------------
 2 files changed, 1 insertion(+), 173 deletions(-)
 delete mode 100644 test/code_path/test_510.ml

diff --git a/test/code_path/dune b/test/code_path/dune
index b88be2aec..06179b3fc 100644
--- a/test/code_path/dune
+++ b/test/code_path/dune
@@ -1,9 +1,7 @@
 (rule
  (alias runtest)
  (enabled_if
-  (and
-   (>= %{ocaml_version} "4.10.0")
-   (< %{ocaml_version} "5.1.0")))
+  (>= %{ocaml_version} "4.10.0"))
  (deps
   (:test test.ml)
   (package ppxlib))
@@ -13,21 +11,3 @@
    (progn
     (run expect-test %{test})
     (diff? %{test} %{test}.corrected)))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} "5.1.0"))
- (deps
-  (:test test.ml)
-  (:t test_510.ml)
-  (package ppxlib))
- (action
-  (chdir
-   %{project_root}
-   (progn
-    (run mv %{t} %{t}.old)
-    (run cp %{test} %{t})
-    (run expect-test %{t})
-    (run mv %{t}.old %{t})
-    (diff? %{t} %{t}.corrected)))))
diff --git a/test/code_path/test_510.ml b/test/code_path/test_510.ml
deleted file mode 100644
index 7be253b88..000000000
--- a/test/code_path/test_510.ml
+++ /dev/null
@@ -1,152 +0,0 @@
-open Ppxlib
-
-let sexp_of_code_path code_path =
-  Sexplib0.Sexp.message
-    "code_path"
-    [ "main_module_name", Sexplib0.Sexp_conv.sexp_of_string (Code_path.main_module_name code_path)
-    ; "submodule_path", Sexplib0.Sexp_conv.sexp_of_list Sexplib0.Sexp_conv.sexp_of_string (Code_path.submodule_path code_path)
-    ; "enclosing_module", Sexplib0.Sexp_conv.sexp_of_string (Code_path.enclosing_module code_path)
-    ; "enclosing_value", Sexplib0.Sexp_conv.sexp_of_option Sexplib0.Sexp_conv.sexp_of_string (Code_path.enclosing_value code_path)
-    ; "value", Sexplib0.Sexp_conv.sexp_of_option Sexplib0.Sexp_conv.sexp_of_string (Code_path.value code_path)
-    ; "fully_qualified_path", Sexplib0.Sexp_conv.sexp_of_string (Code_path.fully_qualified_path code_path)
-    ]
-
-let () =
-  Driver.register_transformation "test"
-    ~extensions:[
-      Extension.V3.declare "code_path"
-        Expression
-        Ast_pattern.(pstr nil)
-        (fun ~ctxt ->
-           let loc = Expansion_context.Extension.extension_point_loc ctxt in
-           let code_path = Expansion_context.Extension.code_path ctxt in
-           Ast_builder.Default.estring ~loc
-             (Sexplib0.Sexp.to_string (sexp_of_code_path code_path)))
-    ]
-[%%expect{|
-val sexp_of_code_path : Code_path.t -> Sexplib0.Sexp.t = <fun>
-|}]
-
-let s =
-  let module A = struct
-    module A' = struct
-      let a =
-        let module B = struct
-          module B' = struct
-            let b =
-              let module C = struct
-                module C' = struct
-                  let c = [%code_path]
-                end
-              end
-              in C.C'.c
-          end
-        end
-        in B.B'.b
-    end
-  end
-  in A.A'.a
-;;
-[%%expect{|
-val s : string =
-  "(code_path(main_module_name Test_510)(submodule_path())(enclosing_module C')(enclosing_value(c))(value(s))(fully_qualified_path Test_510.s))"
-|}]
-
-let module M = struct
-  let m = [%code_path]
-  end
-  in
-  M.m
-[%%expect{|
-- : string =
-"(code_path(main_module_name Test_510)(submodule_path())(enclosing_module M)(enclosing_value(m))(value())(fully_qualified_path Test_510))"
-|}]
-
-module Outer = struct
-  module Inner = struct
-    let code_path = [%code_path]
-  end
-end
-let _ = Outer.Inner.code_path
-[%%expect{|
-module Outer : sig module Inner : sig val code_path : string end end
-- : string =
-"(code_path(main_module_name Test_510)(submodule_path(Outer Inner))(enclosing_module Inner)(enclosing_value(code_path))(value(code_path))(fully_qualified_path Test_510.Outer.Inner.code_path))"
-|}]
-
-module Functor() = struct
-  let code_path = ref ""
-  module _ = struct
-    let x =
-      let module First_class = struct
-        code_path := [%code_path]
-      end in
-      let module _ = First_class in
-      ()
-    ;;
-
-    ignore x
-  end
-end
-let _ = let module M = Functor() in !M.code_path
-[%%expect{|
-module Functor : functor () -> sig val code_path : string ref end
-Line _, characters 23-32:
-Error (warning 73 [generative-application-expects-unit]): A generative functor
-should be applied to '()'; using '(struct end)' is deprecated.
-|}]
-
-module Actual = struct
-  let code_path = [%code_path]
-end [@enter_module Dummy]
-let _ = Actual.code_path
-[%%expect{|
-
-module Actual : sig val code_path : string end
-
-- : string =
-"(code_path(main_module_name Test_510)(submodule_path(Actual Dummy))(enclosing_module Dummy)(enclosing_value(code_path))(value(code_path))(fully_qualified_path Test_510.Actual.Dummy.code_path))"
-|}]
-
-module Ignore_me = struct
-  let code_path = [%code_path]
-end [@@do_not_enter_module]
-let _ = Ignore_me.code_path
-[%%expect{|
-
-module Ignore_me : sig val code_path : string end
-
-- : string =
-"(code_path(main_module_name Test_510)(submodule_path())(enclosing_module Test_510)(enclosing_value(code_path))(value(code_path))(fully_qualified_path Test_510.code_path))"
-|}]
-
-let _ =
-  (let module Ignore_me = struct
-     let code_path = [%code_path]
-   end
-   in
-   Ignore_me.code_path)
-  [@do_not_enter_module]
-[%%expect{|
-
-- : string =
-"(code_path(main_module_name Test_510)(submodule_path())(enclosing_module Test_510)(enclosing_value(code_path))(value())(fully_qualified_path Test_510))"
-|}]
-
-let _ = ([%code_path] [@ppxlib.enter_value dummy])
-[%%expect{|
-
-- : string =
-"(code_path(main_module_name Test_510)(submodule_path())(enclosing_module Test_510)(enclosing_value(dummy))(value(dummy))(fully_qualified_path Test_510.dummy))"
-|}]
-
-let _ =
-  let ignore_me = [%code_path]
-  [@@do_not_enter_value]
-  in
-  ignore_me
-[%%expect{|
-
-- : string =
-"(code_path(main_module_name Test_510)(submodule_path())(enclosing_module Test_510)(enclosing_value())(value())(fully_qualified_path Test_510))"
-|}]

From a66679b86bbbb2409783d2a9b73823603792c35e Mon Sep 17 00:00:00 2001
From: Paul-Elliot <peada@free.fr>
Date: Tue, 19 Sep 2023 09:08:24 +0200
Subject: [PATCH 20/31] 501<->500 migration: review comments

Signed-off-by: Paul-Elliot <peada@free.fr>
---
 astlib/migrate_501_500.ml | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/astlib/migrate_501_500.ml b/astlib/migrate_501_500.ml
index da4759ab8..b77cc75a4 100644
--- a/astlib/migrate_501_500.ml
+++ b/astlib/migrate_501_500.ml
@@ -792,15 +792,16 @@ and copy_module_expr_desc loc :
       let x1 =
         match x1.pmod_desc with
         | Pmod_structure [] ->
+           let loc = { x1.pmod_loc with loc_ghost = true } in
             let pmod_attributes =
               {
                 Ast_500.Parsetree.attr_name =
                   {
                     txt = "ppxlib.migration.keep_structure";
-                    loc = { x1.pmod_loc with loc_ghost = true };
+                    loc;
                   };
                 attr_payload = Ast_500.Parsetree.PStr [];
-                attr_loc = Location.none;
+                attr_loc = loc;
               }
               :: x1.pmod_attributes
             in

From 08aed5c61740a821aa984779e03457d472ed4ac5 Mon Sep 17 00:00:00 2001
From: Paul-Elliot <peada@free.fr>
Date: Tue, 19 Sep 2023 09:12:23 +0200
Subject: [PATCH 21/31] 501<->500 migration: changelog entry

Signed-off-by: Paul-Elliot <peada@free.fr>
---
 CHANGES.md | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/CHANGES.md b/CHANGES.md
index 41310895b..54560e8c3 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,6 +1,10 @@
 unreleased
 -------------------
 
+- Fix support for OCaml 5.1: migrated code preserves generative
+  functor warnings, without creating more. Locations are better
+  preserved. (#432, @pitag-ha, @panglesd)
+
 - Driver: Add `-unused-code-warnings` command-line flag. (#444, @ceastlund)
 
 - Add `?warning` flag to `Deriving.Generator.make`. (#440, @jacksonzou123 via @ceastlund)

From a0d0c351abdc37de4cf10de4a825ce2d92d65d8d Mon Sep 17 00:00:00 2001
From: Paul-Elliot <peada@free.fr>
Date: Tue, 19 Sep 2023 09:15:12 +0200
Subject: [PATCH 22/31] 501<->500 migrations: adding a test with attributes

Signed-off-by: Paul-Elliot <peada@free.fr>
---
 test/501_migrations/normal_migrations.t | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/test/501_migrations/normal_migrations.t b/test/501_migrations/normal_migrations.t
index 78965c17a..8e0de5f89 100644
--- a/test/501_migrations/normal_migrations.t
+++ b/test/501_migrations/normal_migrations.t
@@ -162,6 +162,13 @@ Tests for the Parsetree change for generative functor applications
   $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
   [1]
 
+  $ cat > file.ml << EOF
+  > module F () = struct end
+  > module M = F [@attr1] () [@attr2]
+  > EOF
+  $ ./compare_on.exe file.ml ./identity_driver.exe | grep -v "without_migrations" | grep -v "with_migrations"
+  [1]
+
   $ cat > file.ml << EOF
   > module F () = struct end
   > module M = F(struct end)

From 4026b795d9b9bd44beaf11b790a7f9a26fc0aa63 Mon Sep 17 00:00:00 2001
From: Paul-Elliot <peada@free.fr>
Date: Tue, 19 Sep 2023 10:02:53 +0200
Subject: [PATCH 23/31] formatting

Signed-off-by: Paul-Elliot <peada@free.fr>
---
 astlib/migrate_501_500.ml | 7 ++-----
 1 file changed, 2 insertions(+), 5 deletions(-)

diff --git a/astlib/migrate_501_500.ml b/astlib/migrate_501_500.ml
index b77cc75a4..a0a776e1c 100644
--- a/astlib/migrate_501_500.ml
+++ b/astlib/migrate_501_500.ml
@@ -792,14 +792,11 @@ and copy_module_expr_desc loc :
       let x1 =
         match x1.pmod_desc with
         | Pmod_structure [] ->
-           let loc = { x1.pmod_loc with loc_ghost = true } in
+            let loc = { x1.pmod_loc with loc_ghost = true } in
             let pmod_attributes =
               {
                 Ast_500.Parsetree.attr_name =
-                  {
-                    txt = "ppxlib.migration.keep_structure";
-                    loc;
-                  };
+                  { txt = "ppxlib.migration.keep_structure"; loc };
                 attr_payload = Ast_500.Parsetree.PStr [];
                 attr_loc = loc;
               }

From 4d0a186f7047a0512bf10abab06bffb81fdd2f69 Mon Sep 17 00:00:00 2001
From: Nicolas van Kempen <nicovank@users.noreply.github.com>
Date: Wed, 20 Sep 2023 11:12:49 +0100
Subject: [PATCH 24/31] Fix minor error in README

Signed-off-by: Nicolas van Kempen <nvankempen@fb.com>
---
 examples/simple-extension-rewriter/README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/examples/simple-extension-rewriter/README.md b/examples/simple-extension-rewriter/README.md
index 69eba73de..2f0c087bf 100644
--- a/examples/simple-extension-rewriter/README.md
+++ b/examples/simple-extension-rewriter/README.md
@@ -7,7 +7,7 @@ as a string.
 E.g., assuming we set `MY_VAR="foo"`, it will turn:
 
 ```ocaml
-let () = print_string [%get_env "foo"]
+let () = print_string [%get_env "MY_VAR"]
 ```
 
 into:

From e765a30151347f8044ce077d103d3828db8d5409 Mon Sep 17 00:00:00 2001
From: Sonja Heinze <sonjaleaheinze@gmail.com>
Date: Thu, 21 Sep 2023 15:09:46 +0200
Subject: [PATCH 25/31] Prepare release 0.31.0

Signed-off-by: Sonja Heinze <sonjaleaheinze@gmail.com>
---
 CHANGES.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/CHANGES.md b/CHANGES.md
index 54560e8c3..931467031 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,4 +1,4 @@
-unreleased
+0.31.0 (2023/09/21)
 -------------------
 
 - Fix support for OCaml 5.1: migrated code preserves generative

From af1756cfcfb6ebabd2ebf2234109cd50fce3f2f8 Mon Sep 17 00:00:00 2001
From: dianaoigo <127844136+dianaoigo@users.noreply.github.com>
Date: Tue, 26 Sep 2023 13:00:38 +0300
Subject: [PATCH 26/31] Add API to consider attributes as flag (#408)

Signed-off-by: dianaoigo <oigodmoraa@gmail.com>
Co-authored-by: Paul-Elliot <peada@free.fr>
---
 CHANGES.md                         |  5 ++++
 src/attribute.ml                   | 17 ++++++++++++++
 src/attribute.mli                  | 18 +++++++++++++++
 test/driver/attributes/test.ml     | 33 ++++++++++++++++++++++++++
 test/driver/attributes/test_510.ml | 37 ++++++++++++++++++++++++++++++
 5 files changed, 110 insertions(+)

diff --git a/CHANGES.md b/CHANGES.md
index 931467031..bffcc50a6 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,8 @@
+unreleased
+-------------------
+
+- Add API to manipulate attributes that are used as flags (#404, @dianaoigo)
+
 0.31.0 (2023/09/21)
 -------------------
 
diff --git a/src/attribute.ml b/src/attribute.ml
index 07cfa808a..2672715fa 100644
--- a/src/attribute.ml
+++ b/src/attribute.ml
@@ -297,6 +297,13 @@ let declare_with_attr_loc name context pattern k =
   declare_with_all_args name context pattern (fun ~attr_loc ~name_loc:_ ->
       k ~attr_loc)
 
+type 'a flag = ('a, unit) t
+
+let declare_flag name context =
+  let payload_pattern = Ast_pattern.(pstr nil) in
+  let continuation ~attr_loc:_ ~name_loc:_ = () in
+  declare_with_all_args name context payload_pattern continuation
+
 module Attribute_table = Caml.Hashtbl.Make (struct
   type t = string loc
 
@@ -356,6 +363,16 @@ let get t ?mark_as_seen:do_mark_as_seen x =
   get_res t ?mark_as_seen:do_mark_as_seen x
   |> Result.handle_error ~f:(fun (err, _) -> Location.Error.raise err)
 
+let has_flag_res t ?mark_as_seen x =
+  match get_res ?mark_as_seen t x with
+  | Ok (Some ()) -> Ok true
+  | Ok None -> Ok false
+  | Error _ as e -> e
+
+let has_flag t ?mark_as_seen x =
+  has_flag_res t ?mark_as_seen x
+  |> Result.handle_error ~f:(fun (err, _) -> Location.Error.raise err)
+
 let consume_res t x =
   let open Result in
   let attrs = Context.get_attributes t.context x in
diff --git a/src/attribute.mli b/src/attribute.mli
index 12f8d487d..fad528f23 100644
--- a/src/attribute.mli
+++ b/src/attribute.mli
@@ -135,6 +135,13 @@ val declare_with_attr_loc :
   ('a, 'c) t
 (** Same as [declare] but the callback receives the location of the attribute. *)
 
+type 'a flag = ('a, unit) t
+(** Types for attributes without payload. *)
+
+val declare_flag : string -> 'a Context.t -> 'a flag
+(** Same as {!declare}, but the payload is expected to be empty. It is supposed
+    to be used in conjunction with {!has_flag}. *)
+
 val name : _ t -> string
 val context : ('a, _) t -> 'a Context.t
 
@@ -150,6 +157,17 @@ val get :
   ('a, 'b) t -> ?mark_as_seen:bool (** default [true] *) -> 'a -> 'b option
 (** See {!get_res}. Raises a located error if the attribute is duplicated *)
 
+val has_flag_res :
+  'a flag ->
+  ?mark_as_seen:bool (** default [true] *) ->
+  'a ->
+  (bool, Location.Error.t NonEmptyList.t) result
+(** Answers whether the given flag is attached as an attribute. See {!get_res}
+    for the meaning of [mark_as_seen]. *)
+
+val has_flag : 'a flag -> ?mark_as_seen:bool (** default [true] *) -> 'a -> bool
+(** See {!has_flag_res}. Raises a located error if the attribute is duplicated. *)
+
 val consume_res :
   ('a, 'b) t -> 'a -> (('a * 'b) option, Location.Error.t NonEmptyList.t) result
 (** [consume_res t x] returns the value associated to attribute [t] on [x] if
diff --git a/test/driver/attributes/test.ml b/test/driver/attributes/test.ml
index 22bfacdff..6e5f1bb7d 100644
--- a/test/driver/attributes/test.ml
+++ b/test/driver/attributes/test.ml
@@ -169,3 +169,36 @@ let x = (42 [@baz.qux3])
 Line _, characters 14-22:
 Error: Attribute `baz.qux3' was silently dropped
 |}]
+
+(* Testing flags *)
+
+let flag = Attribute.declare_flag "flag" Attribute.Context.expression
+[%%expect{|
+val flag : expression Attribute.flag = <abstr>
+|}]
+
+let replace_flagged = object
+  inherit Ast_traverse.map as super
+
+  method! expression e =
+    match Attribute.has_flag_res flag e with
+    | Ok true -> Ast_builder.Default.estring ~loc:e.pexp_loc "Found flag"
+    | Ok false -> super#expression e
+    | Error (err, _) -> Ast_builder.Default.estring ~loc:e.pexp_loc (Location.Error.message err)
+end
+[%%expect{|
+val replace_flagged : Ast_traverse.map = <obj>
+|}]
+
+let () =
+  Driver.register_transformation "" ~impl:replace_flagged#structure
+
+let e1 = "flagged" [@flag]
+[%%expect{|
+val e1 : string = "Found flag"
+|}]
+
+let e1 = "flagged" [@flag 12]
+[%%expect{|
+val e1 : string = "[] expected"
+|}]
diff --git a/test/driver/attributes/test_510.ml b/test/driver/attributes/test_510.ml
index a007312a7..7f96affa5 100644
--- a/test/driver/attributes/test_510.ml
+++ b/test/driver/attributes/test_510.ml
@@ -192,3 +192,40 @@ let x = (42 [@baz.qux3])
 Line _, characters 14-22:
 Error: Attribute `baz.qux3' was silently dropped
 |}]
+
+(* Testing flags *)
+
+let flag = Attribute.declare_flag "flag" Attribute.Context.expression
+[%%expect{|
+
+val flag : expression Attribute.flag = <abstr>
+|}]
+
+let replace_flagged = object
+  inherit Ast_traverse.map as super
+
+  method! expression e =
+    match Attribute.has_flag_res flag e with
+    | Ok true -> Ast_builder.Default.estring ~loc:e.pexp_loc "Found flag"
+    | Ok false -> super#expression e
+    | Error (err, _) -> Ast_builder.Default.estring ~loc:e.pexp_loc (Location.Error.message err)
+end
+[%%expect{|
+
+val replace_flagged : Ast_traverse.map = <obj>
+|}]
+
+let () =
+  Driver.register_transformation "" ~impl:replace_flagged#structure
+
+let e1 = "flagged" [@flag]
+[%%expect{|
+
+val e1 : string = "Found flag"
+|}]
+
+let e1 = "flagged" [@flag 12]
+[%%expect{|
+
+val e1 : string = "[] expected"
+|}]

From 0d34ba5b154ff7c0d42c34f133898725eb24917e Mon Sep 17 00:00:00 2001
From: Carl Eastlund <ceastlund@janestreet.com>
Date: Fri, 7 Jul 2023 13:38:31 -0400
Subject: [PATCH 27/31] Changed dates in changelog to ISO 8601 format:
 YYYY-MM-DD.

Signed-off-by: Carl Eastlund <ceastlund@janestreet.com>
---
 CHANGES.md | 54 +++++++++++++++++++++++++++---------------------------
 1 file changed, 27 insertions(+), 27 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index bffcc50a6..246532d88 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -3,7 +3,7 @@ unreleased
 
 - Add API to manipulate attributes that are used as flags (#404, @dianaoigo)
 
-0.31.0 (2023/09/21)
+0.31.0 (2023-09-21)
 -------------------
 
 - Fix support for OCaml 5.1: migrated code preserves generative
@@ -22,7 +22,7 @@ unreleased
 
 - Attribute namespaces: Fix semantics of reserving multi-component namespaces (#443, @ncik-roberts)
 
-0.30.0 (20/06/2023)
+0.30.0 (2023-06-20)
 -------------------
 
 - Adopt the OCaml Code of Conduct on the repo (#426, @pitag-ha)
@@ -54,19 +54,19 @@ unreleased
 - Add support for OCaml 5.1, excluding OCaml `5.1.0~alpha1` (#428, @shym, @Octachron , @pitag-ha, @panglesd)
 - Driver: Fix `-locations-check` option for coercions with ground  (#428, @Octachron)
 
-0.29.1 (14/02/2023)
+0.29.1 (2023-02-14)
 ------------------
 
 - Allow users to vendor `ppxlib` as-is, as well as `ppx_sexp_conv` in the same project (#386, @kit-ty-kate)
 
-0.29.0 (06/02/2023)
+0.29.0 (2023-02-06)
 ------------------
 
 - Remove `File_path` exports. (#381, @ceastlund)
 
 - Add `Ppxlib.Expansion_helpers` with name mangling utilities from ppx_deriving (#370, @sim642)
 
-0.28.0 (05/10/2022)
+0.28.0 (2022-10-05)
 -------------------
 
 - Make `esequence` right-associative. (#366, @ceastlund)
@@ -82,7 +82,7 @@ unreleased
 
 - Add driver benchmarks (#376, @gridbugs)
 
-0.27.0 (14/06/2022)
+0.27.0 (2022-06-14)
 -------------------
 
 - Update expansion context to leave out value name when multiple are
@@ -115,17 +115,17 @@ unreleased
 - API: For each function that could raise a located error, add a function that
   return a `result` instead (#329, @panglesd)
 
-0.26.0 (21/03/2022)
+0.26.0 (2022-03-21)
 -------------------
 
 - Bump ppxlib's AST to 4.14/5.00 (#320, @pitag-ha)
 
-0.25.1 (17/06/2022)
+0.25.1 (2022-06-17)
 -------------------
 
 - Add support for OCaml 5.0 (#355, @pitag-ha)
 
-0.25.0 (03/03/2022)
+0.25.0 (2022-03-03)
 -------------------
 
 - Added `error_extensionf` function to the `Location` module (#316, @panglesd)
@@ -138,7 +138,7 @@ unreleased
 - Driver: Append the last valid AST to the error in case of located exception
   when embedding errors (#315, @panglesd)
 
-0.24.0 (08/12/2021)
+0.24.0 (2021-12-08)
 -------------------
 
 - Add support for OCaml 4.14 (#304, @kit-ty-kate)
@@ -160,7 +160,7 @@ unreleased
   payload (#299, @NathanReb)
 
 
-0.23.0 (31/08/2021)
+0.23.0 (2021-08-31)
 -------------------
 
 - Drop `Parser` from the API (#263, @pitag-ha)
@@ -212,27 +212,27 @@ unreleased
 - Expose a part of `Ast_io` in order to allow reading AST values from binary
  files (#270, @arozovyk)
 
-0.22.2 (23/06/2021)
+0.22.2 (2021-06-23)
 -------------------
 
 - Make ppxlib compatible with 4.13 compiler (#260, @kit-ty-kate)
 
-0.22.1 (10/06/2021)
+0.22.1 (2021-06-10)
 -------------------
 
 - Fix location in parse error reporting (#257, @pitag-ha)
 
-0.21.1 (09/06/2021)
+0.21.1 (2021-06-09)
 -------------------
 
 - Fix location in parse error reporting (#256, @pitag-ha)
 
-0.22.0 (04/02/2021)
+0.22.0 (2021-02-04)
 -------------------
 
 - Bump ppxlib's AST to 4.12 (#193, @NathanReb)
 
-0.21.0 (22/01/2021)
+0.21.0 (2021-01-22)
 -------------------
 
 - Fix ppxlib.traverse declaration and make it a deriver and not a rewriter
@@ -256,29 +256,29 @@ unreleased
 - Location.Error: add functions `raise` and `update_loc`
   (#205, @pitag-ha)
 
-0.20.0 (16/11/2020)
+0.20.0 (2020-11-16)
 -------------------
 
 - Expose `Ppxlib.Driver.map_signature` (#194, @kit-ty-kate)
 
-0.19.0 (23/10/2020)
+0.19.0 (2020-10-23)
 -------------------
 
 - Make ppxlib compatible with 4.12 compiler (#191, @kit-ty-kate)
 
-0.18.0 (06/10/2020)
+0.18.0 (2020-10-06)
 -------------------
 
 - Bump ppxlib's AST to 4.11 (#180, @NathanReb)
 
-0.17.0 (17/09/2020)
+0.17.0 (2020-09-17)
 -------------------
 
 - Add accessors for `code_path` and `tool_name` to `Expansion_context.Base`
   (#173, @jberdine)
 - Add `cases` methods to traversal classes in `Ast_traverse` (#183, @pitag-ha)
 
-0.16.0 (18/08/2020)
+0.16.0 (2020-08-18)
 -------------------
 
 - `Driver.register_transformation`: add optional parameter `~instrument`
@@ -286,7 +286,7 @@ unreleased
 - Add missing `Location.init` (#165, @pitag-ha)
 - Upgrade to ocaml-migrate-parsetree.2.0.0 (#164, @ceastlund)
 
-0.15.0 (04/08/2020)
+0.15.0 (2020-08-04)
 -------------------
 
 - Remove `base` and `stdio` dependencies (#151, @ceastlund)
@@ -297,7 +297,7 @@ unreleased
 
 - Implement name mangling for `ppxlib_traverse` (#159, @ceastlund)
 
-0.14.0 (08/07/2020)
+0.14.0 (2020-07-08)
 -------------------
 
 - Bump ppxlib's AST to 4.10 (#130, @NathanReb)
@@ -309,7 +309,7 @@ unreleased
   `structure` instead of a `Migrate_parsetree.Driver.some_structure`.
   (#153, @NathanReb)
 
-0.13.0 (04/15/2020)
+0.13.0 (2020-04-15)
 -------------------
 
 - Add 'metaquot.' prefix to disambiguate metaquote extensions (#121,
@@ -318,17 +318,17 @@ unreleased
 - Bump dune language to 1.11 since the cinaps extension requires at
   least Dune 1.11 (#126, @diml)
 
-0.12.0 (01/07/2020)
+0.12.0 (2020-01-07)
 -------------------
 
 - Support for OCaml 4.10 (#109, @xclerc)
 
-0.11.0 (01/07/2020)
+0.11.0 (2020-01-07)
 -------------------
 
 - Invariant check on locations (#107, @trefis)
 
-0.10.0 (11/21/2019)
+0.10.0 (2019-11-21)
 -------------------
 
 - Do not produce a suprious empty correction when deriving_inline

From be08601f738b2e6c14270f59e4cd7b05b3f5c263 Mon Sep 17 00:00:00 2001
From: Carl Eastlund <ceastlund@janestreet.com>
Date: Fri, 7 Jul 2023 13:41:56 -0400
Subject: [PATCH 28/31] Updated changelog for PR #445.

Signed-off-by: Carl Eastlund <ceastlund@janestreet.com>
---
 CHANGES.md | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/CHANGES.md b/CHANGES.md
index 246532d88..6ff7ec45d 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -3,6 +3,8 @@ unreleased
 
 - Add API to manipulate attributes that are used as flags (#404, @dianaoigo)
 
+- Update changelog to use ISO 8061 date format: YYYY-MM-DD. (#445, @ceastlund)
+
 0.31.0 (2023-09-21)
 -------------------
 

From 05eedda34c91b07d3600695e3bd79fb02b849e86 Mon Sep 17 00:00:00 2001
From: Carl Eastlund <ceastlund@janestreet.com>
Date: Wed, 14 Jun 2023 13:31:32 -0400
Subject: [PATCH 29/31] Replace Caml with Stdlib.

Signed-off-by: Carl Eastlund <ceastlund@janestreet.com>
---
 .../drivers/identity/inputs/bap_knowledge.ml  | 30 ++++----
 .../ppx_sexp_conv/inputs/bap_knowledge.ml     | 30 ++++----
 src/attribute.ml                              |  2 +-
 src/caller_id.ml                              |  2 +-
 src/code_matcher.ml                           | 12 ++--
 src/code_path.ml                              |  2 +-
 src/common.ml                                 |  4 +-
 src/deriving.ml                               |  6 +-
 src/driver.ml                                 | 68 ++++++++++---------
 src/driver.mli                                |  2 +-
 src/location.ml                               |  4 +-
 src/location.mli                              |  9 +--
 src/name.ml                                   |  4 +-
 src/reconcile.ml                              | 22 +++---
 src/utils.ml                                  | 10 +--
 stdppx/stdppx.ml                              |  2 -
 test/driver/transformations/test.ml           | 12 ++--
 test/driver/transformations/test_412.ml       | 12 ++--
 test/driver/transformations/test_510.ml       | 12 ++--
 19 files changed, 124 insertions(+), 121 deletions(-)

diff --git a/bench/drivers/identity/inputs/bap_knowledge.ml b/bench/drivers/identity/inputs/bap_knowledge.ml
index c3621dd8c..ba7e05881 100644
--- a/bench/drivers/identity/inputs/bap_knowledge.ml
+++ b/bench/drivers/identity/inputs/bap_knowledge.ml
@@ -24,9 +24,9 @@ type conflict = exn = ..
 module Conflict = struct
   type t = conflict = ..
 
-  let to_string = Caml.Printexc.to_string
+  let to_string = Stdlib.Printexc.to_string
   let pp ppf err = Format.fprintf ppf "%s" (to_string err)
-  let register_printer = Caml.Printexc.register_printer
+  let register_printer = Stdlib.Printexc.register_printer
   let sexp_of_t err = Sexp.Atom (to_string err)
 end
 
@@ -153,22 +153,22 @@ end = struct
 
     let rec find_exn t k =
       match t with
-      | Nil -> raise Caml.Not_found
+      | Nil -> raise Stdlib.Not_found
       | Tip (k', v) when k = k' -> v
-      | Tip _ -> raise Caml.Not_found
+      | Tip _ -> raise Stdlib.Not_found
       | Bin (k', l, r) -> (
           match Key.compare k' k with
-          | NA -> raise Caml.Not_found
+          | NA -> raise Stdlib.Not_found
           | LB -> find_exn l k
           | RB -> find_exn r k)
 
-    let find t k = try Some (find_exn t k) with Caml.Not_found -> None
+    let find t k = try Some (find_exn t k) with Stdlib.Not_found -> None
 
     let mem k t =
       try
         ignore (find_exn k t);
         true
-      with Caml.Not_found -> false
+      with Stdlib.Not_found -> false
 
     let node payload branching l r =
       match (l, r) with
@@ -359,7 +359,7 @@ end = struct
 
   let unescaped_exists_so_escape ?(skip_pos = -1) s =
     let buf = Buffer.create (String.length s + 1) in
-    Caml.StringLabels.iteri s ~f:(fun p c ->
+    Stdlib.StringLabels.iteri s ~f:(fun p c ->
         if p <> skip_pos && is_separator_unescaped s p c then
           Buffer.add_char buf escape_char;
         Buffer.add_char buf c);
@@ -555,7 +555,7 @@ end = struct
   let register ?(desc = "no description provided") ?package
       ?(reliability = trustworthy) name =
     let name = Name.create ?package name in
-    let agent = Caml.Digest.string (Name.show name) in
+    let agent = Stdlib.Digest.string (Name.show name) in
     if Hashtbl.mem agents agent then
       failwithf
         "An agent with name `%a' already exists, please choose another name"
@@ -2577,7 +2577,7 @@ module Knowledge = struct
         slot : Name.t;
         repr : string;
         error : Conflict.t;
-        trace : Caml.Printexc.raw_backtrace;
+        trace : Stdlib.Printexc.raw_backtrace;
       }
 
   let () =
@@ -2587,7 +2587,7 @@ module Knowledge = struct
           @@ Format.asprintf
                "Unable to update the slot %a of %s,\n%a\nBacktrace:\n%s" Name.pp
                slot repr Conflict.pp error
-               (Caml.Printexc.raw_backtrace_to_string trace)
+               (Stdlib.Printexc.raw_backtrace_to_string trace)
       | _ -> None)
 
   let non_monotonic slot obj error trace =
@@ -2626,7 +2626,7 @@ module Knowledge = struct
                     };
             }
         with Record.Merge_conflict err ->
-          non_monotonic slot obj err @@ Caml.Printexc.get_raw_backtrace ())
+          non_monotonic slot obj err @@ Stdlib.Printexc.get_raw_backtrace ())
 
   let notify { Slot.watchers } obj data =
     Hashtbl.data watchers
@@ -2698,7 +2698,7 @@ module Knowledge = struct
    fun slot obj ->
     objects slot.cls >>| fun { vals } ->
     match Oid.Tree.find_exn vals obj with
-    | exception Caml.Not_found -> Sleep
+    | exception Stdlib.Not_found -> Sleep
     | { data; comp = slots } -> (
         match Map.find slots (uid slot) with
         | Some (Work _) -> Awoke
@@ -2771,7 +2771,7 @@ module Knowledge = struct
    fun slot id ->
     objects slot.cls >>| fun { Env.vals } ->
     match Oid.Tree.find_exn vals id with
-    | exception Caml.Not_found -> slot.dom.empty
+    | exception Stdlib.Not_found -> slot.dom.empty
     | { data } -> Record.get slot.key slot.dom data
 
   let rec collect_inner : ('a, 'p) slot -> 'a obj -> _ -> _ =
@@ -3030,7 +3030,7 @@ module Knowledge = struct
     compute_value cls obj >>= fun () ->
     objects cls >>| fun { Env.vals } ->
     match Oid.Tree.find_exn vals obj with
-    | exception Caml.Not_found -> Value.empty cls
+    | exception Stdlib.Not_found -> Value.empty cls
     | { data = x } -> Value.create cls x
 
   let run cls obj s =
diff --git a/bench/drivers/ppx_sexp_conv/inputs/bap_knowledge.ml b/bench/drivers/ppx_sexp_conv/inputs/bap_knowledge.ml
index c3621dd8c..ba7e05881 100644
--- a/bench/drivers/ppx_sexp_conv/inputs/bap_knowledge.ml
+++ b/bench/drivers/ppx_sexp_conv/inputs/bap_knowledge.ml
@@ -24,9 +24,9 @@ type conflict = exn = ..
 module Conflict = struct
   type t = conflict = ..
 
-  let to_string = Caml.Printexc.to_string
+  let to_string = Stdlib.Printexc.to_string
   let pp ppf err = Format.fprintf ppf "%s" (to_string err)
-  let register_printer = Caml.Printexc.register_printer
+  let register_printer = Stdlib.Printexc.register_printer
   let sexp_of_t err = Sexp.Atom (to_string err)
 end
 
@@ -153,22 +153,22 @@ end = struct
 
     let rec find_exn t k =
       match t with
-      | Nil -> raise Caml.Not_found
+      | Nil -> raise Stdlib.Not_found
       | Tip (k', v) when k = k' -> v
-      | Tip _ -> raise Caml.Not_found
+      | Tip _ -> raise Stdlib.Not_found
       | Bin (k', l, r) -> (
           match Key.compare k' k with
-          | NA -> raise Caml.Not_found
+          | NA -> raise Stdlib.Not_found
           | LB -> find_exn l k
           | RB -> find_exn r k)
 
-    let find t k = try Some (find_exn t k) with Caml.Not_found -> None
+    let find t k = try Some (find_exn t k) with Stdlib.Not_found -> None
 
     let mem k t =
       try
         ignore (find_exn k t);
         true
-      with Caml.Not_found -> false
+      with Stdlib.Not_found -> false
 
     let node payload branching l r =
       match (l, r) with
@@ -359,7 +359,7 @@ end = struct
 
   let unescaped_exists_so_escape ?(skip_pos = -1) s =
     let buf = Buffer.create (String.length s + 1) in
-    Caml.StringLabels.iteri s ~f:(fun p c ->
+    Stdlib.StringLabels.iteri s ~f:(fun p c ->
         if p <> skip_pos && is_separator_unescaped s p c then
           Buffer.add_char buf escape_char;
         Buffer.add_char buf c);
@@ -555,7 +555,7 @@ end = struct
   let register ?(desc = "no description provided") ?package
       ?(reliability = trustworthy) name =
     let name = Name.create ?package name in
-    let agent = Caml.Digest.string (Name.show name) in
+    let agent = Stdlib.Digest.string (Name.show name) in
     if Hashtbl.mem agents agent then
       failwithf
         "An agent with name `%a' already exists, please choose another name"
@@ -2577,7 +2577,7 @@ module Knowledge = struct
         slot : Name.t;
         repr : string;
         error : Conflict.t;
-        trace : Caml.Printexc.raw_backtrace;
+        trace : Stdlib.Printexc.raw_backtrace;
       }
 
   let () =
@@ -2587,7 +2587,7 @@ module Knowledge = struct
           @@ Format.asprintf
                "Unable to update the slot %a of %s,\n%a\nBacktrace:\n%s" Name.pp
                slot repr Conflict.pp error
-               (Caml.Printexc.raw_backtrace_to_string trace)
+               (Stdlib.Printexc.raw_backtrace_to_string trace)
       | _ -> None)
 
   let non_monotonic slot obj error trace =
@@ -2626,7 +2626,7 @@ module Knowledge = struct
                     };
             }
         with Record.Merge_conflict err ->
-          non_monotonic slot obj err @@ Caml.Printexc.get_raw_backtrace ())
+          non_monotonic slot obj err @@ Stdlib.Printexc.get_raw_backtrace ())
 
   let notify { Slot.watchers } obj data =
     Hashtbl.data watchers
@@ -2698,7 +2698,7 @@ module Knowledge = struct
    fun slot obj ->
     objects slot.cls >>| fun { vals } ->
     match Oid.Tree.find_exn vals obj with
-    | exception Caml.Not_found -> Sleep
+    | exception Stdlib.Not_found -> Sleep
     | { data; comp = slots } -> (
         match Map.find slots (uid slot) with
         | Some (Work _) -> Awoke
@@ -2771,7 +2771,7 @@ module Knowledge = struct
    fun slot id ->
     objects slot.cls >>| fun { Env.vals } ->
     match Oid.Tree.find_exn vals id with
-    | exception Caml.Not_found -> slot.dom.empty
+    | exception Stdlib.Not_found -> slot.dom.empty
     | { data } -> Record.get slot.key slot.dom data
 
   let rec collect_inner : ('a, 'p) slot -> 'a obj -> _ -> _ =
@@ -3030,7 +3030,7 @@ module Knowledge = struct
     compute_value cls obj >>= fun () ->
     objects cls >>| fun { Env.vals } ->
     match Oid.Tree.find_exn vals obj with
-    | exception Caml.Not_found -> Value.empty cls
+    | exception Stdlib.Not_found -> Value.empty cls
     | { data = x } -> Value.create cls x
 
   let run cls obj s =
diff --git a/src/attribute.ml b/src/attribute.ml
index 2672715fa..f13e07cda 100644
--- a/src/attribute.ml
+++ b/src/attribute.ml
@@ -304,7 +304,7 @@ let declare_flag name context =
   let continuation ~attr_loc:_ ~name_loc:_ = () in
   declare_with_all_args name context payload_pattern continuation
 
-module Attribute_table = Caml.Hashtbl.Make (struct
+module Attribute_table = Stdlib.Hashtbl.Make (struct
   type t = string loc
 
   let hash : t -> int = Hashtbl.hash
diff --git a/src/caller_id.ml b/src/caller_id.ml
index 0c354eb86..14d566e9a 100644
--- a/src/caller_id.ml
+++ b/src/caller_id.ml
@@ -1,7 +1,7 @@
 (** Small helper to find out who is the caller of a function *)
 
 open! Import
-module Printexc = Caml.Printexc
+module Printexc = Stdlib.Printexc
 
 type t = Printexc.location option
 
diff --git a/src/code_matcher.ml b/src/code_matcher.ml
index 5a36b3b4d..052d23877 100644
--- a/src/code_matcher.ml
+++ b/src/code_matcher.ml
@@ -1,7 +1,7 @@
 (*$ open Ppxlib_cinaps_helpers $*)
 open! Import
-module Format = Caml.Format
-module Filename = Caml.Filename
+module Format = Stdlib.Format
+module Filename = Stdlib.Filename
 
 (* TODO: make the "deriving." depend on the matching attribute name. *)
 let end_marker_sig =
@@ -72,7 +72,9 @@ struct
 
   let diff_asts ~generated ~round_trip =
     let with_temp_file f =
-      Exn.protectx (Filename.temp_file "ppxlib" "") ~finally:Caml.Sys.remove ~f
+      Exn.protectx
+        (Filename.temp_file "ppxlib" "")
+        ~finally:Stdlib.Sys.remove ~f
     in
     with_temp_file (fun fn1 ->
         with_temp_file (fun fn2 ->
@@ -93,7 +95,7 @@ struct
                     (Filename.quote out)
                 in
                 let ok =
-                  Caml.Sys.command cmd = 1
+                  Stdlib.Sys.command cmd = 1
                   ||
                   let cmd =
                     Printf.sprintf
@@ -102,7 +104,7 @@ struct
                       (Filename.quote fn1) (Filename.quote fn2)
                       (Filename.quote out)
                   in
-                  Caml.Sys.command cmd = 1
+                  Stdlib.Sys.command cmd = 1
                 in
                 if ok then In_channel.read_all out
                 else "<no differences produced by diff>")))
diff --git a/src/code_path.ml b/src/code_path.ml
index 8e75866f6..f76713b28 100644
--- a/src/code_path.ml
+++ b/src/code_path.ml
@@ -12,7 +12,7 @@ type t = {
 
 let top_level ~file_path =
   let main_module_name =
-    file_path |> Caml.Filename.basename |> Caml.Filename.remove_extension
+    file_path |> Stdlib.Filename.basename |> Stdlib.Filename.remove_extension
     |> String.capitalize_ascii
   in
   {
diff --git a/src/common.ml b/src/common.ml
index 45c57eab1..12f5e5274 100644
--- a/src/common.ml
+++ b/src/common.ml
@@ -1,7 +1,7 @@
 open! Import
 open Ast_builder.Default
-module Buffer = Caml.Buffer
-module Format = Caml.Format
+module Buffer = Stdlib.Buffer
+module Format = Stdlib.Format
 
 let lident x = Longident.Lident x
 
diff --git a/src/deriving.ml b/src/deriving.ml
index e10a2d198..90e33fcab 100644
--- a/src/deriving.ml
+++ b/src/deriving.ml
@@ -10,7 +10,7 @@ let keep_w32_intf = ref false
 
 let () =
   let keep_w32_spec =
-    Caml.Arg.Symbol
+    Stdlib.Arg.Symbol
       ( [ "impl"; "intf"; "both" ],
         function
         | "impl" -> keep_w32_impl := true
@@ -21,7 +21,7 @@ let () =
         | _ -> assert false )
   in
   let conv_w32_spec =
-    Caml.Arg.Symbol
+    Stdlib.Arg.Symbol
       ( [ "code"; "attribute" ],
         function
         | "code" -> do_insert_unused_warning_attribute := false
@@ -44,7 +44,7 @@ let keep_w60_intf = ref false
 
 let () =
   let keep_w60_spec =
-    Caml.Arg.Symbol
+    Stdlib.Arg.Symbol
       ( [ "impl"; "intf"; "both" ],
         function
         | "impl" -> keep_w60_impl := true
diff --git a/src/driver.ml b/src/driver.ml
index 77898d459..914f59417 100644
--- a/src/driver.ml
+++ b/src/driver.ml
@@ -3,9 +3,9 @@ open Import
 open Utils
 open Common
 open With_errors
-module Arg = Caml.Arg
+module Arg = Stdlib.Arg
 
-let exe_name = Caml.Filename.basename Caml.Sys.executable_name
+let exe_name = Stdlib.Filename.basename Stdlib.Sys.executable_name
 let args = ref []
 let add_arg key spec ~doc = args := (key, spec, doc) :: !args
 let loc_fname = ref None
@@ -172,7 +172,7 @@ module Transform = struct
       ?impl ?intf ?lint_impl ?lint_intf ?preprocess_impl ?preprocess_intf
       ?instrument ?(aliases = []) name =
     let rules = List.map extensions ~f:Context_free.Rule.extension @ rules in
-    let caller_id = Caller_id.get ~skip:[ Caml.__FILE__ ] in
+    let caller_id = Caller_id.get ~skip:[ Stdlib.__FILE__ ] in
     (match List.filter !all ~f:(fun ct -> has_name ct name) with
     | [] -> ()
     | ct :: _ ->
@@ -449,8 +449,8 @@ let debug_dropped_attribute name ~old_dropped ~new_dropped =
       Printf.eprintf "The following attributes %s after applying %s:\n" what
         name;
       List.iter diff ~f:(fun { Location.txt; loc } ->
-          Caml.Format.eprintf "- %a: %s\n" Location.print loc txt);
-      Caml.Format.eprintf "@.")
+          Stdlib.Format.eprintf "- %a: %s\n" Location.print loc txt);
+      Stdlib.Format.eprintf "@.")
   in
   print_diff "disappeared" new_dropped old_dropped;
   print_diff "reappeared" old_dropped new_dropped
@@ -824,7 +824,7 @@ let versioned_errorf input_version input_file_name =
       in
       Error (err, input_version))
 
-let remove_no_error fn = try Caml.Sys.remove fn with Sys_error _ -> ()
+let remove_no_error fn = try Stdlib.Sys.remove fn with Sys_error _ -> ()
 
 let protectx x ~f ~finally =
   match f x with
@@ -839,7 +839,7 @@ let with_preprocessed_file fn ~f =
   match !preprocessor with
   | None -> f fn
   | Some pp ->
-      protectx (Caml.Filename.temp_file "ocamlpp" "") ~finally:remove_no_error
+      protectx (Stdlib.Filename.temp_file "ocamlpp" "") ~finally:remove_no_error
         ~f:(fun tmpfile ->
           match System.run_preprocessor ~pp ~input:fn ~output:tmpfile with
           | Ok () -> f tmpfile
@@ -1143,7 +1143,7 @@ let process_file (kind : Kind.t) fn ~input_name ~relocate ~output_mode
   let mismatches_found =
     match !corrections with
     | [] ->
-        if Caml.Sys.file_exists corrected then Caml.Sys.remove corrected;
+        if Stdlib.Sys.file_exists corrected then Stdlib.Sys.remove corrected;
         false
     | corrections ->
         Reconcile.reconcile corrections
@@ -1157,14 +1157,14 @@ let process_file (kind : Kind.t) fn ~input_name ~relocate ~output_mode
   | Null -> ()
   | Pretty_print ->
       with_output output ~binary:false ~f:(fun oc ->
-          let ppf = Caml.Format.formatter_of_out_channel oc in
+          let ppf = Stdlib.Format.formatter_of_out_channel oc in
           (match ast with
           | Intf ast -> Pprintast.signature ppf ast
           | Impl ast -> Pprintast.structure ppf ast);
           let null_ast =
             match ast with Intf [] | Impl [] -> true | _ -> false
           in
-          if not null_ast then Caml.Format.pp_print_newline ppf ())
+          if not null_ast then Stdlib.Format.pp_print_newline ppf ())
   | Dump_ast ->
       with_output output ~binary:true ~f:(fun oc ->
           Ast_io.write oc
@@ -1172,12 +1172,12 @@ let process_file (kind : Kind.t) fn ~input_name ~relocate ~output_mode
             ~add_ppx_context:true)
   | Dparsetree ->
       with_output output ~binary:false ~f:(fun oc ->
-          let ppf = Caml.Format.formatter_of_out_channel oc in
+          let ppf = Stdlib.Format.formatter_of_out_channel oc in
           let ast = add_cookies ast in
           (match ast with
           | Intf ast -> Sexp.pp_hum ppf (Ast_traverse.sexp_of#signature ast)
           | Impl ast -> Sexp.pp_hum ppf (Ast_traverse.sexp_of#structure ast));
-          Caml.Format.pp_print_newline ppf ())
+          Stdlib.Format.pp_print_newline ppf ())
   | Reconcile mode ->
       Reconcile.reconcile !replacements
         ~contents:(Lazy.force input_contents)
@@ -1189,7 +1189,7 @@ let process_file (kind : Kind.t) fn ~input_name ~relocate ~output_mode
   then (
     Ppxlib_print_diff.print () ~file1:fn ~file2:corrected ~use_color:!use_color
       ?diff_command:!diff_command;
-    Caml.exit 1)
+    Stdlib.exit 1)
 
 let output_mode = ref Pretty_print
 let output = ref None
@@ -1243,7 +1243,7 @@ let parse_apply_list s =
                Transform.has_name ct name))
       then
         raise
-          (Caml.Arg.Bad
+          (Stdlib.Arg.Bad
              (Printf.sprintf "code transformation '%s' does not exist" name)));
   names
 
@@ -1442,14 +1442,14 @@ let standalone_main () =
   interpret_mask ();
   if !request_print_transformations then (
     print_transformations ();
-    Caml.exit 0);
+    Stdlib.exit 0);
   if !request_print_passes then (
     print_passes ();
-    Caml.exit 0);
+    Stdlib.exit 0);
   match !input with
   | None ->
       Printf.eprintf "%s: no input file given\n%!" exe_name;
-      Caml.exit 2
+      Stdlib.exit 2
   | Some fn ->
       let kind =
         match !kind with
@@ -1461,7 +1461,7 @@ let standalone_main () =
                 Printf.eprintf
                   "%s: don't know what to do with '%s', use -impl or -intf.\n"
                   exe_name fn;
-                Caml.exit 2)
+                Stdlib.exit 2)
       in
       let input_name, relocate =
         match !loc_fname with None -> (fn, false) | Some fn -> (fn, true)
@@ -1492,10 +1492,10 @@ let parse_input passed_in_args ~valid_args ~incorrect_input_msg =
   with
   | Arg.Bad msg ->
       Printf.eprintf "%s" msg;
-      Caml.exit 2
+      Stdlib.exit 2
   | Arg.Help msg ->
       Printf.eprintf "%s" msg;
-      Caml.exit 0
+      Stdlib.exit 0
 
 let run_as_ppx_rewriter_main ~standalone_args ~usage input =
   let valid_args = get_args ~standalone_args () in
@@ -1506,23 +1506,23 @@ let run_as_ppx_rewriter_main ~standalone_args ~usage input =
       parse_input prog_name_and_flags ~valid_args ~incorrect_input_msg:usage;
       interpret_mask ();
       rewrite_binary_ast_file input_fn output_fn;
-      Caml.exit 0
+      Stdlib.exit 0
   | [ help; _ ] when String.equal help "-help" || String.equal help "--help" ->
       parse_input input ~valid_args ~incorrect_input_msg:usage;
       assert false
   | _ ->
       Printf.eprintf "Usage: %s\n%!" usage;
-      Caml.exit 2
+      Stdlib.exit 2
 
 let standalone_run_as_ppx_rewriter () =
-  let n = Array.length Caml.Sys.argv in
+  let n = Array.length Stdlib.Sys.argv in
   let usage =
     Printf.sprintf "%s -as-ppx [extra_args] <infile> <outfile>" exe_name
   in
   let argv = Array.make (n - 1) "" in
-  argv.(0) <- Caml.Sys.argv.(0);
+  argv.(0) <- Stdlib.Sys.argv.(0);
   for i = 1 to n - 2 do
-    argv.(i) <- Caml.Sys.argv.(i + 1)
+    argv.(i) <- Stdlib.Sys.argv.(i + 1)
   done;
   let standalone_args =
     List.map standalone_args ~f:(fun (arg, spec, _doc) ->
@@ -1534,23 +1534,25 @@ let standalone () =
   Astlib.init_error_reporting_style_using_env_vars ();
   try
     if
-      Array.length Caml.Sys.argv >= 2
+      Array.length Stdlib.Sys.argv >= 2
       &&
-      match Caml.Sys.argv.(1) with "-as-ppx" | "--as-ppx" -> true | _ -> false
+      match Stdlib.Sys.argv.(1) with
+      | "-as-ppx" | "--as-ppx" -> true
+      | _ -> false
     then standalone_run_as_ppx_rewriter ()
     else standalone_main ();
-    Caml.exit 0
+    Stdlib.exit 0
   with exn ->
-    Location.report_exception Caml.Format.err_formatter exn;
-    Caml.exit 1
+    Location.report_exception Stdlib.Format.err_formatter exn;
+    Stdlib.exit 1
 
 let run_as_ppx_rewriter () =
   let usage = Printf.sprintf "%s [extra_args] <infile> <outfile>" exe_name in
-  let input = Caml.Sys.argv in
+  let input = Stdlib.Sys.argv in
   try run_as_ppx_rewriter_main ~standalone_args:[] ~usage input
   with exn ->
-    Location.report_exception Caml.Format.err_formatter exn;
-    Caml.exit 1
+    Location.report_exception Stdlib.Format.err_formatter exn;
+    Stdlib.exit 1
 
 let pretty () = !pretty
 
diff --git a/src/driver.mli b/src/driver.mli
index cdc7061dc..41a759828 100644
--- a/src/driver.mli
+++ b/src/driver.mli
@@ -6,7 +6,7 @@
 
 open Import
 
-val add_arg : Caml.Arg.key -> Caml.Arg.spec -> doc:string -> unit
+val add_arg : Stdlib.Arg.key -> Stdlib.Arg.spec -> doc:string -> unit
 (** Add one argument to the command line *)
 
 (** Error reported by linters *)
diff --git a/src/location.ml b/src/location.ml
index 8de4cedda..54daa6397 100644
--- a/src/location.ml
+++ b/src/location.ml
@@ -34,7 +34,7 @@ let of_lexbuf (lexbuf : Lexing.lexbuf) =
   }
 
 let print ppf t =
-  Caml.Format.fprintf ppf "File \"%s\", line %d, characters %d-%d:"
+  Stdlib.Format.fprintf ppf "File \"%s\", line %d, characters %d-%d:"
     t.loc_start.pos_fname t.loc_start.pos_lnum
     (t.loc_start.pos_cnum - t.loc_start.pos_bol)
     (t.loc_end.pos_cnum - t.loc_start.pos_bol)
@@ -76,6 +76,6 @@ let error_extensionf ~loc fmt =
 exception Error = L.Error
 
 let () =
-  Caml.Printexc.register_printer (function
+  Stdlib.Printexc.register_printer (function
     | Error e -> Some (Error.message e)
     | _ -> None)
diff --git a/src/location.mli b/src/location.mli
index 642b9ab78..a6f4f6b54 100644
--- a/src/location.mli
+++ b/src/location.mli
@@ -27,7 +27,8 @@ val init : Lexing.lexbuf -> string -> unit
 (** Set the file name and line number of the [lexbuf] to be the start of the
     named file. *)
 
-val raise_errorf : ?loc:t -> ('a, Caml.Format.formatter, unit, 'b) format4 -> 'a
+val raise_errorf :
+  ?loc:t -> ('a, Stdlib.Format.formatter, unit, 'b) format4 -> 'a
 (** Raise a located error. Should be avoided as much as possible, in favor of
     {!error_extensionf}. See the {{!"good-practices".handling_errors} relevant}
     part of the tutorial. *)
@@ -35,10 +36,10 @@ val raise_errorf : ?loc:t -> ('a, Caml.Format.formatter, unit, 'b) format4 -> 'a
 val of_lexbuf : Lexing.lexbuf -> t
 (** Return the location corresponding to the last matched regular expression *)
 
-val report_exception : Caml.Format.formatter -> exn -> unit
+val report_exception : Stdlib.Format.formatter -> exn -> unit
 (** Report an exception on the given formatter *)
 
-val print : Caml.Format.formatter -> t -> unit
+val print : Stdlib.Format.formatter -> t -> unit
 (** Prints [File "...", line ..., characters ...-...:] *)
 
 type nonrec 'a loc = 'a loc = { txt : 'a; loc : t }
@@ -59,7 +60,7 @@ module Error : sig
   val make : loc:location -> string -> sub:(location * string) list -> t
 
   val createf :
-    loc:location -> ('a, Caml.Format.formatter, unit, t) format4 -> 'a
+    loc:location -> ('a, Stdlib.Format.formatter, unit, t) format4 -> 'a
 
   val message : t -> string
   val set_message : t -> string -> t
diff --git a/src/name.ml b/src/name.ml
index 357b7a1c0..76d9d6284 100644
--- a/src/name.ml
+++ b/src/name.ml
@@ -1,5 +1,5 @@
 open! Import
-module Format = Caml.Format
+module Format = Stdlib.Format
 
 let fold_dot_suffixes name ~init:acc ~f =
   let rec collapse_after_at = function
@@ -218,7 +218,7 @@ module Registrar = struct
     | Some e ->
         let declared_at = function
           | None -> ""
-          | Some (loc : Caml.Printexc.location) ->
+          | Some (loc : Stdlib.Printexc.location) ->
               Printf.sprintf " declared at %s:%d" loc.filename loc.line_number
         in
         let context =
diff --git a/src/reconcile.ml b/src/reconcile.ml
index eba810d63..b148d4d21 100644
--- a/src/reconcile.ml
+++ b/src/reconcile.ml
@@ -6,9 +6,9 @@ module Context = struct
     | Extension of 'a Extension.Context.t
     | Floating_attribute of 'a Attribute.Floating.Context.t
 
-  let paren pp ppf x = Caml.Format.fprintf ppf "(%a)" pp x
+  let paren pp ppf x = Stdlib.Format.fprintf ppf "(%a)" pp x
 
-  let printer : type a. a t -> Caml.Format.formatter -> a -> unit =
+  let printer : type a. a t -> Stdlib.Format.formatter -> a -> unit =
     let open Extension.Context in
     let open Attribute.Floating.Context in
     function
@@ -51,13 +51,13 @@ module Replacement = struct
         let s =
           let printer = Context.printer context in
           match generated with
-          | Single x -> Caml.Format.asprintf "%a" printer x
+          | Single x -> Stdlib.Format.asprintf "%a" printer x
           | Many l ->
-              Caml.Format.asprintf "%a"
+              Stdlib.Format.asprintf "%a"
                 (fun ppf l ->
                   List.iter l ~f:(fun x ->
                       printer ppf x;
-                      Caml.Format.pp_print_newline ppf ()))
+                      Stdlib.Format.pp_print_newline ppf ()))
                 l
         in
         let is_ws = function ' ' | '\t' | '\r' -> true | _ -> false in
@@ -169,24 +169,24 @@ let with_output ~styler ~(kind : Kind.t) fn ~f =
   | None -> with_output fn ~binary:false ~f
   | Some cmd ->
       let tmp_fn, oc =
-        Caml.Filename.open_temp_file "ppxlib_driver"
+        Stdlib.Filename.open_temp_file "ppxlib_driver"
           (match kind with Impl -> ".ml" | Intf -> ".mli")
       in
       let cmd =
         Printf.sprintf "%s %s%s" cmd
-          (Caml.Filename.quote tmp_fn)
+          (Stdlib.Filename.quote tmp_fn)
           (match fn with
           | None -> ""
-          | Some fn -> " > " ^ Caml.Filename.quote fn)
+          | Some fn -> " > " ^ Stdlib.Filename.quote fn)
       in
       let n =
-        Exn.protectx tmp_fn ~finally:Caml.Sys.remove ~f:(fun _ ->
+        Exn.protectx tmp_fn ~finally:Stdlib.Sys.remove ~f:(fun _ ->
             Exn.protectx oc ~finally:close_out ~f;
-            Caml.Sys.command cmd)
+            Stdlib.Sys.command cmd)
       in
       if n <> 0 then (
         Printf.eprintf "command exited with code %d: %s\n" n cmd;
-        Caml.exit 1)
+        Stdlib.exit 1)
 
 let reconcile ?styler (repls : Replacements.t) ~kind ~contents ~input_filename
     ~output ~input_name ~target =
diff --git a/src/utils.ml b/src/utils.ml
index 5dedb6eb6..555e604ce 100644
--- a/src/utils.ml
+++ b/src/utils.ml
@@ -9,8 +9,8 @@ module Kind = struct
   type t = Intf | Impl
 
   let of_filename fn : t option =
-    if Caml.Filename.check_suffix fn ".ml" then Some Impl
-    else if Caml.Filename.check_suffix fn ".mli" then Some Intf
+    if Stdlib.Filename.check_suffix fn ".ml" then Some Impl
+    else if Stdlib.Filename.check_suffix fn ".mli" then Some Intf
     else None
 
   let describe = function Impl -> "implementation" | Intf -> "interface"
@@ -213,9 +213,9 @@ module System = struct
   let run_preprocessor ~pp ~input ~output =
     let command =
       Printf.sprintf "%s %s > %s" pp
-        (if String.equal input "-" then "" else Caml.Filename.quote input)
-        (Caml.Filename.quote output)
+        (if String.equal input "-" then "" else Stdlib.Filename.quote input)
+        (Stdlib.Filename.quote output)
     in
-    if Caml.Sys.command command = 0 then Ok ()
+    if Stdlib.Sys.command command = 0 then Ok ()
     else Error (command, Ast_io.fall_back_input_version)
 end
diff --git a/stdppx/stdppx.ml b/stdppx/stdppx.ml
index b3a81e77d..b0102c394 100644
--- a/stdppx/stdppx.ml
+++ b/stdppx/stdppx.ml
@@ -1,5 +1,3 @@
-module Caml = Stdlib
-open Caml
 open StdLabels
 module Sexp = Sexplib0.Sexp
 module Sexpable = Sexplib0.Sexpable
diff --git a/test/driver/transformations/test.ml b/test/driver/transformations/test.ml
index 48ea804b4..1f13cfadf 100644
--- a/test/driver/transformations/test.ml
+++ b/test/driver/transformations/test.ml
@@ -56,17 +56,17 @@ let () =
 [%%expect{|
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop]
 [%%expect{|
 - : string = "-\n"
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop.Truc]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop.Truc]
 [%%expect{|
 - : string = "Truc\n"
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop.Truc.Bidule]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop.Truc.Bidule]
 [%%expect{|
 - : string = "Truc.Bidule\n"
 |}]
@@ -89,17 +89,17 @@ let () =
 [%%expect{|
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop_ctxt]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt]
 [%%expect{|
 - : string = "-\n"
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop_ctxt.Truc]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt.Truc]
 [%%expect{|
 - : string = "Truc\n"
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop_ctxt.Truc.Bidule]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt.Truc.Bidule]
 [%%expect{|
 - : string = "Truc.Bidule\n"
 |}]
diff --git a/test/driver/transformations/test_412.ml b/test/driver/transformations/test_412.ml
index d7ea35a2e..d386d438a 100644
--- a/test/driver/transformations/test_412.ml
+++ b/test/driver/transformations/test_412.ml
@@ -56,17 +56,17 @@ let () =
 [%%expect{|
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop]
 [%%expect{|
 - : string = "-\n"
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop.Truc]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop.Truc]
 [%%expect{|
 - : string = "Truc\n"
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop.Truc.Bidule]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop.Truc.Bidule]
 [%%expect{|
 - : string = "Truc.Bidule\n"
 |}]
@@ -89,17 +89,17 @@ let () =
 [%%expect{|
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop_ctxt]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt]
 [%%expect{|
 - : string = "-\n"
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop_ctxt.Truc]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt.Truc]
 [%%expect{|
 - : string = "Truc\n"
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop_ctxt.Truc.Bidule]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt.Truc.Bidule]
 [%%expect{|
 - : string = "Truc.Bidule\n"
 |}]
diff --git a/test/driver/transformations/test_510.ml b/test/driver/transformations/test_510.ml
index 596c43b74..cd8f0d20b 100644
--- a/test/driver/transformations/test_510.ml
+++ b/test/driver/transformations/test_510.ml
@@ -56,19 +56,19 @@ let () =
 [%%expect{|
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop]
 [%%expect{|
 
 - : string = "-\n"
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop.Truc]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop.Truc]
 [%%expect{|
 
 - : string = "Truc\n"
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop.Truc.Bidule]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop.Truc.Bidule]
 [%%expect{|
 
 - : string = "Truc.Bidule\n"
@@ -92,19 +92,19 @@ let () =
 [%%expect{|
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop_ctxt]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt]
 [%%expect{|
 
 - : string = "-\n"
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop_ctxt.Truc]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt.Truc]
 [%%expect{|
 
 - : string = "Truc\n"
 |}]
 
-let _ = Caml.Printf.sprintf "%s\n" [%plop_ctxt.Truc.Bidule]
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt.Truc.Bidule]
 [%%expect{|
 
 - : string = "Truc.Bidule\n"

From 2bfa317c0bccde38b3f1a75bcd5e9de45ade8fb2 Mon Sep 17 00:00:00 2001
From: Carl Eastlund <ceastlund@janestreet.com>
Date: Wed, 14 Jun 2023 13:35:07 -0400
Subject: [PATCH 30/31] Updated changelog for Caml->Stdlib change.

Signed-off-by: Carl Eastlund <ceastlund@janestreet.com>
---
 CHANGES.md | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/CHANGES.md b/CHANGES.md
index 6ff7ec45d..397261272 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -29,6 +29,8 @@ unreleased
 
 - Adopt the OCaml Code of Conduct on the repo (#426, @pitag-ha)
 
+- Replace `Caml` with `Stdlib`. (#427, @ceastlund)
+
 - Clean up misleading attribute hints when declared for proper context. (#425, @ceastlund)
 
 - Ast_pattern now has ebool, pbool helper, and a new map.(#402, @burnleydev1)

From df3f389eb0d25a7bdc4f901ecab84265b892895f Mon Sep 17 00:00:00 2001
From: Carl Eastlund <ceastlund@janestreet.com>
Date: Wed, 14 Jun 2023 13:40:41 -0400
Subject: [PATCH 31/31] Restored Caml alias with deprecation so clients can
 upgrade more easily.

Signed-off-by: Carl Eastlund <ceastlund@janestreet.com>
---
 stdppx/stdppx.ml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/stdppx/stdppx.ml b/stdppx/stdppx.ml
index b0102c394..2bcc4b8e0 100644
--- a/stdppx/stdppx.ml
+++ b/stdppx/stdppx.ml
@@ -1,3 +1,5 @@
+module Caml = Stdlib [@@deprecated "[since 2023-06] use Stdlib instead"]
+open Stdlib
 open StdLabels
 module Sexp = Sexplib0.Sexp
 module Sexpable = Sexplib0.Sexpable