Migrate Ptyp_open from 502 to 501

A bug fix to support migration syntax like `type t = M.(t)` to the 501
AST via, our now, standard approach of using extensions. This really
only impacts those who have not upgraded ppxlib to 0.36.0.

Signed-off-by: Patrick Ferris <patrick@sirref.org>

.ocamlformat-ignore

@@ -61,5 +61,5 @@ test/ppx_import_support/test.ml
 test/quoter/test.ml
 test/traverse/test.ml
 test/type_is_recursive/test.ml
-test/502_pexpfun/test.ml
+test/502_migrations/test.ml
 test/encoding/503/api/test.ml

astlib/encoding_502.ml

@@ -0,0 +1,30 @@
+module Ext_name = struct
+  let ptyp_open = "ppxlib.migration.ptyp_open_502"
+end
+
+let invalid_encoding ~loc name =
+  Location.raise_errorf ~loc "Invalid %s encoding" name
+
+module To_501 = struct
+  open Ast_501.Asttypes
+  open Ast_501.Parsetree
+
+  let encode_ptyp_open ~loc ((name, typ) : Longident.t Location.loc * core_type)
+      : extension =
+    let typ = Ptyp_constr (name, [ typ ]) in
+    let ctyp =
+      {
+        ptyp_desc = typ;
+        ptyp_loc = loc;
+        ptyp_attributes = [];
+        ptyp_loc_stack = [];
+      }
+    in
+    let payload = PTyp ctyp in
+    let ext = { txt = Ext_name.ptyp_open; loc } in
+    (ext, payload)
+
+  let decode_ptyp_open ~loc = function
+    | PTyp { ptyp_desc = Ptyp_constr (name, [ typ ]); _ } -> (name, typ)
+    | _ -> invalid_encoding ~loc Ext_name.ptyp_open
+end

astlib/migrate_501_502.ml

@@ -455,9 +455,10 @@ and copy_core_type : Ast_501.Parsetree.core_type -> Ast_502.Parsetree.core_type
        Ast_501.Parsetree.ptyp_loc_stack;
        Ast_501.Parsetree.ptyp_attributes;
      } ->
+  let loc = copy_location ptyp_loc in
   {
-    Ast_502.Parsetree.ptyp_desc = copy_core_type_desc ptyp_desc;
-    Ast_502.Parsetree.ptyp_loc = copy_location ptyp_loc;
+    Ast_502.Parsetree.ptyp_desc = copy_core_type_desc ~loc ptyp_desc;
+    Ast_502.Parsetree.ptyp_loc = loc;
     Ast_502.Parsetree.ptyp_loc_stack = copy_location_stack ptyp_loc_stack;
     Ast_502.Parsetree.ptyp_attributes = copy_attributes ptyp_attributes;
   }
@@ -467,8 +468,10 @@ and copy_location_stack :
  fun x -> List.map copy_location x
 
 and copy_core_type_desc :
-    Ast_501.Parsetree.core_type_desc -> Ast_502.Parsetree.core_type_desc =
-  function
+    loc:Location.t ->
+    Ast_501.Parsetree.core_type_desc ->
+    Ast_502.Parsetree.core_type_desc =
+ fun ~loc -> function
   | Ast_501.Parsetree.Ptyp_any -> Ast_502.Parsetree.Ptyp_any
   | Ast_501.Parsetree.Ptyp_var x0 -> Ast_502.Parsetree.Ptyp_var x0
   | Ast_501.Parsetree.Ptyp_arrow (x0, x1, x2) ->
@@ -498,6 +501,11 @@ and copy_core_type_desc :
         (List.map (fun x -> copy_loc (fun x -> x) x) x0, copy_core_type x1)
   | Ast_501.Parsetree.Ptyp_package x0 ->
       Ast_502.Parsetree.Ptyp_package (copy_package_type x0)
+  | Ast_501.Parsetree.Ptyp_extension (x0, payload)
+    when String.equal x0.txt Encoding_502.Ext_name.ptyp_open ->
+      let name, ctyp = Encoding_502.To_501.decode_ptyp_open ~loc payload in
+      Ast_502.Parsetree.Ptyp_open
+        (copy_loc copy_Longident_t name, copy_core_type ctyp)
   | Ast_501.Parsetree.Ptyp_extension x0 ->
       Ast_502.Parsetree.Ptyp_extension (copy_extension x0)
 

astlib/migrate_502_501.ml

@@ -2,10 +2,6 @@ open Stdlib0
 module From = Ast_502
 module To = Ast_501
 
-let migration_error loc missing_feature =
-  Location.raise_errorf ~loc
-    "migration error: %s is not supported before OCaml 5.02" missing_feature
-
 let mk_ghost_attr name =
   {
     Ast_501.Parsetree.attr_name = { Location.txt = name; loc = Location.none };
@@ -525,7 +521,11 @@ and copy_core_type_desc loc :
   | Ast_502.Parsetree.Ptyp_extension x0 ->
       Ast_501.Parsetree.Ptyp_extension (copy_extension x0)
   | Ast_502.Parsetree.Ptyp_open (x0, x1) ->
-      migration_error loc "module open in types"
+      let e =
+        Encoding_502.To_501.encode_ptyp_open ~loc
+          (copy_loc copy_Longident_t x0, copy_core_type x1)
+      in
+      Ast_501.Parsetree.Ptyp_extension e
 
 and copy_package_type :
     Ast_502.Parsetree.package_type -> Ast_501.Parsetree.package_type =

test/502_migrations/driver.ml

@@ -0,0 +1,15 @@
+module To_before_502 =
+  Ppxlib_ast.Convert (Ppxlib_ast.Js) (Ppxlib_ast__.Versions.OCaml_501)
+
+module From_before_502 =
+  Ppxlib_ast.Convert (Ppxlib_ast__.Versions.OCaml_501) (Ppxlib_ast.Js)
+
+let impl _ctxt str =
+  (* This manual migration is here to ensure the test still works even once our
+     internal AST has been bumped past 5.3 *)
+  let before_502_ast = To_before_502.copy_structure str in
+  let roundtrip = From_before_502.copy_structure before_502_ast in
+  roundtrip
+
+let () = Ppxlib.Driver.V2.register_transformation ~impl "502-downward-roundtrip"
+let () = Ppxlib.Driver.standalone ()

test/502_pexpfun/run.t → test/502_migrations/run.t

@@ -1,11 +1,33 @@
+The driver in the following tests force a migration to before 502 similar
+to what happens in test/503_migrations.
+
+1. Ptyp_open
+
+Local module open types should be preserved during the migrations.
+
+  $ cat > test.ml << EOF
+  > module M = struct
+  >   type t = int
+  > end
+  > 
+  > type t = M.(t)
+  > EOF
+
+  $ ./driver.exe test.ml
+  module M = struct type t = int end
+  type t = M.(t)
+
+
+2. Valid locations 
+
 We want to make sure that migrations from 5.2 to previous versions still
 produce valid location ranges between parent and child.
 
   $ cat > test.ml << EOF
   > let make ~foo ~bar = foo ^ bar
   > EOF
 
-We run a custom driver that will read our ast, migrate it back to 5.01, and
+We run a custom driver that will read our ast, migrate it back to 5.1, and
 check that the locations are valid (the parent range is larger than the child
 range).
 
@@ -17,3 +39,5 @@ Locations should also be well formed for Pparam_newtype
   > EOF
 
   $ ./driver.exe -locations-check --impl test.ml -o ignore.ml
+
+