diff --git a/doc/tests_src/ocaml_datatype_basic.md b/doc/tests_src/ocaml_datatype_basic.md
old mode 100755
new mode 100644
index 725df8e..b406e4c
--- a/doc/tests_src/ocaml_datatype_basic.md
+++ b/doc/tests_src/ocaml_datatype_basic.md
@@ -210,7 +210,7 @@ module Caml :
   sig
     module Ppxlib = Ppxlib
     module Astlib = Astlib
-    module Pprintast = Astlib.Pprintast
+    module Emitter = Bindoj_gen.Emitter
     module CommonTypes : sig ... end
     type signature_item = CommonTypes.signature_item
     type signature = CommonTypes.signature
diff --git a/example/ex01/generated/ex01.ml b/example/ex01/generated/ex01.ml
index bbf84e9..3a75efa 100644
--- a/example/ex01/generated/ex01.ml
+++ b/example/ex01/generated/ex01.ml
@@ -1,4 +1,5 @@
-type nonrec my_int = int [@@ocaml.doc "definition of my_int type"]
+type nonrec my_int = int
+(** definition of my_int type *)
 
 let (my_int_reflect : _ Bindoj_runtime.Refl.t) =
   lazy
@@ -52,7 +53,7 @@ and my_int_of_json =
 [@@warning "-39"]
 
 type nonrec my_tuple = float * string
-[@@ocaml.doc "definition of my_tuple type"]
+(** definition of my_tuple type *)
 
 let (my_tuple_reflect : _ Bindoj_runtime.Refl.t) =
   lazy
@@ -149,10 +150,10 @@ and my_tuple_of_json =
 [@@warning "-39"]
 
 type student = {
-  admission_year : int; [@ocaml.doc "addmission_year field"]
-  name : string; [@ocaml.doc "name field"]
+  admission_year : int;  (** 📅 addmission_year field *)
+  name : string;  (** 📛 name field *)
 }
-[@@ocaml.doc "definition of student type"]
+(** 📝 definition of student type *)
 
 let rec (student_reflect : _ Bindoj_runtime.Refl.t) =
   lazy
@@ -259,19 +260,19 @@ and student_of_json =
     : Kxclib.Json.jv -> student option)
 [@@warning "-39"]
 
+(** definition of person type *)
 type person =
-  | Anonymous [@ocaml.doc "Anonymous constructor"]
-  | With_id of int [@ocaml.doc "With_id constructor"]
+  | Anonymous  (** Anonymous constructor *)
+  | With_id of int  (** With_id constructor *)
   | Student of {
-      student_id : int; [@ocaml.doc "student_id field in Student constructor"]
-      name : string; [@ocaml.doc "name field in Student constructor"]
-    } [@ocaml.doc "Student constructor"]
+      student_id : int;  (** student_id field in Student constructor *)
+      name : string;  (** name field in Student constructor *)
+    }  (** Student constructor *)
   | Teacher of {
-      faculty_id : int; [@ocaml.doc "faculty_id field in Teacher constructor"]
-      name : string; [@ocaml.doc "name field in Teacher constructor"]
-      department : string; [@ocaml.doc "dapartment field in Teacher constructor"]
-    } [@ocaml.doc "Teacher constructor"]
-[@@ocaml.doc "definition of person type"]
+      faculty_id : int;  (** faculty_id field in Teacher constructor *)
+      name : string;  (** name field in Teacher constructor *)
+      department : string;  (** dapartment field in Teacher constructor *)
+    }  (** Teacher constructor *)
 
 let rec (person_reflect : _ Bindoj_runtime.Refl.t) =
   lazy
diff --git a/example/ex01/generated/ex01.mli b/example/ex01/generated/ex01.mli
index b6bef6c..470c3f1 100644
--- a/example/ex01/generated/ex01.mli
+++ b/example/ex01/generated/ex01.mli
@@ -1,4 +1,5 @@
-type nonrec my_int = int [@@ocaml.doc "definition of my_int type"]
+type nonrec my_int = int
+(** definition of my_int type *)
 
 val my_int_reflect : my_int Bindoj_runtime.Refl.t
 val my_int_json_shape_explanation : Bindoj_runtime.json_shape_explanation
@@ -7,7 +8,7 @@ val my_int_of_json' : my_int Bindoj_runtime.json_full_decoder
 val my_int_of_json : Kxclib.Json.jv -> my_int option
 
 type nonrec my_tuple = float * string
-[@@ocaml.doc "definition of my_tuple type"]
+(** definition of my_tuple type *)
 
 val my_tuple_reflect : my_tuple Bindoj_runtime.Refl.t
 val my_tuple_json_shape_explanation : Bindoj_runtime.json_shape_explanation
@@ -16,10 +17,10 @@ val my_tuple_of_json' : my_tuple Bindoj_runtime.json_full_decoder
 val my_tuple_of_json : Kxclib.Json.jv -> my_tuple option
 
 type student = {
-  admission_year : int; [@ocaml.doc "addmission_year field"]
-  name : string; [@ocaml.doc "name field"]
+  admission_year : int;  (** 📅 addmission_year field *)
+  name : string;  (** 📛 name field *)
 }
-[@@ocaml.doc "definition of student type"]
+(** 📝 definition of student type *)
 
 val student_reflect : student Bindoj_runtime.Refl.t
 val student_json_shape_explanation : Bindoj_runtime.json_shape_explanation
@@ -27,19 +28,19 @@ val student_to_json : student -> Kxclib.Json.jv
 val student_of_json' : student Bindoj_runtime.json_full_decoder
 val student_of_json : Kxclib.Json.jv -> student option
 
+(** definition of person type *)
 type person =
-  | Anonymous [@ocaml.doc "Anonymous constructor"]
-  | With_id of int [@ocaml.doc "With_id constructor"]
+  | Anonymous  (** Anonymous constructor *)
+  | With_id of int  (** With_id constructor *)
   | Student of {
-      student_id : int; [@ocaml.doc "student_id field in Student constructor"]
-      name : string; [@ocaml.doc "name field in Student constructor"]
-    } [@ocaml.doc "Student constructor"]
+      student_id : int;  (** student_id field in Student constructor *)
+      name : string;  (** name field in Student constructor *)
+    }  (** Student constructor *)
   | Teacher of {
-      faculty_id : int; [@ocaml.doc "faculty_id field in Teacher constructor"]
-      name : string; [@ocaml.doc "name field in Teacher constructor"]
-      department : string; [@ocaml.doc "dapartment field in Teacher constructor"]
-    } [@ocaml.doc "Teacher constructor"]
-[@@ocaml.doc "definition of person type"]
+      faculty_id : int;  (** faculty_id field in Teacher constructor *)
+      name : string;  (** name field in Teacher constructor *)
+      department : string;  (** dapartment field in Teacher constructor *)
+    }  (** Teacher constructor *)
 
 val person_reflect : person Bindoj_runtime.Refl.t
 val person_json_discriminator_value : person -> string
