Ppx: port all PPX's to ppxlib (#1041)

Before, the two extension node rewriters in the compiler and in ppx_js
were based on the omp driver and the omp Ast_mapper. The deriver in
ppx_deriving_json was already partly based on ppxlib, but also on
omp's Ast_408. All of those omp modules will be dropped in omp 2.0.0.

Co-authored-by: Hugo Heuzard <[email protected]>

Author: pitag-ha

CHANGES.md

@@ -1,3 +1,7 @@
+# unreleased
+## Features/Changes
+* compiler, ppx_js, ppx_deriving_json: port PPX's to ppxlib (#1041)
+
 # 3.7.1 (2020-09-29) - London
 ## Features/Changes
 * lib: Add Navigator.{vendor,maxTouchPoints} (#1062)

compiler/ppx/dune

@@ -1,6 +1,6 @@
 (library
   (name ppx_optcomp_light)
   (libraries compiler-libs.common
-             ocaml-migrate-parsetree)
+             ppxlib)
   (kind ppx_rewriter)
   )

compiler/ppx/ppx_optcomp_light.ml

@@ -26,9 +26,7 @@
 *)
 
 open StdLabels
-open Migrate_parsetree
-open OCaml_407.Ast
-open Parsetree
+open Ppxlib.Parsetree
 
 module Version : sig
   type t
@@ -86,7 +84,7 @@ let keep loc (attrs : attributes) =
   try
     let keep =
       List.for_all attrs ~f:(function
-          | { Location.txt = ("if" | "ifnot") as ifnot; _ }, attr_payload -> (
+          | { attr_name = { txt = ("if" | "ifnot") as ifnot; _ }; attr_payload; _ } -> (
               let norm =
                 match ifnot with
                 | "if" -> fun x -> x
@@ -186,32 +184,53 @@ let rec filter_pattern = function
   | { ppat_attributes; ppat_loc; _ } as p ->
       if keep ppat_loc ppat_attributes then Some p else None
 
-let mapper =
-  { Ast_mapper.default_mapper with
-    cases =
-      (fun mapper cases ->
-        let cases =
-          filter_map cases ~f:(fun case ->
-              match filter_pattern case.pc_lhs with
-              | None -> None
-              | Some pattern -> Some { case with pc_lhs = pattern })
-        in
-        Ast_mapper.default_mapper.cases mapper cases)
-  ; structure =
-      (fun mapper items ->
-        let items =
-          List.filter items ~f:(fun item ->
-              match item.pstr_desc with
-              | Pstr_module { pmb_attributes; pmb_loc; _ } -> keep pmb_loc pmb_attributes
-              | Pstr_primitive { pval_attributes; pval_loc; _ } ->
-                  keep pval_loc pval_attributes
-              | _ -> true)
-        in
-        Ast_mapper.default_mapper.structure mapper items)
-  }
+(* TODO: This class is useful while we transition to ppxlib.0.17 that provides the `cases`
+   method. Remove this once we drop support for ppxlib < 0.17 *)
+class map =
+  object (self)
+    inherit Ppxlib.Ast_traverse.map as super
+
+    method cases = self#list self#case [@@ocaml.warning "-7"]
+
+    method expression_desc : expression_desc -> expression_desc =
+      fun x ->
+        match x with
+        | Pexp_function a ->
+            let a = self#cases a in
+            Pexp_function a
+        | Pexp_match (a, b) ->
+            let a = self#expression a in
+            let b = self#cases b in
+            Pexp_match (a, b)
+        | Pexp_try (a, b) ->
+            let a = self#expression a in
+            let b = self#cases b in
+            Pexp_try (a, b)
+        | _ -> super#expression_desc x
+    [@@ocaml.warning "-7"]
+  end
+
+let traverse =
+  object
+    inherit map as super
+
+    method! structure items =
+      let items =
+        List.filter items ~f:(fun item ->
+            match item.pstr_desc with
+            | Pstr_module { pmb_attributes; pmb_loc; _ } -> keep pmb_loc pmb_attributes
+            | Pstr_primitive { pval_attributes; pval_loc; _ } ->
+                keep pval_loc pval_attributes
+            | _ -> true)
+      in
+      super#structure items
+
+    method! cases =
+      filter_map ~f:(fun case ->
+          match filter_pattern case.pc_lhs with
+          | None -> None
+          | Some pattern -> Some { case with pc_lhs = pattern })
+  end
 
 let () =
-  Driver.register
-    ~name:"ppx_optcomp_light"
-    Migrate_parsetree.Versions.ocaml_407
-    (fun _config _cookies -> mapper)
+  Ppxlib.Driver.register_transformation ~impl:traverse#structure "ppx_optcomp_light"

js_of_ocaml-compiler.opam

@@ -19,7 +19,7 @@ depends: [
   "ppx_expect" {with-test & >= "v0.12.0"}
   "cmdliner"
   "menhir"
-  "ocaml-migrate-parsetree" {< "2.0.0"}
+  "ppxlib" {>= "0.15.0"}
   "yojson" # It's optional, but we want users to be able to use source-map without pain.
 ]
 

js_of_ocaml-ppx.opam

@@ -16,7 +16,6 @@ build: [["dune" "build" "-p" name "-j" jobs]]
 depends: [
   "ocaml" {>= "4.02.0"}
   "dune" {>= "2.5"}
-  "ocaml-migrate-parsetree" {>= "1.4" & < "2.0.0" }
-  "ppx_tools_versioned" {>= "5.2.3"}
+  "ppxlib" {>= "0.15.0"}
   "js_of_ocaml" {= version}
 ]

js_of_ocaml-ppx_deriving_json.opam

@@ -17,6 +17,5 @@ depends: [
   "ocaml" {>= "4.04.1"}
   "dune" {>= "2.5"}
   "js_of_ocaml" {= version}
-  "ocaml-migrate-parsetree" {< "2.0.0"}
-  "ppxlib" {>= "0.14.0"}
+  "ppxlib" {>= "0.15.0"}
 ]

js_of_ocaml.opam

@@ -18,8 +18,7 @@ build: [["dune" "build" "-p" name "-j" jobs]]
 depends: [
   "ocaml" {>= "4.02.0"}
   "dune" {>= "2.5"}
-  "ocaml-migrate-parsetree" {>= "1.4" & < "2.0.0" }
-  "ppx_tools_versioned" {>= "5.2.3"}
+  "ppxlib" {>= "0.15.0" }
   "uchar"
   "js_of_ocaml-compiler" {= version}
 ]