Expose migration/copying/etc. functions for all AST types needed by Pprintast

.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

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)
 -------------------
 

ast/cinaps/ast_cinaps_helpers.ml

@@ -3,33 +3,15 @@
 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 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
+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 ->

ast/cinaps/dune

@@ -1,3 +1,3 @@
 (library
  (name ast_cinaps_helpers)
- (libraries supported_version))
+ (libraries stdppx supported_version astlib_cinaps_helpers))

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"
+              (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"
+              (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"
+              (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