diff --git a/example/ex01/generated/ex01_apidir.json b/example/ex01/generated/ex01_apidir.json
index a6e6618..c20998f 100644
--- a/example/ex01/generated/ex01_apidir.json
+++ b/example/ex01/generated/ex01_apidir.json
@@ -187,14 +187,14 @@
       "String": { "title": "String", "type": "string" },
       "Student": {
         "title": "Student",
-        "description": "definition of student type",
+        "description": "📝 definition of student type",
         "type": "object",
         "properties": {
           "admissionYear": {
-            "description": "addmission_year field",
+            "description": "📅 addmission_year field",
             "type": "integer"
           },
-          "name": { "description": "name field", "type": "string" }
+          "name": { "description": "📛 name field", "type": "string" }
         },
         "required": ["admissionYear", "name"],
         "additionalProperties": false
diff --git a/example/ex01/generated/ex01_schema.json b/example/ex01/generated/ex01_schema.json
index 0e307cf..702b7cd 100644
--- a/example/ex01/generated/ex01_schema.json
+++ b/example/ex01/generated/ex01_schema.json
@@ -13,11 +13,11 @@
   },
   {
     "title": "Student",
-    "description": "definition of student type",
+    "description": "📝 definition of student type",
     "type": "object",
     "properties": {
-      "admissionYear": { "description": "addmission_year field", "type": "integer" },
-      "name": { "description": "name field", "type": "string" }
+      "admissionYear": { "description": "📅 addmission_year field", "type": "integer" },
+      "name": { "description": "📛 name field", "type": "string" }
     },
     "required": ["admissionYear", "name"],
     "additionalProperties": false
diff --git a/example/ex01/src/typedesc.ml b/example/ex01/src/typedesc.ml
index 0b0344e..b8af56f 100644
--- a/example/ex01/src/typedesc.ml
+++ b/example/ex01/src/typedesc.ml
@@ -38,10 +38,10 @@ let my_tuple_decl = alias_decl "my_tuple" (
 
 let student_decl = record_decl "student" [
   record_field "admission_year" cty_int
-    ~doc:(`docstr "addmission_year field");
+    ~doc:(`docstr "📅 addmission_year field");
   record_field "name" cty_string
-    ~doc:( `docstr "name field");
-] ~doc:(`docstr "definition of student type")
+    ~doc:( `docstr "📛 name field");
+] ~doc:(`docstr "📝 definition of student type")
 
 let person_decl = variant_decl "person" [
   variant_constructor "Anonymous" `no_param
diff --git a/example/ex02/generated/ex02.ml b/example/ex02/generated/ex02.ml
index f9c32db..0868aa3 100644
--- a/example/ex02/generated/ex02.ml
+++ b/example/ex02/generated/ex02.ml
@@ -52,12 +52,12 @@ and product_id_of_json =
 [@@warning "-39"]
 
 type product_details = {
-  name : string; [@ocaml.doc "Product name"]
-  description : string; [@ocaml.doc "Product description"]
-  price : int; [@ocaml.doc "Product price"]
-  count : int; [@ocaml.doc "Count of the product"]
+  name : string;  (** Product name *)
+  description : string;  (** Product description *)
+  price : int;  (** Product price *)
+  count : int;  (** Count of the product *)
 }
-[@@ocaml.doc "Product details"]
+(** Product details *)
 
 let rec (product_details_reflect : _ Bindoj_runtime.Refl.t) =
   lazy
@@ -187,11 +187,8 @@ and product_details_of_json =
     : Kxclib.Json.jv -> product_details option)
 [@@warning "-39"]
 
-type product = {
-  id : product_id; [@ocaml.doc "Product ID"]
-  details : product_details;
-}
-[@@ocaml.doc "Product"]
+type product = { id : product_id;  (** Product ID *) details : product_details }
+(** Product *)
 
 let rec (product_reflect : _ Bindoj_runtime.Refl.t) =
   lazy
@@ -412,19 +409,19 @@ and order_id_of_json =
     : Kxclib.Json.jv -> order_id option)
 [@@warning "-39"]
 
+(** Payment method of an order *)
 type payment_method =
   | Credit_card of {
-      card_number : string; [@ocaml.doc "Card number"]
-      holder_name : string; [@ocaml.doc "Card holder name"]
-      expiration_date : int * int; [@ocaml.doc "Expiration date"]
-      cvv : string; [@ocaml.doc "Card CVV"]
-    } [@ocaml.doc "Payment by credit card"]
+      card_number : string;  (** Card number *)
+      holder_name : string;  (** Card holder name *)
+      expiration_date : int * int;  (** Expiration date *)
+      cvv : string;  (** Card CVV *)
+    }  (** Payment by credit card *)
   | Bank_transfer of {
-      account_number : string; [@ocaml.doc "Account number"]
-      bank_name : string; [@ocaml.doc "Bank name"]
-      holder_name : string; [@ocaml.doc "Account holder name"]
-    } [@ocaml.doc "Payment by bank transer"]
-[@@ocaml.doc "Payment method of an order"]
+      account_number : string;  (** Account number *)
+      bank_name : string;  (** Bank name *)
+      holder_name : string;  (** Account holder name *)
+    }  (** Payment by bank transer *)
 
 let rec (payment_method_reflect : _ Bindoj_runtime.Refl.t) =
   lazy
@@ -709,8 +706,8 @@ and payment_method_of_json =
 
 type order_details = {
   products : (product_id * int) list;
-      [@ocaml.doc "ID and it's count of ordered products"]
-  payment_method : payment_method; [@ocaml.doc "Payment method"]
+      (** ID and it's count of ordered products *)
+  payment_method : payment_method;  (** Payment method *)
 }
 
 let rec (order_details_reflect : _ Bindoj_runtime.Refl.t) =
@@ -1050,7 +1047,7 @@ and order_details_of_json =
 
 type nonrec order_status =
   [ `Unpaid | `Paid | `Shipped | `Delivered | `Canceled ]
-[@@ocaml.doc "Status of an order"]
+(** Status of an order *)
 
 let (order_status_reflect : _ Bindoj_runtime.Refl.t) =
   lazy
@@ -1135,7 +1132,7 @@ and order_status_of_json =
 [@@warning "-39"]
 
 type order = {
-  id : order_id; [@ocaml.doc "Order ID"]
+  id : order_id;  (** Order ID *)
   total_price : int;
   details : order_details;
   status : order_status;
@@ -1587,15 +1584,14 @@ and order_of_json =
 
 type product_query = {
   searchQuery : string option;
-      [@ocaml.doc
-        "Optional search string to match product names or descriptions"]
+      (** Optional search string to match product names or descriptions *)
   minimum_price : int option;
-      [@ocaml.doc "Optional minimum price constraint for a product"]
+      (** Optional minimum price constraint for a product *)
   maximum_price : int option;
-      [@ocaml.doc "Optional maximum price constraint for a product"]
-  limit : int option; [@ocaml.doc "Number limit of data to be acquired."]
+      (** Optional maximum price constraint for a product *)
+  limit : int option;  (** Number limit of data to be acquired. *)
 }
-[@@ocaml.doc "Query to search products"]
+(** Query to search products *)
 
 let rec (product_query_reflect : _ Bindoj_runtime.Refl.t) =
   lazy
@@ -1745,16 +1741,15 @@ and product_query_of_json =
 [@@warning "-39"]
 
 type order_query = {
-  products : int list option; [@ocaml.doc "List of product IDs in the order"]
-  status : order_status list option;
-      [@ocaml.doc "Optional order status constraint"]
+  products : int list option;  (** List of product IDs in the order *)
+  status : order_status list option;  (** Optional order status constraint *)
   minimum_price : int option;
-      [@ocaml.doc "Optional minimum total price constraint for the order"]
+      (** Optional minimum total price constraint for the order *)
   maximum_price : int option;
-      [@ocaml.doc "Optional maximum total price constraint for the order"]
-  limit : int option; [@ocaml.doc "Number limit of data to be acquired."]
+      (** Optional maximum total price constraint for the order *)
+  limit : int option;  (** Number limit of data to be acquired. *)
 }
-[@@ocaml.doc "Query to search orders"]
+(** Query to search orders *)
 
 let rec (order_query_reflect : _ Bindoj_runtime.Refl.t) =
   lazy
diff --git a/example/ex02/generated/ex02.mli b/example/ex02/generated/ex02.mli
index 5101bea..c529641 100644
--- a/example/ex02/generated/ex02.mli
+++ b/example/ex02/generated/ex02.mli
@@ -7,12 +7,12 @@ val product_id_of_json' : product_id Bindoj_runtime.json_full_decoder
 val product_id_of_json : Kxclib.Json.jv -> product_id option
 
 type product_details = {
-  name : string; [@ocaml.doc "Product name"]
-  description : string; [@ocaml.doc "Product description"]
-  price : int; [@ocaml.doc "Product price"]
-  count : int; [@ocaml.doc "Count of the product"]
+  name : string;  (** Product name *)
+  description : string;  (** Product description *)
+  price : int;  (** Product price *)
+  count : int;  (** Count of the product *)
 }
-[@@ocaml.doc "Product details"]
+(** Product details *)
 
 val product_details_reflect : product_details Bindoj_runtime.Refl.t
 
@@ -23,11 +23,8 @@ val product_details_to_json : product_details -> Kxclib.Json.jv
 val product_details_of_json' : product_details Bindoj_runtime.json_full_decoder
 val product_details_of_json : Kxclib.Json.jv -> product_details option
 
-type product = {
-  id : product_id; [@ocaml.doc "Product ID"]
-  details : product_details;
-}
-[@@ocaml.doc "Product"]
+type product = { id : product_id;  (** Product ID *) details : product_details }
+(** Product *)
 
 val product_reflect : product Bindoj_runtime.Refl.t
 val product_json_shape_explanation : Bindoj_runtime.json_shape_explanation
@@ -43,19 +40,19 @@ val order_id_to_json : order_id -> Kxclib.Json.jv
 val order_id_of_json' : order_id Bindoj_runtime.json_full_decoder
 val order_id_of_json : Kxclib.Json.jv -> order_id option
 
+(** Payment method of an order *)
 type payment_method =
   | Credit_card of {
-      card_number : string; [@ocaml.doc "Card number"]
-      holder_name : string; [@ocaml.doc "Card holder name"]
-      expiration_date : int * int; [@ocaml.doc "Expiration date"]
-      cvv : string; [@ocaml.doc "Card CVV"]
-    } [@ocaml.doc "Payment by credit card"]
+      card_number : string;  (** Card number *)
+      holder_name : string;  (** Card holder name *)
+      expiration_date : int * int;  (** Expiration date *)
+      cvv : string;  (** Card CVV *)
+    }  (** Payment by credit card *)
   | Bank_transfer of {
-      account_number : string; [@ocaml.doc "Account number"]
-      bank_name : string; [@ocaml.doc "Bank name"]
-      holder_name : string; [@ocaml.doc "Account holder name"]
-    } [@ocaml.doc "Payment by bank transer"]
-[@@ocaml.doc "Payment method of an order"]
+      account_number : string;  (** Account number *)
+      bank_name : string;  (** Bank name *)
+      holder_name : string;  (** Account holder name *)
+    }  (** Payment by bank transer *)
 
 val payment_method_reflect : payment_method Bindoj_runtime.Refl.t
 val payment_method_json_discriminator_value : payment_method -> string
@@ -69,8 +66,8 @@ val payment_method_of_json : Kxclib.Json.jv -> payment_method option
 
 type order_details = {
   products : (product_id * int) list;
-      [@ocaml.doc "ID and it's count of ordered products"]
-  payment_method : payment_method; [@ocaml.doc "Payment method"]
+      (** ID and it's count of ordered products *)
+  payment_method : payment_method;  (** Payment method *)
 }
 
 val order_details_reflect : order_details Bindoj_runtime.Refl.t
@@ -81,7 +78,7 @@ val order_details_of_json : Kxclib.Json.jv -> order_details option
 
 type nonrec order_status =
   [ `Unpaid | `Paid | `Shipped | `Delivered | `Canceled ]
-[@@ocaml.doc "Status of an order"]
+(** Status of an order *)
 
 val order_status_reflect : order_status Bindoj_runtime.Refl.t
 val order_status_json_shape_explanation : Bindoj_runtime.json_shape_explanation
@@ -90,7 +87,7 @@ val order_status_of_json' : order_status Bindoj_runtime.json_full_decoder
 val order_status_of_json : Kxclib.Json.jv -> order_status option
 
 type order = {
-  id : order_id; [@ocaml.doc "Order ID"]
+  id : order_id;  (** Order ID *)
   total_price : int;
   details : order_details;
   status : order_status;
@@ -104,15 +101,14 @@ val order_of_json : Kxclib.Json.jv -> order option
 
 type product_query = {
   searchQuery : string option;
-      [@ocaml.doc
-        "Optional search string to match product names or descriptions"]
+      (** Optional search string to match product names or descriptions *)
   minimum_price : int option;
-      [@ocaml.doc "Optional minimum price constraint for a product"]
+      (** Optional minimum price constraint for a product *)
   maximum_price : int option;
-      [@ocaml.doc "Optional maximum price constraint for a product"]
-  limit : int option; [@ocaml.doc "Number limit of data to be acquired."]
+      (** Optional maximum price constraint for a product *)
+  limit : int option;  (** Number limit of data to be acquired. *)
 }
-[@@ocaml.doc "Query to search products"]
+(** Query to search products *)
 
 val product_query_reflect : product_query Bindoj_runtime.Refl.t
 val product_query_json_shape_explanation : Bindoj_runtime.json_shape_explanation
@@ -121,16 +117,15 @@ val product_query_of_json' : product_query Bindoj_runtime.json_full_decoder
 val product_query_of_json : Kxclib.Json.jv -> product_query option
 
 type order_query = {
-  products : int list option; [@ocaml.doc "List of product IDs in the order"]
-  status : order_status list option;
-      [@ocaml.doc "Optional order status constraint"]
+  products : int list option;  (** List of product IDs in the order *)
+  status : order_status list option;  (** Optional order status constraint *)
   minimum_price : int option;
-      [@ocaml.doc "Optional minimum total price constraint for the order"]
+      (** Optional minimum total price constraint for the order *)
   maximum_price : int option;
-      [@ocaml.doc "Optional maximum total price constraint for the order"]
-  limit : int option; [@ocaml.doc "Number limit of data to be acquired."]
+      (** Optional maximum total price constraint for the order *)
+  limit : int option;  (** Number limit of data to be acquired. *)
 }
-[@@ocaml.doc "Query to search orders"]
+(** Query to search orders *)
 
 val order_query_reflect : order_query Bindoj_runtime.Refl.t
 val order_query_json_shape_explanation : Bindoj_runtime.json_shape_explanation
diff --git a/scripts/audit_banner.js b/scripts/audit_banner.js
index 40b3cb6..7953925 100644
--- a/scripts/audit_banner.js
+++ b/scripts/audit_banner.js
@@ -43,6 +43,7 @@ const ignorePatterns = [
   /.+_gen\.[A-Za-z]+$/,
   /.*README\.md$/,
   /src\/lib_kxclib_testlib/,
+  /src\/lib_gen\/emitter.ml/,
 ]
 
 const filetypes = new Map([
diff --git a/src/lib_bindoj/bindoj.ml b/src/lib_bindoj/bindoj.ml
index 5374db8..47d9408 100644
--- a/src/lib_bindoj/bindoj.ml
+++ b/src/lib_bindoj/bindoj.ml
@@ -30,7 +30,7 @@ module Versioned = struct
     module Caml = struct
       module Ppxlib = Ppxlib
       module Astlib = Astlib
-      module Pprintast = Astlib.Pprintast
+      module Emitter = Bindoj_gen.Emitter
 
       module CommonTypes = struct
         type signature_item = Ppxlib.signature_item
@@ -80,14 +80,14 @@ module Versioned = struct
         let open_utils' : structure list -> structure_item =
           open_utils % List.flatten
 
-        let pp_caml : Format.formatter -> t -> unit = Pprintast.structure
+        let pp_caml : Format.formatter -> t -> unit = Emitter.structure
       end
 
       module Signature = struct
         type elt = signature_item
         type t = signature
 
-        let pp_caml : Format.formatter -> t -> unit = Pprintast.signature
+        let pp_caml : Format.formatter -> t -> unit = Emitter.signature
       end
 
     end
diff --git a/src/lib_gen/caml_datatype.ml b/src/lib_gen/caml_datatype.ml
index ba354e2..52291e4 100644
--- a/src/lib_gen/caml_datatype.ml
+++ b/src/lib_gen/caml_datatype.ml
@@ -506,7 +506,7 @@ let gen_structure :
             | Ppat_var l -> evar l.txt
             | Ppat_constraint (p, _) -> go p.ppat_desc
             | _ -> failwith' "impossible @%s: %a" __LOC__
-                     Pprintast.pattern reflect.pvb_pat
+                     Emitter.pattern reflect.pvb_pat
           in
           go reflect.pvb_pat.ppat_desc
         in
diff --git a/src/lib_gen/emitter.ml b/src/lib_gen/emitter.ml
new file mode 100644
index 0000000..a4631f9
--- /dev/null
+++ b/src/lib_gen/emitter.ml
@@ -0,0 +1,1778 @@
+(* adopted from ppxlib.0.30.0 source tree *)
+
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                      Thomas Gazagnaire, OCamlPro                       *)
+(*                   Fabrice Le Fessant, INRIA Saclay                     *)
+(*               Hongbo Zhang, University of Pennsylvania                 *)
+(*                                                                        *)
+(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Original Code from Ber-metaocaml, modified for 3.12.0 and fixed *)
+(* Printing code expressions *)
+(* Authors:  Ed Pizzi, Fabrice Le Fessant *)
+(* Extensive Rewrite: Hongbo Zhang: University of Pennsylvania *)
+(* TODO more fine-grained precedence pretty-printing *)
+
+open Ppxlib_ast
+[@@@warning "-9"]
+
+(* open Ast_414 *)
+open Asttypes
+open Format
+open Location
+open Longident
+open Parsetree
+
+module Option = struct
+  let value t ~default = match t with None -> default | Some x -> x
+end
+
+let varify_type_constructors var_names t =
+  let check_variable vl loc v =
+    if List.mem v vl then
+      Location.raise_errorf ~loc "variable in scope syntax error: %s" v
+  in
+  let var_names = List.map (fun v -> v.txt) var_names in
+  let rec loop t =
+    let desc =
+      match t.ptyp_desc with
+      | Ptyp_any -> Ptyp_any
+      | Ptyp_var x ->
+          check_variable var_names t.ptyp_loc x;
+          Ptyp_var x
+      | Ptyp_arrow (label, core_type, core_type') ->
+          Ptyp_arrow (label, loop core_type, loop core_type')
+      | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
+      | Ptyp_constr ({ txt = Longident.Lident s }, []) when List.mem s var_names
+        ->
+          Ptyp_var s
+      | Ptyp_constr (longident, lst) ->
+          Ptyp_constr (longident, List.map loop lst)
+      | Ptyp_object (lst, o) -> Ptyp_object (List.map loop_object_field lst, o)
+      | Ptyp_class (longident, lst) -> Ptyp_class (longident, List.map loop lst)
+      | Ptyp_alias (core_type, string) ->
+          check_variable var_names t.ptyp_loc string;
+          Ptyp_alias (loop core_type, string)
+      | Ptyp_variant (row_field_list, flag, lbl_lst_option) ->
+          Ptyp_variant
+            (List.map loop_row_field row_field_list, flag, lbl_lst_option)
+      | Ptyp_poly (string_lst, core_type) ->
+          List.iter
+            (fun v -> check_variable var_names t.ptyp_loc v.txt)
+            string_lst;
+          Ptyp_poly (string_lst, loop core_type)
+      | Ptyp_package (longident, lst) ->
+          Ptyp_package (longident, List.map (fun (n, typ) -> (n, loop typ)) lst)
+      | Ptyp_extension (s, arg) -> Ptyp_extension (s, arg)
+    in
+    { t with ptyp_desc = desc }
+  and loop_row_field field =
+    let prf_desc =
+      match field.prf_desc with
+      | Rtag (label, flag, lst) -> Rtag (label, flag, List.map loop lst)
+      | Rinherit t -> Rinherit (loop t)
+    in
+    { field with prf_desc }
+  and loop_object_field field =
+    let pof_desc =
+      match field.pof_desc with
+      | Otag (label, t) -> Otag (label, loop t)
+      | Oinherit t -> Oinherit (loop t)
+    in
+    { field with pof_desc }
+  in
+  loop t
+
+let prefix_symbols = [ '!'; '?'; '~' ]
+
+let infix_symbols =
+  [ '='; '<'; '>'; '@'; '^'; '|'; '&'; '+'; '-'; '*'; '/'; '$'; '%'; '#' ]
+
+(* type fixity = Infix| Prefix  *)
+let special_infix_strings =
+  [ "asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; ":="; "!="; "::" ]
+
+let letop s =
+  String.length s > 3
+  && s.[0] = 'l'
+  && s.[1] = 'e'
+  && s.[2] = 't'
+  && List.mem s.[3] infix_symbols
+
+let andop s =
+  String.length s > 3
+  && s.[0] = 'a'
+  && s.[1] = 'n'
+  && s.[2] = 'd'
+  && List.mem s.[3] infix_symbols
+
+(* determines if the string is an infix string.
+   checks backwards, first allowing a renaming postfix ("_102") which
+   may have resulted from Pexp -> Texp -> Pexp translation, then checking
+   if all the characters in the beginning of the string are valid infix
+   characters. *)
+let fixity_of_string = function
+  | "" -> `Normal
+  | s when List.mem s special_infix_strings -> `Infix s
+  | s when List.mem s.[0] infix_symbols -> `Infix s
+  | s when List.mem s.[0] prefix_symbols -> `Prefix s
+  | s when s.[0] = '.' -> `Mixfix s
+  | s when letop s -> `Letop s
+  | s when andop s -> `Andop s
+  | _ -> `Normal
+
+let view_fixity_of_exp = function
+  | { pexp_desc = Pexp_ident { txt = Lident l; _ }; pexp_attributes = [] } ->
+      fixity_of_string l
+  | _ -> `Normal
+
+let is_infix = function `Infix _ -> true | _ -> false
+let is_mixfix = function `Mixfix _ -> true | _ -> false
+let is_kwdop = function `Letop _ | `Andop _ -> true | _ -> false
+let first_is c str = str <> "" && str.[0] = c
+let last_is c str = str <> "" && str.[String.length str - 1] = c
+let first_is_in cs str = str <> "" && List.mem str.[0] cs
+
+(* which identifiers are in fact operators needing parentheses *)
+let needs_parens txt =
+  let fix = fixity_of_string txt in
+  is_infix fix || is_mixfix fix || is_kwdop fix
+  || first_is_in prefix_symbols txt
+
+(* some infixes need spaces around parens to avoid clashes with comment
+   syntax *)
+let needs_spaces txt = first_is '*' txt || last_is '*' txt
+let string_loc ppf x = fprintf ppf "%s" x.txt
+
+(* add parentheses to binders when they are in fact infix or prefix operators *)
+let protect_ident ppf txt =
+  let format : (_, _, _) format =
+    if not (needs_parens txt) then "%s"
+    else if needs_spaces txt then "(@;%s@;)"
+    else "(%s)"
+  in
+  fprintf ppf format txt
+
+let protect_longident ppf print_longident longprefix txt =
+  let format : (_, _, _) format =
+    if not (needs_parens txt) then "%a.%s"
+    else if needs_spaces txt then "%a.(@;%s@;)"
+    else "%a.(%s)"
+  in
+  fprintf ppf format print_longident longprefix txt
+
+type space_formatter = (unit, Format.formatter, unit) format
+
+let override = function Override -> "!" | Fresh -> ""
+
+(* variance encoding: need to sync up with the [parser.mly] *)
+let type_variance = function
+  | NoVariance -> ""
+  | Covariant -> "+"
+  | Contravariant -> "-"
+
+let type_injectivity = function NoInjectivity -> "" | Injective -> "!"
+
+type construct =
+  [ `cons of expression list
+  | `list of expression list
+  | `nil
+  | `normal
+  | `simple of Longident.t
+  | `tuple ]
+
+let view_expr x =
+  match x.pexp_desc with
+  | Pexp_construct ({ txt = Lident "()"; _ }, _) -> `tuple
+  | Pexp_construct ({ txt = Lident "[]"; _ }, _) -> `nil
+  | Pexp_construct ({ txt = Lident "::"; _ }, Some _) ->
+      let rec loop exp acc =
+        match exp with
+        | {
+         pexp_desc = Pexp_construct ({ txt = Lident "[]"; _ }, _);
+         pexp_attributes = [];
+        } ->
+            (List.rev acc, true)
+        | {
+         pexp_desc =
+           Pexp_construct
+             ( { txt = Lident "::"; _ },
+               Some { pexp_desc = Pexp_tuple [ e1; e2 ]; pexp_attributes = [] }
+             );
+         pexp_attributes = [];
+        } ->
+            loop e2 (e1 :: acc)
+        | e -> (List.rev (e :: acc), false)
+      in
+      let ls, b = loop x [] in
+      if b then `list ls else `cons ls
+  | Pexp_construct (x, None) -> `simple x.txt
+  | _ -> `normal
+
+let is_simple_construct : construct -> bool = function
+  | `nil | `tuple | `list _ | `simple _ -> true
+  | `cons _ | `normal -> false
+
+let pp = fprintf
+
+type ctxt = { pipe : bool; semi : bool; ifthenelse : bool }
+
+let reset_ctxt = { pipe = false; semi = false; ifthenelse = false }
+let under_pipe ctxt = { ctxt with pipe = true }
+let under_semi ctxt = { ctxt with semi = true }
+let under_ifthenelse ctxt = { ctxt with ifthenelse = true }
+(*
+let reset_semi ctxt = { ctxt with semi=false }
+let reset_ifthenelse ctxt = { ctxt with ifthenelse=false }
+let reset_pipe ctxt = { ctxt with pipe=false }
+*)
+
+let list :
+      'a.
+      ?sep:space_formatter ->
+      ?first:space_formatter ->
+      ?last:space_formatter ->
+      (Format.formatter -> 'a -> unit) ->
+      Format.formatter ->
+      'a list ->
+      unit =
+ fun ?sep ?first ?last fu f xs ->
+  let first = match first with Some x -> x | None -> ("" : _ format6)
+  and last = match last with Some x -> x | None -> ("" : _ format6)
+  and sep = match sep with Some x -> x | None -> ("@ " : _ format6) in
+  let aux f = function
+    | [] -> ()
+    | [ x ] -> fu f x
+    | xs ->
+        let rec loop f = function
+          | [ x ] -> fu f x
+          | x :: xs ->
+              fu f x;
+              pp f sep;
+              loop f xs
+          | _ -> assert false
+        in
+        pp f first;
+        loop f xs;
+        pp f last
+  in
+  aux f xs
+
+let option :
+      'a.
+      ?first:space_formatter ->
+      ?last:space_formatter ->
+      (Format.formatter -> 'a -> unit) ->
+      Format.formatter ->
+      'a option ->
+      unit =
+ fun ?first ?last fu f a ->
+  let first = match first with Some x -> x | None -> ("" : _ format6)
+  and last = match last with Some x -> x | None -> ("" : _ format6) in
+  match a with
+  | None -> ()
+  | Some x ->
+      pp f first;
+      fu f x;
+      pp f last
+
+let paren :
+      'a.
+      ?first:space_formatter ->
+      ?last:space_formatter ->
+      bool ->
+      (Format.formatter -> 'a -> unit) ->
+      Format.formatter ->
+      'a ->
+      unit =
+ fun ?(first = ("" : _ format6)) ?(last = ("" : _ format6)) b fu f x ->
+  if b then (
+    pp f "(";
+    pp f first;
+    fu f x;
+    pp f last;
+    pp f ")")
+  else fu f x
+
+let rec longident f = function
+  | Lident s -> protect_ident f s
+  | Ldot (y, s) -> protect_longident f longident y s
+  | Lapply (y, s) -> pp f "%a(%a)" longident y longident s
+
+let longident_loc f x = pp f "%a" longident x.txt
+
+let constant f = function
+  | Pconst_char i -> pp f "%C" i
+  | Pconst_string (i, _, None) -> pp f "%S" i
+  | Pconst_string (i, _, Some delim) -> pp f "{%s|%s|%s}" delim i delim
+  | Pconst_integer (i, None) -> paren (first_is '-' i) (fun f -> pp f "%s") f i
+  | Pconst_integer (i, Some m) ->
+      paren (first_is '-' i) (fun f (i, m) -> pp f "%s%c" i m) f (i, m)
+  | Pconst_float (i, None) -> paren (first_is '-' i) (fun f -> pp f "%s") f i
+  | Pconst_float (i, Some m) ->
+      paren (first_is '-' i) (fun f (i, m) -> pp f "%s%c" i m) f (i, m)
+
+(* trailing space*)
+let mutable_flag f = function Immutable -> () | Mutable -> pp f "mutable@;"
+let virtual_flag f = function Concrete -> () | Virtual -> pp f "virtual@;"
+
+(* trailing space added *)
+let rec_flag f rf =
+  match rf with Nonrecursive -> () | Recursive -> pp f "rec "
+
+let nonrec_flag f rf =
+  match rf with Nonrecursive -> pp f "nonrec " | Recursive -> ()
+
+let direction_flag f = function
+  | Upto -> pp f "to@ "
+  | Downto -> pp f "downto@ "
+
+let private_flag f = function Public -> () | Private -> pp f "private@ "
+let iter_loc f ctxt { txt; loc = _ } = f ctxt txt
+let constant_string f s = pp f "%S" s
+
+let tyvar ppf s =
+  if String.length s >= 2 && s.[1] = '\'' then
+    (* without the space, this would be parsed as
+       a character literal *)
+    Format.fprintf ppf "' %s" s
+  else Format.fprintf ppf "'%s" s
+
+let tyvar_loc f str = tyvar f str.txt
+let string_quot f x = pp f "`%s" x
+
+(* c ['a,'b] *)
+let rec class_params_def ctxt f = function
+  | [] -> ()
+  | l -> pp f "[%a] " (* space *) (list (type_param ctxt) ~sep:",") l
+
+and type_with_label ctxt f (label, c) =
+  match label with
+  | Nolabel -> core_type1 ctxt f c (* otherwise parenthesize *)
+  | Labelled s -> pp f "%s:%a" s (core_type1 ctxt) c
+  | Optional s -> pp f "?%s:%a" s (core_type1 ctxt) c
+
+and core_type ctxt f x =
+  if x.ptyp_attributes <> [] then
+    pp f "((%a)%a)" (core_type ctxt)
+      { x with ptyp_attributes = [] }
+      (attributes ctxt) x.ptyp_attributes
+  else
+    match x.ptyp_desc with
+    | Ptyp_arrow (l, ct1, ct2) ->
+        pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
+          (type_with_label ctxt) (l, ct1) (core_type ctxt) ct2
+    | Ptyp_alias (ct, s) ->
+        pp f "@[<2>%a@;as@;%a@]" (core_type1 ctxt) ct tyvar s
+    | Ptyp_poly ([], ct) -> core_type ctxt f ct
+    | Ptyp_poly (sl, ct) ->
+        pp f "@[<2>%a%a@]"
+          (fun f l ->
+            pp f "%a"
+              (fun f l ->
+                match l with
+                | [] -> ()
+                | _ -> pp f "%a@;.@;" (list tyvar_loc ~sep:"@;") l)
+              l)
+          sl (core_type ctxt) ct
+    | _ -> pp f "@[<2>%a@]" (core_type1 ctxt) x
+
+and core_type1 ctxt f x =
+  if x.ptyp_attributes <> [] then core_type ctxt f x
+  else
+    match x.ptyp_desc with
+    | Ptyp_any -> pp f "_"
+    | Ptyp_var s -> tyvar f s
+    | Ptyp_tuple l -> pp f "(%a)" (list (core_type1 ctxt) ~sep:"@;*@;") l
+    | Ptyp_constr (li, l) ->
+        pp f (* "%a%a@;" *) "%a%a"
+          (fun f l ->
+            match l with
+            | [] -> ()
+            | [ x ] -> pp f "%a@;" (core_type1 ctxt) x
+            | _ -> list ~first:"(" ~last:")@;" (core_type ctxt) ~sep:",@;" f l)
+          l longident_loc li
+    | Ptyp_variant (l, closed, low) ->
+        let first_is_inherit =
+          match l with
+          | { Parsetree.prf_desc = Rinherit _ } :: _ -> true
+          | _ -> false
+        in
+        let type_variant_helper f x =
+          match x.prf_desc with
+          | Rtag (l, _, ctl) ->
+              pp f "@[<2>%a%a@;%a@]" (iter_loc string_quot) l
+                (fun f l ->
+                  match l with
+                  | [] -> ()
+                  | _ -> pp f "@;of@;%a" (list (core_type ctxt) ~sep:"&") ctl)
+                ctl (attributes ctxt) x.prf_attributes
+          | Rinherit ct -> core_type ctxt f ct
+        in
+        pp f "@[<2>[%a%a]@]"
+          (fun f l ->
+            match (l, closed) with
+            | [], Closed -> ()
+            | [], Open -> pp f ">" (* Cf #7200: print [>] correctly *)
+            | _ ->
+                pp f "%s@;%a"
+                  (match (closed, low) with
+                  | Closed, None -> if first_is_inherit then " |" else ""
+                  | Closed, Some _ -> "<" (* FIXME desugar the syntax sugar*)
+                  | Open, _ -> ">")
+                  (list type_variant_helper ~sep:"@;<1 -2>| ")
+                  l)
+          l
+          (fun f low ->
+            match low with
+            | Some [] | None -> ()
+            | Some xs -> pp f ">@ %a" (list string_quot) xs)
+          low
+    | Ptyp_object (l, o) ->
+        let core_field_type f x =
+          match x.pof_desc with
+          | Otag (l, ct) ->
+              (* Cf #7200 *)
+              pp f "@[<hov2>%s: %a@ %a@ @]" l.txt (core_type ctxt) ct
+                (attributes ctxt) x.pof_attributes
+          | Oinherit ct -> pp f "@[<hov2>%a@ @]" (core_type ctxt) ct
+        in
+        let field_var f = function
+          | Asttypes.Closed -> ()
+          | Asttypes.Open -> (
+              match l with [] -> pp f ".." | _ -> pp f " ;..")
+        in
+        pp f "@[<hov2><@ %a%a@ > @]"
+          (list core_field_type ~sep:";")
+          l field_var o
+        (* Cf #7200 *)
+    | Ptyp_class (li, l) ->
+        (*FIXME*)
+        pp f "@[<hov2>%a#%a@]"
+          (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
+          l longident_loc li
+    | Ptyp_package (lid, cstrs) -> (
+        let aux f (s, ct) =
+          pp f "type %a@ =@ %a" longident_loc s (core_type ctxt) ct
+        in
+        match cstrs with
+        | [] -> pp f "@[<hov2>(module@ %a)@]" longident_loc lid
+        | _ ->
+            pp f "@[<hov2>(module@ %a@ with@ %a)@]" longident_loc lid
+              (list aux ~sep:"@ and@ ") cstrs)
+    | Ptyp_extension e -> extension ctxt f e
+    | _ -> paren true (core_type ctxt) f x
+
+(********************pattern********************)
+(* be cautious when use [pattern], [pattern1] is preferred *)
+and pattern ctxt f x =
+  if x.ppat_attributes <> [] then
+    pp f "((%a)%a)" (pattern ctxt)
+      { x with ppat_attributes = [] }
+      (attributes ctxt) x.ppat_attributes
+  else
+    match x.ppat_desc with
+    | Ppat_alias (p, s) ->
+        pp f "@[<2>%a@;as@;%a@]" (pattern ctxt) p protect_ident s.txt
+    | _ -> pattern_or ctxt f x
+
+and pattern_or ctxt f x =
+  let rec left_associative x acc =
+    match x with
+    | { ppat_desc = Ppat_or (p1, p2); ppat_attributes = [] } ->
+        left_associative p1 (p2 :: acc)
+    | x -> x :: acc
+  in
+  match left_associative x [] with
+  | [] -> assert false
+  | [ x ] -> pattern1 ctxt f x
+  | orpats -> pp f "@[<hov0>%a@]" (list ~sep:"@ | " (pattern1 ctxt)) orpats
+
+and pattern1 ctxt (f : Format.formatter) (x : pattern) : unit =
+  let rec pattern_list_helper f = function
+    | {
+        ppat_desc =
+          Ppat_construct
+            ( { txt = Lident "::"; _ },
+              Some ([], { ppat_desc = Ppat_tuple [ pat1; pat2 ]; _ }) );
+        ppat_attributes = [];
+      } ->
+        pp f "%a::%a" (simple_pattern ctxt) pat1 pattern_list_helper pat2 (*RA*)
+    | p -> pattern1 ctxt f p
+  in
+  if x.ppat_attributes <> [] then pattern ctxt f x
+  else
+    match x.ppat_desc with
+    | Ppat_variant (l, Some p) ->
+        pp f "@[<2>`%s@;%a@]" l (simple_pattern ctxt) p
+    | Ppat_construct ({ txt = Lident ("()" | "[]"); _ }, _) ->
+        simple_pattern ctxt f x
+    | Ppat_construct (({ txt; _ } as li), po) -> (
+        if (* FIXME The third field always false *)
+           txt = Lident "::" then pp f "%a" pattern_list_helper x
+        else
+          match po with
+          | Some ([], x) ->
+              pp f "%a@;%a" longident_loc li (simple_pattern ctxt) x
+          | Some (vl, x) ->
+              pp f "%a@ (type %a)@;%a" longident_loc li
+                (list ~sep:"@ " string_loc)
+                vl (simple_pattern ctxt) x
+          | None -> pp f "%a" longident_loc li)
+    | _ -> simple_pattern ctxt f x
+
+and simple_pattern ctxt (f : Format.formatter) (x : pattern) : unit =
+  if x.ppat_attributes <> [] then pattern ctxt f x
+  else
+    match x.ppat_desc with
+    | Ppat_construct ({ txt = Lident (("()" | "[]") as x); _ }, None) ->
+        pp f "%s" x
+    | Ppat_any -> pp f "_"
+    | Ppat_var { txt; _ } -> protect_ident f txt
+    | Ppat_array l -> pp f "@[<2>[|%a|]@]" (list (pattern1 ctxt) ~sep:";") l
+    | Ppat_unpack { txt = None } -> pp f "(module@ _)@ "
+    | Ppat_unpack { txt = Some s } -> pp f "(module@ %s)@ " s
+    | Ppat_type li -> pp f "#%a" longident_loc li
+    | Ppat_record (l, closed) -> (
+        let longident_x_pattern f (li, p) =
+          match (li, p) with
+          | ( { txt = Lident s; _ },
+              { ppat_desc = Ppat_var { txt; _ }; ppat_attributes = []; _ } )
+            when s = txt ->
+              pp f "@[<2>%a@]" longident_loc li
+          | _ -> pp f "@[<2>%a@;=@;%a@]" longident_loc li (pattern1 ctxt) p
+        in
+        match closed with
+        | Closed ->
+            pp f "@[<2>{@;%a@;}@]" (list longident_x_pattern ~sep:";@;") l
+        | _ -> pp f "@[<2>{@;%a;_}@]" (list longident_x_pattern ~sep:";@;") l)
+    | Ppat_tuple l ->
+        pp f "@[<1>(%a)@]" (list ~sep:",@;" (pattern1 ctxt)) l (* level1*)
+    | Ppat_constant c -> pp f "%a" constant c
+    | Ppat_interval (c1, c2) -> pp f "%a..%a" constant c1 constant c2
+    | Ppat_variant (l, None) -> pp f "`%s" l
+    | Ppat_constraint (p, ct) ->
+        pp f "@[<2>(%a@;:@;%a)@]" (pattern1 ctxt) p (core_type ctxt) ct
+    | Ppat_lazy p -> pp f "@[<2>(lazy@;%a)@]" (simple_pattern ctxt) p
+    | Ppat_exception p -> pp f "@[<2>exception@;%a@]" (pattern1 ctxt) p
+    | Ppat_extension e -> extension ctxt f e
+    | Ppat_open (lid, p) ->
+        let with_paren =
+          match p.ppat_desc with
+          | Ppat_array _ | Ppat_record _
+          | Ppat_construct ({ txt = Lident ("()" | "[]"); _ }, None) ->
+              false
+          | _ -> true
+        in
+        pp f "@[<2>%a.%a @]" longident_loc lid
+          (paren with_paren @@ pattern1 ctxt)
+          p
+    | _ -> paren true (pattern ctxt) f x
+
+and label_exp ctxt f (l, opt, p) =
+  match l with
+  | Nolabel ->
+      (* single case pattern parens needed here *)
+      pp f "%a@ " (simple_pattern ctxt) p
+  | Optional rest -> (
+      match p with
+      | { ppat_desc = Ppat_var { txt; _ }; ppat_attributes = [] }
+        when txt = rest -> (
+          match opt with
+          | Some o -> pp f "?(%s=@;%a)@;" rest (expression ctxt) o
+          | None -> pp f "?%s@ " rest)
+      | _ -> (
+          match opt with
+          | Some o ->
+              pp f "?%s:(%a=@;%a)@;" rest (pattern1 ctxt) p (expression ctxt) o
+          | None -> pp f "?%s:%a@;" rest (simple_pattern ctxt) p))
+  | Labelled l -> (
+      match p with
+      | { ppat_desc = Ppat_var { txt; _ }; ppat_attributes = [] } when txt = l
+        ->
+          pp f "~%s@;" l
+      | _ -> pp f "~%s:%a@;" l (simple_pattern ctxt) p)
+
+and sugar_expr ctxt f e =
+  if e.pexp_attributes <> [] then false
+  else
+    match e.pexp_desc with
+    | Pexp_apply
+        ( { pexp_desc = Pexp_ident { txt = id; _ }; pexp_attributes = []; _ },
+          args )
+      when List.for_all (fun (lab, _) -> lab = Nolabel) args -> (
+        let print_indexop a path_prefix assign left sep right print_index
+            indices rem_args =
+          let print_path ppf = function
+            | None -> ()
+            | Some m -> pp ppf ".%a" longident m
+          in
+          match (assign, rem_args) with
+          | false, [] ->
+              pp f "@[%a%a%s%a%s@]" (simple_expr ctxt) a print_path path_prefix
+                left (list ~sep print_index) indices right;
+              true
+          | true, [ v ] ->
+              pp f "@[%a%a%s%a%s@ <-@;<1 2>%a@]" (simple_expr ctxt) a print_path
+                path_prefix left (list ~sep print_index) indices right
+                (simple_expr ctxt) v;
+              true
+          | _ -> false
+        in
+        match (id, List.map snd args) with
+        | Lident "!", [ e ] ->
+            pp f "@[<hov>!%a@]" (simple_expr ctxt) e;
+            true
+        | Ldot (path, (("get" | "set") as func)), a :: other_args -> (
+            let assign = func = "set" in
+            let print = print_indexop a None assign in
+            match (path, other_args) with
+            | Lident "Array", i :: rest ->
+                print ".(" "" ")" (expression ctxt) [ i ] rest
+            | Lident "String", i :: rest ->
+                print ".[" "" "]" (expression ctxt) [ i ] rest
+            | Ldot (Lident "Bigarray", "Array1"), i1 :: rest ->
+                print ".{" "," "}" (simple_expr ctxt) [ i1 ] rest
+            | Ldot (Lident "Bigarray", "Array2"), i1 :: i2 :: rest ->
+                print ".{" "," "}" (simple_expr ctxt) [ i1; i2 ] rest
+            | Ldot (Lident "Bigarray", "Array3"), i1 :: i2 :: i3 :: rest ->
+                print ".{" "," "}" (simple_expr ctxt) [ i1; i2; i3 ] rest
+            | ( Ldot (Lident "Bigarray", "Genarray"),
+                { pexp_desc = Pexp_array indexes; pexp_attributes = [] } :: rest
+              ) ->
+                print ".{" "," "}" (simple_expr ctxt) indexes rest
+            | _ -> false)
+        | (Lident s | Ldot (_, s)), a :: i :: rest when first_is '.' s ->
+            (* extract operator:
+               assignment operators end with [right_bracket ^ "<-"],
+               access operators end with [right_bracket] directly
+            *)
+            let multi_indices = String.contains s ';' in
+            let i =
+              match i.pexp_desc with
+              | Pexp_array l when multi_indices -> l
+              | _ -> [ i ]
+            in
+            let assign = last_is '-' s in
+            let kind =
+              (* extract the right end bracket *)
+              let n = String.length s in
+              if assign then s.[n - 3] else s.[n - 1]
+            in
+            let left, right =
+              match kind with
+              | ')' -> ('(', ")")
+              | ']' -> ('[', "]")
+              | '}' -> ('{', "}")
+              | _ -> assert false
+            in
+            let path_prefix =
+              match id with Ldot (m, _) -> Some m | _ -> None
+            in
+            let left = String.sub s 0 (1 + String.index s left) in
+            print_indexop a path_prefix assign left ";" right
+              (if multi_indices then expression ctxt else simple_expr ctxt)
+              i rest
+        | _ -> false)
+    | _ -> false
+
+and expression ctxt f x =
+  if x.pexp_attributes <> [] then
+    pp f "((%a)@,%a)" (expression ctxt)
+      { x with pexp_attributes = [] }
+      (attributes ctxt) x.pexp_attributes
+  else
+    match x.pexp_desc with
+    | Pexp_function _ | Pexp_fun _ | Pexp_match _ | Pexp_try _ | Pexp_sequence _
+    | Pexp_newtype _
+      when ctxt.pipe || ctxt.semi ->
+        paren true (expression reset_ctxt) f x
+    | (Pexp_ifthenelse _ | Pexp_sequence _) when ctxt.ifthenelse ->
+        paren true (expression reset_ctxt) f x
+    | Pexp_let _ | Pexp_letmodule _ | Pexp_open _ | Pexp_letexception _
+    | Pexp_letop _
+      when ctxt.semi ->
+        paren true (expression reset_ctxt) f x
+    | Pexp_fun (l, e0, p, e) ->
+        pp f "@[<2>fun@;%a->@;%a@]" (label_exp ctxt) (l, e0, p)
+          (expression ctxt) e
+    | Pexp_newtype (lid, e) ->
+        pp f "@[<2>fun@;(type@;%s)@;->@;%a@]" lid.txt (expression ctxt) e
+    | Pexp_function l -> pp f "@[<hv>function%a@]" (case_list ctxt) l
+    | Pexp_match (e, l) ->
+        pp f "@[<hv0>@[<hv0>@[<2>match %a@]@ with@]%a@]" (expression reset_ctxt)
+          e (case_list ctxt) l
+    | Pexp_try (e, l) ->
+        pp f "@[<0>@[<hv2>try@ %a@]@ @[<0>with%a@]@]"
+          (* "try@;@[<2>%a@]@\nwith@\n%a"*)
+          (expression reset_ctxt)
+          e (case_list ctxt) l
+    | Pexp_let (rf, l, e) ->
+        (* pp f "@[<2>let %a%a in@;<1 -2>%a@]"
+           (*no indentation here, a new line*) *)
+        (*   rec_flag rf *)
+        pp f "@[<2>%a in@;<1 -2>%a@]" (bindings reset_ctxt) (rf, l)
+          (expression ctxt) e
+    | Pexp_apply (e, l) -> (
+        if not (sugar_expr ctxt f x) then
+          match view_fixity_of_exp e with
+          | `Infix s -> (
+              match l with
+              | [ ((Nolabel, _) as arg1); ((Nolabel, _) as arg2) ] ->
+                  (* FIXME associativity label_x_expression_param *)
+                  pp f "@[<2>%a@;%s@;%a@]"
+                    (label_x_expression_param reset_ctxt)
+                    arg1 s
+                    (label_x_expression_param ctxt)
+                    arg2
+              | _ ->
+                  pp f "@[<2>%a %a@]" (simple_expr ctxt) e
+                    (list (label_x_expression_param ctxt))
+                    l)
+          | `Prefix s -> (
+              let s =
+                if
+                  List.mem s [ "~+"; "~-"; "~+."; "~-." ]
+                  &&
+                  match l with
+                  (* See #7200: avoid turning (~- 1) into (- 1) which is
+                     parsed as an int literal *)
+                  | [ (_, { pexp_desc = Pexp_constant _ }) ] -> false
+                  | _ -> true
+                then String.sub s 1 (String.length s - 1)
+                else s
+              in
+              match l with
+              | [ (Nolabel, x) ] -> pp f "@[<2>%s@;%a@]" s (simple_expr ctxt) x
+              | _ ->
+                  pp f "@[<2>%a %a@]" (simple_expr ctxt) e
+                    (list (label_x_expression_param ctxt))
+                    l)
+          | _ ->
+              pp f "@[<hov2>%a@]"
+                (fun f (e, l) ->
+                  pp f "%a@ %a" (expression2 ctxt) e
+                    (list (label_x_expression_param reset_ctxt))
+                    l
+                  (* reset here only because [function,match,try,sequence]
+                     are lower priority *))
+                (e, l))
+    | Pexp_construct (li, Some eo) when not (is_simple_construct (view_expr x))
+      -> (
+        (* Not efficient FIXME*)
+        match view_expr x with
+        | `cons ls -> list (simple_expr ctxt) f ls ~sep:"@;::@;"
+        | `normal -> pp f "@[<2>%a@;%a@]" longident_loc li (simple_expr ctxt) eo
+        | _ -> assert false)
+    | Pexp_setfield (e1, li, e2) ->
+        pp f "@[<2>%a.%a@ <-@ %a@]" (simple_expr ctxt) e1 longident_loc li
+          (simple_expr ctxt) e2
+    | Pexp_ifthenelse (e1, e2, eo) ->
+        (* @;@[<2>else@ %a@]@] *)
+        let fmt : (_, _, _) format =
+          "@[<hv0>@[<2>if@ %a@]@;@[<2>then@ %a@]%a@]"
+        in
+        let expression_under_ifthenelse = expression (under_ifthenelse ctxt) in
+        pp f fmt expression_under_ifthenelse e1 expression_under_ifthenelse e2
+          (fun f eo ->
+            match eo with
+            | Some x ->
+                pp f "@;@[<2>else@;%a@]" (expression (under_semi ctxt)) x
+            | None -> ()
+            (* pp f "()" *))
+          eo
+    | Pexp_sequence _ ->
+        let rec sequence_helper acc = function
+          | { pexp_desc = Pexp_sequence (e1, e2); pexp_attributes = [] } ->
+              sequence_helper (e1 :: acc) e2
+          | v -> List.rev (v :: acc)
+        in
+        let lst = sequence_helper [] x in
+        pp f "@[<hv>%a@]" (list (expression (under_semi ctxt)) ~sep:";@;") lst
+    | Pexp_new li -> pp f "@[<hov2>new@ %a@]" longident_loc li
+    | Pexp_setinstvar (s, e) ->
+        pp f "@[<hov2>%s@ <-@ %a@]" s.txt (expression ctxt) e
+    | Pexp_override l ->
+        (* FIXME *)
+        let string_x_expression f (s, e) =
+          pp f "@[<hov2>%s@ =@ %a@]" s.txt (expression ctxt) e
+        in
+        pp f "@[<hov2>{<%a>}@]" (list string_x_expression ~sep:";") l
+    | Pexp_letmodule (s, me, e) ->
+        pp f "@[<hov2>let@ module@ %s@ =@ %a@ in@ %a@]"
+          (Option.value s.txt ~default:"_")
+          (module_expr reset_ctxt) me (expression ctxt) e
+    | Pexp_letexception (cd, e) ->
+        pp f "@[<hov2>let@ exception@ %a@ in@ %a@]"
+          (extension_constructor ctxt)
+          cd (expression ctxt) e
+    | Pexp_assert e -> pp f "@[<hov2>assert@ %a@]" (simple_expr ctxt) e
+    | Pexp_lazy e -> pp f "@[<hov2>lazy@ %a@]" (simple_expr ctxt) e
+    (* Pexp_poly: impossible but we should print it anyway, rather than
+       assert false *)
+    | Pexp_poly (e, None) -> pp f "@[<hov2>!poly!@ %a@]" (simple_expr ctxt) e
+    | Pexp_poly (e, Some ct) ->
+        pp f "@[<hov2>(!poly!@ %a@ : %a)@]" (simple_expr ctxt) e
+          (core_type ctxt) ct
+    | Pexp_open (o, e) ->
+        pp f "@[<2>let open%s %a in@;%a@]"
+          (override o.popen_override)
+          (module_expr ctxt) o.popen_expr (expression ctxt) e
+    | Pexp_variant (l, Some eo) -> pp f "@[<2>`%s@;%a@]" l (simple_expr ctxt) eo
+    | Pexp_letop { let_; ands; body } ->
+        pp f "@[<2>@[<v>%a@,%a@] in@;<1 -2>%a@]" (binding_op ctxt) let_
+          (list ~sep:"@," (binding_op ctxt))
+          ands (expression ctxt) body
+    | Pexp_extension e -> extension ctxt f e
+    | Pexp_unreachable -> pp f "."
+    | _ -> expression1 ctxt f x
+
+and expression1 ctxt f x =
+  if x.pexp_attributes <> [] then expression ctxt f x
+  else
+    match x.pexp_desc with
+    | Pexp_object cs -> pp f "%a" (class_structure ctxt) cs
+    | _ -> expression2 ctxt f x
+(* used in [Pexp_apply] *)
+
+and expression2 ctxt f x =
+  if x.pexp_attributes <> [] then expression ctxt f x
+  else
+    match x.pexp_desc with
+    | Pexp_field (e, li) ->
+        pp f "@[<hov2>%a.%a@]" (simple_expr ctxt) e longident_loc li
+    | Pexp_send (e, s) -> pp f "@[<hov2>%a#%s@]" (simple_expr ctxt) e s.txt
+    | _ -> simple_expr ctxt f x
+
+and simple_expr ctxt f x =
+  if x.pexp_attributes <> [] then expression ctxt f x
+  else
+    match x.pexp_desc with
+    | Pexp_construct _ when is_simple_construct (view_expr x) -> (
+        match view_expr x with
+        | `nil -> pp f "[]"
+        | `tuple -> pp f "()"
+        | `list xs ->
+            pp f "@[<hv0>[%a]@]"
+              (list (expression (under_semi ctxt)) ~sep:";@;")
+              xs
+        | `simple x -> longident f x
+        | _ -> assert false)
+    | Pexp_ident li -> longident_loc f li
+    (* (match view_fixity_of_exp x with *)
+    (* |`Normal -> longident_loc f li *)
+    (* | `Prefix _ | `Infix _ -> pp f "( %a )" longident_loc li) *)
+    | Pexp_constant c -> constant f c
+    | Pexp_pack me -> pp f "(module@;%a)" (module_expr ctxt) me
+    | Pexp_tuple l ->
+        pp f "@[<hov2>(%a)@]" (list (simple_expr ctxt) ~sep:",@;") l
+    | Pexp_constraint (e, ct) ->
+        pp f "(%a : %a)" (expression ctxt) e (core_type ctxt) ct
+    | Pexp_coerce (e, cto1, ct) ->
+        pp f "(%a%a :> %a)" (expression ctxt) e
+          (option (core_type ctxt) ~first:" : " ~last:" ")
+          cto1
+          (* no sep hint*) (core_type ctxt)
+          ct
+    | Pexp_variant (l, None) -> pp f "`%s" l
+    | Pexp_record (l, eo) ->
+        let longident_x_expression f (li, e) =
+          match e with
+          | { pexp_desc = Pexp_ident { txt; _ }; pexp_attributes = []; _ }
+            when li.txt = txt ->
+              pp f "@[<hov2>%a@]" longident_loc li
+          | _ ->
+              pp f "@[<hov2>%a@;=@;%a@]" longident_loc li (simple_expr ctxt) e
+        in
+        pp f "@[<hv0>@[<hv2>{@;%a%a@]@;}@]" (* "@[<hov2>{%a%a}@]" *)
+          (option ~last:" with@;" (simple_expr ctxt))
+          eo
+          (list longident_x_expression ~sep:";@;")
+          l
+    | Pexp_array l ->
+        pp f "@[<0>@[<2>[|%a|]@]@]"
+          (list (simple_expr (under_semi ctxt)) ~sep:";")
+          l
+    | Pexp_while (e1, e2) ->
+        let fmt : (_, _, _) format = "@[<2>while@;%a@;do@;%a@;done@]" in
+        pp f fmt (expression ctxt) e1 (expression ctxt) e2
+    | Pexp_for (s, e1, e2, df, e3) ->
+        let fmt : (_, _, _) format =
+          "@[<hv0>@[<hv2>@[<2>for %a =@;%a@;%a%a@;do@]@;%a@]@;done@]"
+        in
+        let expression = expression ctxt in
+        pp f fmt (pattern ctxt) s expression e1 direction_flag df expression e2
+          expression e3
+    | _ -> paren true (expression ctxt) f x
+
+and attributes ctxt f l = List.iter (attribute ctxt f) l
+and item_attributes ctxt f l = List.iter (item_attribute ctxt f) l
+
+and classify_attribute = function
+  | { attr_name = { txt = "ocaml.doc"; _ };
+      attr_payload =
+        (PStr [{ pstr_desc =
+           Pstr_eval ({
+             pexp_desc =
+               Pexp_constant (Pconst_string (docstr, _, _))}, _)}]);
+    } -> `docstr docstr
+  | a -> `misc a
+
+and attribute ctxt f = classify_attribute &> function
+  | `docstr str -> pp f "@[<2>(** %s *)@]" str
+  | `misc a ->pp f "@[<2>[@@%s@ %a]@]" a.attr_name.txt (payload ctxt) a.attr_payload
+
+and item_attribute ctxt f = classify_attribute &> function
+  | `docstr str -> pp f "@[<2>(** %s *)@\n@]" str
+  | `misc a ->
+     pp f "@[<2>[@@@@%s@ %a]@]" a.attr_name.txt (payload ctxt) a.attr_payload
+
+and floating_attribute ctxt f = classify_attribute &> function
+  | `docstr str -> pp f "@[<2>(** %s *)@]" str
+  | `misc a ->
+     pp f "@\n@[<2>[@@@@@@%s@ %a]@]@\n" a.attr_name.txt (payload ctxt) a.attr_payload
+
+and value_description ctxt f x =
+  (* note: value_description has an attribute field,
+           but they're already printed by the callers this method *)
+  pp f "@[<hov2>%a%a@]" (core_type ctxt) x.pval_type
+    (fun f x ->
+      if x.pval_prim <> [] then
+        pp f "@ =@ %a" (list constant_string) x.pval_prim)
+    x
+
+and extension ctxt f (s, e) = pp f "@[<2>[%%%s@ %a]@]" s.txt (payload ctxt) e
+
+and item_extension ctxt f (s, e) =
+  pp f "@[<2>[%%%%%s@ %a]@]" s.txt (payload ctxt) e
+
+and exception_declaration ctxt f x =
+  pp f "@[<hov2>exception@ %a@]%a"
+    (extension_constructor ctxt)
+    x.ptyexn_constructor (item_attributes ctxt) x.ptyexn_attributes
+
+and class_type_field ctxt f x =
+  match x.pctf_desc with
+  | Pctf_inherit ct ->
+      pp f "@[<2>inherit@ %a@]%a" (class_type ctxt) ct (item_attributes ctxt)
+        x.pctf_attributes
+  | Pctf_val (s, mf, vf, ct) ->
+      pp f "@[<2>val @ %a%a%s@ :@ %a@]%a" mutable_flag mf virtual_flag vf s.txt
+        (core_type ctxt) ct (item_attributes ctxt) x.pctf_attributes
+  | Pctf_method (s, pf, vf, ct) ->
+      pp f "@[<2>method %a %a%s :@;%a@]%a" private_flag pf virtual_flag vf s.txt
+        (core_type ctxt) ct (item_attributes ctxt) x.pctf_attributes
+  | Pctf_constraint (ct1, ct2) ->
+      pp f "@[<2>constraint@ %a@ =@ %a@]%a" (core_type ctxt) ct1
+        (core_type ctxt) ct2 (item_attributes ctxt) x.pctf_attributes
+  | Pctf_attribute a -> floating_attribute ctxt f a
+  | Pctf_extension e ->
+      item_extension ctxt f e;
+      item_attributes ctxt f x.pctf_attributes
+
+and class_signature ctxt f { pcsig_self = ct; pcsig_fields = l; _ } =
+  pp f "@[<hv0>@[<hv2>object@[<1>%a@]@ %a@]@ end@]"
+    (fun f -> function
+      | { ptyp_desc = Ptyp_any; ptyp_attributes = []; _ } -> ()
+      | ct -> pp f " (%a)" (core_type ctxt) ct)
+    ct
+    (list (class_type_field ctxt) ~sep:"@;")
+    l
+
+(* call [class_signature] called by [class_signature] *)
+and class_type ctxt f x =
+  match x.pcty_desc with
+  | Pcty_signature cs ->
+      class_signature ctxt f cs;
+      attributes ctxt f x.pcty_attributes
+  | Pcty_constr (li, l) ->
+      pp f "%a%a%a"
+        (fun f l ->
+          match l with
+          | [] -> ()
+          | _ -> pp f "[%a]@ " (list (core_type ctxt) ~sep:",") l)
+        l longident_loc li (attributes ctxt) x.pcty_attributes
+  | Pcty_arrow (l, co, cl) ->
+      pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
+        (type_with_label ctxt) (l, co) (class_type ctxt) cl
+  | Pcty_extension e ->
+      extension ctxt f e;
+      attributes ctxt f x.pcty_attributes
+  | Pcty_open (o, e) ->
+      pp f "@[<2>let open%s %a in@;%a@]"
+        (override o.popen_override)
+        longident_loc o.popen_expr (class_type ctxt) e
+
+(* [class type a = object end] *)
+and class_type_declaration_list ctxt f l =
+  let class_type_declaration kwd f x =
+    let { pci_params = ls; pci_name = { txt; _ }; _ } = x in
+    pp f "@[<2>%s %a%a%s@ =@ %a@]%a" kwd virtual_flag x.pci_virt
+      (class_params_def ctxt) ls txt (class_type ctxt) x.pci_expr
+      (item_attributes ctxt) x.pci_attributes
+  in
+  match l with
+  | [] -> ()
+  | [ x ] -> class_type_declaration "class type" f x
+  | x :: xs ->
+      pp f "@[<v>%a@,%a@]"
+        (class_type_declaration "class type")
+        x
+        (list ~sep:"@," (class_type_declaration "and"))
+        xs
+
+and class_field ctxt f x =
+  match x.pcf_desc with
+  | Pcf_inherit (ovf, ce, so) ->
+      pp f "@[<2>inherit@ %s@ %a%a@]%a" (override ovf) (class_expr ctxt) ce
+        (fun f so ->
+          match so with None -> () | Some s -> pp f "@ as %s" s.txt)
+        so (item_attributes ctxt) x.pcf_attributes
+  | Pcf_val (s, mf, Cfk_concrete (ovf, e)) ->
+      pp f "@[<2>val%s %a%s =@;%a@]%a" (override ovf) mutable_flag mf s.txt
+        (expression ctxt) e (item_attributes ctxt) x.pcf_attributes
+  | Pcf_method (s, pf, Cfk_virtual ct) ->
+      pp f "@[<2>method virtual %a %s :@;%a@]%a" private_flag pf s.txt
+        (core_type ctxt) ct (item_attributes ctxt) x.pcf_attributes
+  | Pcf_val (s, mf, Cfk_virtual ct) ->
+      pp f "@[<2>val virtual %a%s :@ %a@]%a" mutable_flag mf s.txt
+        (core_type ctxt) ct (item_attributes ctxt) x.pcf_attributes
+  | Pcf_method (s, pf, Cfk_concrete (ovf, e)) ->
+      let bind e =
+        binding ctxt f
+          {
+            pvb_pat =
+              {
+                ppat_desc = Ppat_var s;
+                ppat_loc = Location.none;
+                ppat_loc_stack = [];
+                ppat_attributes = [];
+              };
+            pvb_expr = e;
+            pvb_attributes = [];
+            pvb_loc = Location.none;
+          }
+      in
+      pp f "@[<2>method%s %a%a@]%a" (override ovf) private_flag pf
+        (fun f -> function
+          | { pexp_desc = Pexp_poly (e, Some ct); pexp_attributes = []; _ } ->
+              pp f "%s :@;%a=@;%a" s.txt (core_type ctxt) ct (expression ctxt) e
+          | { pexp_desc = Pexp_poly (e, None); pexp_attributes = []; _ } ->
+              bind e
+          | _ -> bind e)
+        e (item_attributes ctxt) x.pcf_attributes
+  | Pcf_constraint (ct1, ct2) ->
+      pp f "@[<2>constraint %a =@;%a@]%a" (core_type ctxt) ct1 (core_type ctxt)
+        ct2 (item_attributes ctxt) x.pcf_attributes
+  | Pcf_initializer e ->
+      pp f "@[<2>initializer@ %a@]%a" (expression ctxt) e (item_attributes ctxt)
+        x.pcf_attributes
+  | Pcf_attribute a -> floating_attribute ctxt f a
+  | Pcf_extension e ->
+      item_extension ctxt f e;
+      item_attributes ctxt f x.pcf_attributes
+
+and class_structure ctxt f { pcstr_self = p; pcstr_fields = l } =
+  pp f "@[<hv0>@[<hv2>object%a@;%a@]@;end@]"
+    (fun f p ->
+      match p.ppat_desc with
+      | Ppat_any -> ()
+      | Ppat_constraint _ -> pp f " %a" (pattern ctxt) p
+      | _ -> pp f " (%a)" (pattern ctxt) p)
+    p
+    (list (class_field ctxt))
+    l
+
+and class_expr ctxt f x =
+  if x.pcl_attributes <> [] then
+    pp f "((%a)%a)" (class_expr ctxt)
+      { x with pcl_attributes = [] }
+      (attributes ctxt) x.pcl_attributes
+  else
+    match x.pcl_desc with
+    | Pcl_structure cs -> class_structure ctxt f cs
+    | Pcl_fun (l, eo, p, e) ->
+        pp f "fun@ %a@ ->@ %a" (label_exp ctxt) (l, eo, p) (class_expr ctxt) e
+    | Pcl_let (rf, l, ce) ->
+        pp f "%a@ in@ %a" (bindings ctxt) (rf, l) (class_expr ctxt) ce
+    | Pcl_apply (ce, l) ->
+        pp f "((%a)@ %a)"
+          (* Cf: #7200 *) (class_expr ctxt)
+          ce
+          (list (label_x_expression_param ctxt))
+          l
+    | Pcl_constr (li, l) ->
+        pp f "%a%a"
+          (fun f l ->
+            if l <> [] then pp f "[%a]@ " (list (core_type ctxt) ~sep:",") l)
+          l longident_loc li
+    | Pcl_constraint (ce, ct) ->
+        pp f "(%a@ :@ %a)" (class_expr ctxt) ce (class_type ctxt) ct
+    | Pcl_extension e -> extension ctxt f e
+    | Pcl_open (o, e) ->
+        pp f "@[<2>let open%s %a in@;%a@]"
+          (override o.popen_override)
+          longident_loc o.popen_expr (class_expr ctxt) e
+
+and module_type ctxt f x =
+  if x.pmty_attributes <> [] then
+    pp f "((%a)%a)" (module_type ctxt)
+      { x with pmty_attributes = [] }
+      (attributes ctxt) x.pmty_attributes
+  else
+    match x.pmty_desc with
+    | Pmty_functor (Unit, mt2) ->
+        pp f "@[<hov2>functor () ->@ %a@]" (module_type ctxt) mt2
+    | Pmty_functor (Named (s, mt1), mt2) -> (
+        match s.txt with
+        | None ->
+            pp f "@[<hov2>%a@ ->@ %a@]" (module_type1 ctxt) mt1
+              (module_type ctxt) mt2
+        | Some name ->
+            pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" name
+              (module_type ctxt) mt1 (module_type ctxt) mt2)
+    | Pmty_with (mt, []) -> module_type ctxt f mt
+    | Pmty_with (mt, l) ->
+        pp f "@[<hov2>%a@ with@ %a@]" (module_type1 ctxt) mt
+          (list (with_constraint ctxt) ~sep:"@ and@ ")
+          l
+    | _ -> module_type1 ctxt f x
+
+and with_constraint ctxt f = function
+  | Pwith_type (li, ({ ptype_params = ls; _ } as td)) ->
+      let ls = List.map fst ls in
+      pp f "type@ %a %a =@ %a"
+        (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
+        ls longident_loc li (type_declaration ctxt) td
+  | Pwith_module (li, li2) ->
+      pp f "module %a =@ %a" longident_loc li longident_loc li2
+  | Pwith_modtype (li, mty) ->
+      pp f "module type %a =@ %a" longident_loc li (module_type ctxt) mty
+  | Pwith_typesubst (li, ({ ptype_params = ls; _ } as td)) ->
+      let ls = List.map fst ls in
+      pp f "type@ %a %a :=@ %a"
+        (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
+        ls longident_loc li (type_declaration ctxt) td
+  | Pwith_modsubst (li, li2) ->
+      pp f "module %a :=@ %a" longident_loc li longident_loc li2
+  | Pwith_modtypesubst (li, mty) ->
+      pp f "module type %a :=@ %a" longident_loc li (module_type ctxt) mty
+
+and module_type1 ctxt f x =
+  if x.pmty_attributes <> [] then module_type ctxt f x
+  else
+    match x.pmty_desc with
+    | Pmty_ident li -> pp f "%a" longident_loc li
+    | Pmty_alias li -> pp f "(module %a)" longident_loc li
+    | Pmty_signature s ->
+        pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" (* "@[<hov>sig@ %a@ end@]" *)
+          (list (signature_item ctxt))
+          s
+        (* FIXME wrong indentation*)
+    | Pmty_typeof me ->
+        pp f "@[<hov2>module@ type@ of@ %a@]" (module_expr ctxt) me
+    | Pmty_extension e -> extension ctxt f e
+    | _ -> paren true (module_type ctxt) f x
+
+and signature ctxt f x = list ~sep:"@\n" (signature_item ctxt) f x
+
+and signature_item ctxt f x : unit =
+  match x.psig_desc with
+  | Psig_type (rf, l) -> type_def_list ctxt f (rf, true, l)
+  | Psig_typesubst l ->
+      (* Psig_typesubst is never recursive, but we specify [Recursive] here to
+         avoid printing a [nonrec] flag, which would be rejected by the parser.
+      *)
+      type_def_list ctxt f (Recursive, false, l)
+  | Psig_value vd ->
+      let intro = if vd.pval_prim = [] then "val" else "external" in
+      pp f "@[<2>%s@ %a@ :@ %a@]%a" intro protect_ident vd.pval_name.txt
+        (value_description ctxt) vd (item_attributes ctxt) vd.pval_attributes
+  | Psig_typext te -> type_extension ctxt f te
+  | Psig_exception ed -> exception_declaration ctxt f ed
+  | Psig_class l -> (
+      let class_description kwd f
+          ({ pci_params = ls; pci_name = { txt; _ }; _ } as x) =
+        pp f "@[<2>%s %a%a%s@;:@;%a@]%a" kwd virtual_flag x.pci_virt
+          (class_params_def ctxt) ls txt (class_type ctxt) x.pci_expr
+          (item_attributes ctxt) x.pci_attributes
+      in
+      match l with
+      | [] -> ()
+      | [ x ] -> class_description "class" f x
+      | x :: xs ->
+          pp f "@[<v>%a@,%a@]"
+            (class_description "class")
+            x
+            (list ~sep:"@," (class_description "and"))
+            xs)
+  | Psig_module
+      ({
+         pmd_type = { pmty_desc = Pmty_alias alias; pmty_attributes = []; _ };
+         _;
+       } as pmd) ->
+      pp f "@[<hov>module@ %s@ =@ %a@]%a"
+        (Option.value pmd.pmd_name.txt ~default:"_")
+        longident_loc alias (item_attributes ctxt) pmd.pmd_attributes
+  | Psig_module pmd ->
+      pp f "@[<hov>module@ %s@ :@ %a@]%a"
+        (Option.value pmd.pmd_name.txt ~default:"_")
+        (module_type ctxt) pmd.pmd_type (item_attributes ctxt)
+        pmd.pmd_attributes
+  | Psig_modsubst pms ->
+      pp f "@[<hov>module@ %s@ :=@ %a@]%a" pms.pms_name.txt longident_loc
+        pms.pms_manifest (item_attributes ctxt) pms.pms_attributes
+  | Psig_open od ->
+      pp f "@[<hov2>open%s@ %a@]%a"
+        (override od.popen_override)
+        longident_loc od.popen_expr (item_attributes ctxt) od.popen_attributes
+  | Psig_include incl ->
+      pp f "@[<hov2>include@ %a@]%a" (module_type ctxt) incl.pincl_mod
+        (item_attributes ctxt) incl.pincl_attributes
+  | Psig_modtype { pmtd_name = s; pmtd_type = md; pmtd_attributes = attrs } ->
+      pp f "@[<hov2>module@ type@ %s%a@]%a" s.txt
+        (fun f md ->
+          match md with
+          | None -> ()
+          | Some mt ->
+              pp_print_space f ();
+              pp f "@ =@ %a" (module_type ctxt) mt)
+        md (item_attributes ctxt) attrs
+  | Psig_modtypesubst { pmtd_name = s; pmtd_type = md; pmtd_attributes = attrs }
+    ->
+      let md =
+        match md with None -> assert false (* ast invariant *) | Some mt -> mt
+      in
+      pp f "@[<hov2>module@ type@ %s@ :=@ %a@]%a" s.txt (module_type ctxt) md
+        (item_attributes ctxt) attrs
+  | Psig_class_type l -> class_type_declaration_list ctxt f l
+  | Psig_recmodule decls ->
+      let rec string_x_module_type_list f ?(first = true) l =
+        match l with
+        | [] -> ()
+        | pmd :: tl ->
+            if not first then
+              pp f "@ @[<hov2>and@ %s:@ %a@]%a"
+                (Option.value pmd.pmd_name.txt ~default:"_")
+                (module_type1 ctxt) pmd.pmd_type (item_attributes ctxt)
+                pmd.pmd_attributes
+            else
+              pp f "@[<hov2>module@ rec@ %s:@ %a@]%a"
+                (Option.value pmd.pmd_name.txt ~default:"_")
+                (module_type1 ctxt) pmd.pmd_type (item_attributes ctxt)
+                pmd.pmd_attributes;
+            string_x_module_type_list f ~first:false tl
+      in
+      string_x_module_type_list f decls
+  | Psig_attribute a -> floating_attribute ctxt f a
+  | Psig_extension (e, a) ->
+      item_extension ctxt f e;
+      item_attributes ctxt f a
+
+and module_expr ctxt f x =
+  if x.pmod_attributes <> [] then
+    pp f "((%a)%a)" (module_expr ctxt)
+      { x with pmod_attributes = [] }
+      (attributes ctxt) x.pmod_attributes
+  else
+    match x.pmod_desc with
+    | Pmod_structure s ->
+        pp f "@[<hv2>struct@;@[<0>%a@]@;<1 -2>end@]"
+          (list (structure_item ctxt) ~sep:"@\n")
+          s
+    | Pmod_constraint (me, mt) ->
+        pp f "@[<hov2>(%a@ :@ %a)@]" (module_expr ctxt) me (module_type ctxt) mt
+    | Pmod_ident li -> pp f "%a" longident_loc li
+    | Pmod_functor (Unit, me) -> pp f "functor ()@;->@;%a" (module_expr ctxt) me
+    | Pmod_functor (Named (s, mt), me) ->
+        pp f "functor@ (%s@ :@ %a)@;->@;%a"
+          (Option.value s.txt ~default:"_")
+          (module_type ctxt) mt (module_expr ctxt) me
+    | Pmod_apply (me1, me2) ->
+        pp f "(%a)(%a)" (module_expr ctxt) me1 (module_expr ctxt) me2
+        (* Cf: #7200 *)
+    | Pmod_unpack e -> pp f "(val@ %a)" (expression ctxt) e
+    | Pmod_extension e -> extension ctxt f e
+
+and structure ctxt f x = list ~sep:"@\n" (structure_item ctxt) f x
+
+and payload ctxt f = function
+  | PStr [ { pstr_desc = Pstr_eval (e, attrs) } ] ->
+      pp f "@[<2>%a@]%a" (expression ctxt) e (item_attributes ctxt) attrs
+  | PStr x -> structure ctxt f x
+  | PTyp x ->
+      pp f ":@ ";
+      core_type ctxt f x
+  | PSig x ->
+      pp f ":@ ";
+      signature ctxt f x
+  | PPat (x, None) ->
+      pp f "?@ ";
+      pattern ctxt f x
+  | PPat (x, Some e) ->
+      pp f "?@ ";
+      pattern ctxt f x;
+      pp f " when ";
+      expression ctxt f e
+
+(* transform [f = fun g h -> ..] to [f g h = ... ] could be improved *)
+and binding ctxt f { pvb_pat = p; pvb_expr = x; _ } =
+  (* .pvb_attributes have already been printed by the caller, #bindings *)
+  let rec pp_print_pexp_function f x =
+    if x.pexp_attributes <> [] then pp f "=@;%a" (expression ctxt) x
+    else
+      match x.pexp_desc with
+      | Pexp_fun (label, eo, p, e) ->
+          if label = Nolabel then
+            pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function e
+          else
+            pp f "%a@ %a" (label_exp ctxt) (label, eo, p) pp_print_pexp_function
+              e
+      | Pexp_newtype (str, e) ->
+          pp f "(type@ %s)@ %a" str.txt pp_print_pexp_function e
+      | _ -> pp f "=@;%a" (expression ctxt) x
+  in
+  let tyvars_str tyvars = List.map (fun v -> v.txt) tyvars in
+  let is_desugared_gadt p e =
+    let gadt_pattern =
+      match p with
+      | {
+       ppat_desc =
+         Ppat_constraint
+           ( ({ ppat_desc = Ppat_var _ } as pat),
+             { ptyp_desc = Ptyp_poly (args_tyvars, rt) } );
+       ppat_attributes = [];
+      } ->
+          Some (pat, args_tyvars, rt)
+      | _ -> None
+    in
+    let rec gadt_exp tyvars e =
+      match e with
+      | { pexp_desc = Pexp_newtype (tyvar, e); pexp_attributes = [] } ->
+          gadt_exp (tyvar :: tyvars) e
+      | { pexp_desc = Pexp_constraint (e, ct); pexp_attributes = [] } ->
+          Some (List.rev tyvars, e, ct)
+      | _ -> None
+    in
+    let gadt_exp = gadt_exp [] e in
+    match (gadt_pattern, gadt_exp) with
+    | Some (p, pt_tyvars, pt_ct), Some (e_tyvars, e, e_ct)
+      when tyvars_str pt_tyvars = tyvars_str e_tyvars ->
+        let ety = varify_type_constructors e_tyvars e_ct in
+        if ety = pt_ct then Some (p, pt_tyvars, e_ct, e) else None
+    | _ -> None
+  in
+  if x.pexp_attributes <> [] then
+    match p with
+    | {
+     ppat_desc =
+       Ppat_constraint
+         ( ({ ppat_desc = Ppat_var _; _ } as pat),
+           ({ ptyp_desc = Ptyp_poly _; _ } as typ) );
+     ppat_attributes = [];
+     _;
+    } ->
+        pp f "%a@;: %a@;=@;%a" (simple_pattern ctxt) pat (core_type ctxt) typ
+          (expression ctxt) x
+    | _ -> pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x
+  else
+    match is_desugared_gadt p x with
+    | Some (p, [], ct, e) ->
+        pp f "%a@;: %a@;=@;%a" (simple_pattern ctxt) p (core_type ctxt) ct
+          (expression ctxt) e
+    | Some (p, tyvars, ct, e) ->
+        pp f "%a@;: type@;%a.@;%a@;=@;%a" (simple_pattern ctxt) p
+          (list pp_print_string ~sep:"@;")
+          (tyvars_str tyvars) (core_type ctxt) ct (expression ctxt) e
+    | None -> (
+        match p with
+        | { ppat_desc = Ppat_constraint (p, ty); ppat_attributes = [] } -> (
+            (* special case for the first*)
+            match ty with
+            | { ptyp_desc = Ptyp_poly _; ptyp_attributes = [] } ->
+                pp f "%a@;:@;%a@;=@;%a" (simple_pattern ctxt) p (core_type ctxt)
+                  ty (expression ctxt) x
+            | _ ->
+                pp f "(%a@;:@;%a)@;=@;%a" (simple_pattern ctxt) p
+                  (core_type ctxt) ty (expression ctxt) x)
+        | { ppat_desc = Ppat_var _; ppat_attributes = [] } ->
+            pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function x
+        | _ -> pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x)
+
+(* [in] is not printed *)
+and bindings ctxt f (rf, l) =
+  let binding kwd rf f x =
+    pp f "@[<2>%s %a%a@]%a" kwd rec_flag rf (binding ctxt) x
+      (item_attributes ctxt) x.pvb_attributes
+  in
+  match l with
+  | [] -> ()
+  | [ x ] -> binding "let" rf f x
+  | x :: xs ->
+      pp f "@[<v>%a@,%a@]" (binding "let" rf) x
+        (list ~sep:"@," (binding "and" Nonrecursive))
+        xs
+
+and binding_op ctxt f x =
+  match (x.pbop_pat, x.pbop_exp) with
+  | ( { ppat_desc = Ppat_var { txt = pvar; _ }; ppat_attributes = []; _ },
+      {
+        pexp_desc = Pexp_ident { txt = Lident evar; _ };
+        pexp_attributes = [];
+        _;
+      } )
+    when pvar = evar ->
+      pp f "@[<2>%s %s@]" x.pbop_op.txt evar
+  | pat, exp ->
+      pp f "@[<2>%s %a@;=@;%a@]" x.pbop_op.txt (pattern ctxt) pat
+        (expression ctxt) exp
+
+and structure_item ctxt f x =
+  match x.pstr_desc with
+  | Pstr_eval (e, attrs) ->
+      pp f "@[<hov2>;;%a@]%a" (expression ctxt) e (item_attributes ctxt) attrs
+  | Pstr_type (_, []) -> assert false
+  | Pstr_type (rf, l) -> type_def_list ctxt f (rf, true, l)
+  | Pstr_value (rf, l) ->
+      (* pp f "@[<hov2>let %a%a@]"  rec_flag rf bindings l *)
+      pp f "@[<2>%a@]" (bindings ctxt) (rf, l)
+  | Pstr_typext te -> type_extension ctxt f te
+  | Pstr_exception ed -> exception_declaration ctxt f ed
+  | Pstr_module x ->
+      let rec module_helper = function
+        | { pmod_desc = Pmod_functor (arg_opt, me'); pmod_attributes = [] } ->
+            (match arg_opt with
+            | Unit -> pp f "()"
+            | Named (s, mt) ->
+                pp f "(%s:%a)"
+                  (Option.value s.txt ~default:"_")
+                  (module_type ctxt) mt);
+            module_helper me'
+        | me -> me
+      in
+      pp f "@[<hov2>module %s%a@]%a"
+        (Option.value x.pmb_name.txt ~default:"_")
+        (fun f me ->
+          let me = module_helper me in
+          match me with
+          | {
+           pmod_desc =
+             Pmod_constraint
+               (me', ({ pmty_desc = Pmty_ident _ | Pmty_signature _; _ } as mt));
+           pmod_attributes = [];
+          } ->
+              pp f " :@;%a@;=@;%a@;" (module_type ctxt) mt (module_expr ctxt)
+                me'
+          | _ -> pp f " =@ %a" (module_expr ctxt) me)
+        x.pmb_expr (item_attributes ctxt) x.pmb_attributes
+  | Pstr_open od ->
+      pp f "@[<2>open%s@;%a@]%a"
+        (override od.popen_override)
+        (module_expr ctxt) od.popen_expr (item_attributes ctxt)
+        od.popen_attributes
+  | Pstr_modtype { pmtd_name = s; pmtd_type = md; pmtd_attributes = attrs } ->
+      pp f "@[<hov2>module@ type@ %s%a@]%a" s.txt
+        (fun f md ->
+          match md with
+          | None -> ()
+          | Some mt ->
+              pp_print_space f ();
+              pp f "@ =@ %a" (module_type ctxt) mt)
+        md (item_attributes ctxt) attrs
+  | Pstr_class l -> (
+      let extract_class_args cl =
+        let rec loop acc = function
+          | { pcl_desc = Pcl_fun (l, eo, p, cl'); pcl_attributes = [] } ->
+              loop ((l, eo, p) :: acc) cl'
+          | cl -> (List.rev acc, cl)
+        in
+        let args, cl = loop [] cl in
+        let constr, cl =
+          match cl with
+          | { pcl_desc = Pcl_constraint (cl', ct); pcl_attributes = [] } ->
+              (Some ct, cl')
+          | _ -> (None, cl)
+        in
+        (args, constr, cl)
+      in
+      let class_constraint f ct = pp f ": @[%a@] " (class_type ctxt) ct in
+      let class_declaration kwd f
+          ({ pci_params = ls; pci_name = { txt; _ }; _ } as x) =
+        let args, constr, cl = extract_class_args x.pci_expr in
+        pp f "@[<2>%s %a%a%s %a%a=@;%a@]%a" kwd virtual_flag x.pci_virt
+          (class_params_def ctxt) ls txt
+          (list (label_exp ctxt))
+          args (option class_constraint) constr (class_expr ctxt) cl
+          (item_attributes ctxt) x.pci_attributes
+      in
+      match l with
+      | [] -> ()
+      | [ x ] -> class_declaration "class" f x
+      | x :: xs ->
+          pp f "@[<v>%a@,%a@]"
+            (class_declaration "class")
+            x
+            (list ~sep:"@," (class_declaration "and"))
+            xs)
+  | Pstr_class_type l -> class_type_declaration_list ctxt f l
+  | Pstr_primitive vd ->
+      pp f "@[<hov2>external@ %a@ :@ %a@]%a" protect_ident vd.pval_name.txt
+        (value_description ctxt) vd (item_attributes ctxt) vd.pval_attributes
+  | Pstr_include incl ->
+      pp f "@[<hov2>include@ %a@]%a" (module_expr ctxt) incl.pincl_mod
+        (item_attributes ctxt) incl.pincl_attributes
+  | Pstr_recmodule decls -> (
+      (* 3.07 *)
+      let aux f = function
+        | { pmb_expr = { pmod_desc = Pmod_constraint (expr, typ) } } as pmb ->
+            pp f "@[<hov2>@ and@ %s:%a@ =@ %a@]%a"
+              (Option.value pmb.pmb_name.txt ~default:"_")
+              (module_type ctxt) typ (module_expr ctxt) expr
+              (item_attributes ctxt) pmb.pmb_attributes
+        | pmb ->
+            pp f "@[<hov2>@ and@ %s@ =@ %a@]%a"
+              (Option.value pmb.pmb_name.txt ~default:"_")
+              (module_expr ctxt) pmb.pmb_expr (item_attributes ctxt)
+              pmb.pmb_attributes
+      in
+      match decls with
+      | ({ pmb_expr = { pmod_desc = Pmod_constraint (expr, typ) } } as pmb)
+        :: l2 ->
+          pp f "@[<hv>@[<hov2>module@ rec@ %s:%a@ =@ %a@]%a@ %a@]"
+            (Option.value pmb.pmb_name.txt ~default:"_")
+            (module_type ctxt) typ (module_expr ctxt) expr
+            (item_attributes ctxt) pmb.pmb_attributes
+            (fun f l2 -> List.iter (aux f) l2)
+            l2
+      | pmb :: l2 ->
+          pp f "@[<hv>@[<hov2>module@ rec@ %s@ =@ %a@]%a@ %a@]"
+            (Option.value pmb.pmb_name.txt ~default:"_")
+            (module_expr ctxt) pmb.pmb_expr (item_attributes ctxt)
+            pmb.pmb_attributes
+            (fun f l2 -> List.iter (aux f) l2)
+            l2
+      | _ -> assert false)
+  | Pstr_attribute a -> floating_attribute ctxt f a
+  | Pstr_extension (e, a) ->
+      item_extension ctxt f e;
+      item_attributes ctxt f a
+
+and type_param ctxt f (ct, (a, b)) =
+  pp f "%s%s%a" (type_variance a) (type_injectivity b) (core_type ctxt) ct
+
+and type_params ctxt f = function
+  | [] -> ()
+  | l -> pp f "%a " (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",@;") l
+
+and type_def_list ctxt f (rf, exported, l) =
+  let type_decl kwd rf f x =
+    let eq =
+      if x.ptype_kind = Ptype_abstract && x.ptype_manifest = None then ""
+      else if exported then " ="
+      else " :="
+    in
+    pp f "@[<2>%s %a%a%s%s%a@]%a" kwd nonrec_flag rf (type_params ctxt)
+      x.ptype_params x.ptype_name.txt eq (type_declaration ctxt) x
+      (item_attributes ctxt) x.ptype_attributes
+  in
+  match l with
+  | [] -> assert false
+  | [ x ] -> type_decl "type" rf f x
+  | x :: xs ->
+      pp f "@[<v>%a@,%a@]" (type_decl "type" rf) x
+        (list ~sep:"@," (type_decl "and" Recursive))
+        xs
+
+and record_declaration ctxt f lbls =
+  let type_record_field f pld =
+    pp f "@[<2>%a%s:@;%a@;%a@]" mutable_flag pld.pld_mutable pld.pld_name.txt
+      (core_type ctxt) pld.pld_type (attributes ctxt) pld.pld_attributes
+  in
+  pp f "{@\n%a}" (list type_record_field ~sep:";@\n") lbls
+
+and type_declaration ctxt f x =
+  (* type_declaration has an attribute field,
+     but it's been printed by the caller of this method *)
+  let priv f =
+    match x.ptype_private with Public -> () | Private -> pp f "@;private"
+  in
+  let manifest f =
+    match x.ptype_manifest with
+    | None -> ()
+    | Some y ->
+        if x.ptype_kind = Ptype_abstract then
+          pp f "%t@;%a" priv (core_type ctxt) y
+        else pp f "@;%a" (core_type ctxt) y
+  in
+  let constructor_declaration f pcd =
+    pp f "|@;";
+    constructor_declaration ctxt f
+      ( pcd.pcd_name.txt,
+        pcd.pcd_vars,
+        pcd.pcd_args,
+        pcd.pcd_res,
+        pcd.pcd_attributes )
+  in
+  let repr f =
+    let intro f = if x.ptype_manifest = None then () else pp f "@;=" in
+    match x.ptype_kind with
+    | Ptype_variant xs ->
+        let variants fmt xs =
+          if xs = [] then pp fmt " |"
+          else pp fmt "@\n%a" (list ~sep:"@\n" constructor_declaration) xs
+        in
+        pp f "%t%t%a" intro priv variants xs
+    | Ptype_abstract -> ()
+    | Ptype_record l -> pp f "%t%t@;%a" intro priv (record_declaration ctxt) l
+    | Ptype_open -> pp f "%t%t@;.." intro priv
+  in
+  let constraints f =
+    List.iter
+      (fun (ct1, ct2, _) ->
+        pp f "@[<hov2>@ constraint@ %a@ =@ %a@]" (core_type ctxt) ct1
+          (core_type ctxt) ct2)
+      x.ptype_cstrs
+  in
+  pp f "%t%t%t" manifest repr constraints
+
+and type_extension ctxt f x =
+  let extension_constructor f x =
+    pp f "@\n|@;%a" (extension_constructor ctxt) x
+  in
+  pp f "@[<2>type %a%a += %a@ %a@]%a"
+    (fun f -> function
+      | [] -> ()
+      | l ->
+          pp f "%a@;" (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",") l)
+    x.ptyext_params longident_loc x.ptyext_path private_flag
+    x.ptyext_private (* Cf: #7200 *)
+    (list ~sep:"" extension_constructor)
+    x.ptyext_constructors (item_attributes ctxt) x.ptyext_attributes
+
+and constructor_declaration ctxt f (name, vars, args, res, attrs) =
+  let name = match name with "::" -> "(::)" | s -> s in
+  let pp_vars f vs =
+    match vs with
+    | [] -> ()
+    | vs -> pp f "%a@;.@;" (list tyvar_loc ~sep:"@;") vs
+  in
+  match res with
+  | None ->
+      pp f "%s%a@;%a" name
+        (fun f -> function
+          | Pcstr_tuple [] -> ()
+          | Pcstr_tuple l ->
+              pp f "@;of@;%a" (list (core_type1 ctxt) ~sep:"@;*@;") l
+          | Pcstr_record l -> pp f "@;of@;%a" (record_declaration ctxt) l)
+        args (attributes ctxt) attrs
+  | Some r ->
+      pp f "%s:@;%a%a@;%a" name pp_vars vars
+        (fun f -> function
+          | Pcstr_tuple [] -> core_type1 ctxt f r
+          | Pcstr_tuple l ->
+              pp f "%a@;->@;%a"
+                (list (core_type1 ctxt) ~sep:"@;*@;")
+                l (core_type1 ctxt) r
+          | Pcstr_record l ->
+              pp f "%a@;->@;%a" (record_declaration ctxt) l (core_type1 ctxt) r)
+        args (attributes ctxt) attrs
+
+and extension_constructor ctxt f x =
+  (* Cf: #7200 *)
+  match x.pext_kind with
+  | Pext_decl (v, l, r) ->
+      constructor_declaration ctxt f
+        (x.pext_name.txt, v, l, r, x.pext_attributes)
+  | Pext_rebind li ->
+      pp f "%s@;=@;%a%a" x.pext_name.txt longident_loc li (attributes ctxt)
+        x.pext_attributes
+
+and case_list ctxt f l : unit =
+  let aux f { pc_lhs; pc_guard; pc_rhs } =
+    pp f "@;| @[<2>%a%a@;->@;%a@]" (pattern ctxt) pc_lhs
+      (option (expression ctxt) ~first:"@;when@;")
+      pc_guard
+      (expression (under_pipe ctxt))
+      pc_rhs
+  in
+  list aux f l ~sep:""
+
+and label_x_expression_param ctxt f (l, e) =
+  let simple_name =
+    match e with
+    | { pexp_desc = Pexp_ident { txt = Lident l; _ }; pexp_attributes = [] } ->
+        Some l
+    | _ -> None
+  in
+  match l with
+  | Nolabel -> expression2 ctxt f e (* level 2*)
+  | Optional str ->
+      if Some str = simple_name then pp f "?%s" str
+      else pp f "?%s:%a" str (simple_expr ctxt) e
+  | Labelled lbl ->
+      if Some lbl = simple_name then pp f "~%s" lbl
+      else pp f "~%s:%a" lbl (simple_expr ctxt) e
+
+and directive_argument f x =
+  match x.pdira_desc with
+  | Pdir_string s -> pp f "@ %S" s
+  | Pdir_int (n, None) -> pp f "@ %s" n
+  | Pdir_int (n, Some m) -> pp f "@ %s%c" n m
+  | Pdir_ident li -> pp f "@ %a" longident li
+  | Pdir_bool b -> pp f "@ %s" (string_of_bool b)
+
+let toplevel_phrase f x =
+  match x with
+  | Ptop_def s -> pp f "@[<hov0>%a@]" (list (structure_item reset_ctxt)) s
+  (* pp_open_hvbox f 0; *)
+  (* pp_print_list structure_item f s ; *)
+  (* pp_close_box f (); *)
+  | Ptop_dir { pdir_name; pdir_arg = None; _ } ->
+      pp f "@[<hov2>#%s@]" pdir_name.txt
+  | Ptop_dir { pdir_name; pdir_arg = Some pdir_arg; _ } ->
+      pp f "@[<hov2>#%s@ %a@]" pdir_name.txt directive_argument pdir_arg
+
+let expression f x = pp f "@[%a@]" (expression reset_ctxt) x
+
+let string_of_expression x =
+  ignore (flush_str_formatter ());
+  let f = str_formatter in
+  expression f x;
+  flush_str_formatter ()
+
+let string_of_structure x =
+  ignore (flush_str_formatter ());
+  let f = str_formatter in
+  structure reset_ctxt f x;
+  flush_str_formatter ()
+
+let top_phrase f x =
+  pp_print_newline f ();
+  toplevel_phrase f x;
+  pp f ";;";
+  pp_print_newline f ()
+
+let core_type = core_type reset_ctxt
+let pattern = pattern reset_ctxt
+let signature = signature reset_ctxt
+let structure = structure reset_ctxt
+let class_expr = class_expr reset_ctxt
+let class_field = class_field reset_ctxt
+let class_type = class_type reset_ctxt
+let class_signature = class_signature reset_ctxt
+let class_type_field = class_type_field reset_ctxt
+let module_expr = module_expr reset_ctxt
+let module_type = module_type reset_ctxt
+let signature_item = signature_item reset_ctxt
+let structure_item = structure_item reset_ctxt
+let type_declaration = type_declaration reset_ctxt
diff --git a/src/lib_gen/generator.ml b/src/lib_gen/generator.ml
index 2a846b6..a713ed1 100644
--- a/src/lib_gen/generator.ml
+++ b/src/lib_gen/generator.ml
@@ -50,7 +50,7 @@ let gen_structure_with_json_codec :
       ]
       decl
   in
-  Astlib.Pprintast.structure formatter structure
+  Emitter.structure formatter structure
 
 let gen_signature_with_json_codec
   ?gen_json_shape_explanation
@@ -70,4 +70,4 @@ let gen_signature_with_json_codec
       ]
       decl
   in
-  Astlib.Pprintast.signature formatter structure
+  Emitter.signature formatter structure
diff --git a/src/lib_gen/unit_test/gen/gen_embed_full_impl.ml b/src/lib_gen/unit_test/gen/gen_embed_full_impl.ml
index 6eb7f3d..a850b85 100644
--- a/src/lib_gen/unit_test/gen/gen_embed_full_impl.ml
+++ b/src/lib_gen/unit_test/gen/gen_embed_full_impl.ml
@@ -72,7 +72,7 @@ let gen_structure_embed_full_impl =
       ]
       decl
   in
-  Astlib.Pprintast.structure formatter structure
+  Emitter.structure formatter structure
 
 let () =
   let gen_type_decl = ArgOptions.has_flag "-gen-type-decl" in