Support migrating external types

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

Author: patricoferris

astlib/encoding_505.ml

@@ -2,6 +2,7 @@ module Ext_name = struct
   let pexp_struct_item = "ppxlib.migration.pexp_struct_item_505"
   let ptyp_functor = "ppxlib.migration.ptyp_functor_505"
   let ppat_unpack = "ppxlib.migration.ppat_unpack_505"
+  let ptype_kind_external = "ppxlib.migration.ptype_kind_external_505"
 end
 
 let invalid_encoding ~loc name =
@@ -57,4 +58,36 @@ module To_504 = struct
         } ->
         (arg, attr.attr_name, pkg, typ)
     | _ -> invalid_encoding ~loc Ext_name.ptyp_functor
+
+  let encode_ptype_kind_external name =
+    let name_attr =
+      {
+        attr_name = { txt = name; loc = Location.none };
+        attr_loc = Location.none;
+        attr_payload = PStr [];
+      }
+    in
+    let si =
+      { pstr_desc = Pstr_attribute name_attr; pstr_loc = Location.none }
+    in
+    {
+      attr_name = { txt = Ext_name.ptype_kind_external; loc = Location.none };
+      attr_loc = Location.none;
+      attr_payload = PStr [ si ];
+    }
+
+  let decode_ptype_kind_external = function
+    | {
+        attr_name = { txt; _ };
+        attr_payload =
+          PStr
+            [
+              {
+                pstr_desc = Pstr_attribute { attr_name = { txt = name; _ }; _ };
+              };
+            ];
+      }
+      when String.equal txt Ext_name.ptype_kind_external ->
+        Some name
+    | _ -> None
 end

astlib/migrate_504_505.ml

@@ -623,6 +623,22 @@ and copy_type_declaration :
        Ast_504.Parsetree.ptype_attributes;
        Ast_504.Parsetree.ptype_loc;
      } ->
+  let external_name, ptype_attributes =
+    let rec aux so_far = function
+      | [] -> (None, List.rev so_far)
+      | Ast_504.Parsetree.({ attr_name = { txt; _ }; _ } as attr) :: rest
+        when String.equal txt Encoding_505.Ext_name.ptype_kind_external ->
+          ( Encoding_505.To_504.decode_ptype_kind_external attr,
+            List.rev_append so_far rest )
+      | attr :: rest -> aux (attr :: so_far) rest
+    in
+    aux [] ptype_attributes
+  in
+  let ptype_kind =
+    match external_name with
+    | Some name -> Ast_505.Parsetree.Ptype_external name
+    | None -> copy_type_kind ptype_kind
+  in
   {
     Ast_505.Parsetree.ptype_name = copy_loc (fun x -> x) ptype_name;
     Ast_505.Parsetree.ptype_params =
@@ -639,7 +655,7 @@ and copy_type_declaration :
           let x0, x1, x2 = x in
           (copy_core_type x0, copy_core_type x1, copy_location x2))
         ptype_cstrs;
-    Ast_505.Parsetree.ptype_kind = copy_type_kind ptype_kind;
+    Ast_505.Parsetree.ptype_kind;
     Ast_505.Parsetree.ptype_private = copy_private_flag ptype_private;
     Ast_505.Parsetree.ptype_manifest = Option.map copy_core_type ptype_manifest;
     Ast_505.Parsetree.ptype_attributes = copy_attributes ptype_attributes;

astlib/migrate_505_504.ml

@@ -617,6 +617,13 @@ and copy_type_declaration :
        Ast_505.Parsetree.ptype_attributes;
        Ast_505.Parsetree.ptype_loc;
      } ->
+  let ptype_attributes =
+    match ptype_kind with
+    | Ptype_external name ->
+        let attr = Encoding_505.To_504.encode_ptype_kind_external name in
+        attr :: copy_attributes ptype_attributes
+    | _ -> copy_attributes ptype_attributes
+  in
   {
     Ast_504.Parsetree.ptype_name = copy_loc (fun x -> x) ptype_name;
     Ast_504.Parsetree.ptype_params =
@@ -636,7 +643,7 @@ and copy_type_declaration :
     Ast_504.Parsetree.ptype_kind = copy_type_kind ptype_kind;
     Ast_504.Parsetree.ptype_private = copy_private_flag ptype_private;
     Ast_504.Parsetree.ptype_manifest = Option.map copy_core_type ptype_manifest;
-    Ast_504.Parsetree.ptype_attributes = copy_attributes ptype_attributes;
+    Ast_504.Parsetree.ptype_attributes;
     Ast_504.Parsetree.ptype_loc = copy_location ptype_loc;
   }
 
@@ -649,7 +656,9 @@ and copy_type_kind : Ast_505.Parsetree.type_kind -> Ast_504.Parsetree.type_kind
       Ast_504.Parsetree.Ptype_record (List.map copy_label_declaration x0)
   | Ast_505.Parsetree.Ptype_open -> Ast_504.Parsetree.Ptype_open
   | Ast_505.Parsetree.Ptype_external x0 ->
-      Location.raise_errorf "External types are not supported."
+      (* Note that copy_type_declaration should handle this for us and we need
+       only put _something_ here. *)
+      Ast_504.Parsetree.Ptype_open
 
 and copy_label_declaration :
     Ast_505.Parsetree.label_declaration -> Ast_504.Parsetree.label_declaration =

test/505_migrations/run.t

@@ -61,9 +61,7 @@ to encode this feature into attributes and this test, along with this comment,
 will need updated.
 
   $ ./driver.exe test.ml --use-compiler-pp
-  File "test.ml", line 1:
-  Error: External types are not supported.
-  [1]
+  type t = external "t"
 
 3. Ptyp_functor