Merge pull request #7 from anuragsoni/use-ppxlib

use ppxlib

.github/workflows/main.yml

@@ -16,9 +16,8 @@ jobs:
           - ubuntu-latest
           - windows-latest
         ocaml-version:
-          - 4.10.0 
-          - 4.09.0
-          - 4.08.1
+          - 4.12.0
+          - 4.11.2
 
     runs-on: ${{ matrix.os }}
 

dune-project

@@ -14,9 +14,8 @@
  (name ppx_defer)
  (synopsis "Go-like [%defer later]; now syntax")
  (depends
-  (ocaml (>= 4.02.3))
+  (ocaml (>= 4.11.0))
   (dune (>= 2.0))
   (lwt :with-test)
   (lwt_ppx :with-test)
-  (ocaml-migrate-parsetree (>= 1.5.0))
-  ppx_tools_versioned))
+  (ppxlib (>= 0.12.0))))

ppx_defer.opam

@@ -7,12 +7,11 @@ license: "MIT"
 homepage: "https://github.com/hcarty/ppx_defer"
 bug-reports: "https://github.com/hcarty/ppx_defer/issues"
 depends: [
-  "ocaml" {>= "4.02.3"}
+  "ocaml" {>= "4.11.0"}
   "dune" {>= "2.0"}
   "lwt" {with-test}
   "lwt_ppx" {with-test}
-  "ocaml-migrate-parsetree" {>= "1.5.0"}
-  "ppx_tools_versioned"
+  "ppxlib" {>= "0.12.0"}
 ]
 build: [
   ["dune" "subst"] {pinned}

src/dune

@@ -3,7 +3,7 @@
  (public_name ppx_defer)
  (synopsis "Defer evaluation of expressions")
  (modules ppx_defer)
- (libraries compiler-libs.common ocaml-migrate-parsetree)
+ (libraries ppxlib)
  (kind ppx_rewriter)
  (preprocess
-  (pps ppx_tools_versioned.metaquot_410)))
+  (pps ppxlib.metaquot)))

src/ppx_defer.ml

@@ -1,72 +1,71 @@
-open Migrate_parsetree
-open OCaml_410.Ast
-open Ast_mapper
-open Parsetree
+open Ppxlib
 
-(**
-   {[
-     [%defer later];
-     now
-   ]}
+(** {[
+      [%defer later];
+      now
+    ]}
 
-   will evaluate [later] after [now].  For example:
+    will evaluate [later] after [now]. For example:
 
-   {[
-     let ic = open_in_bin "test.ml" in
-     [%defer close_in ic];
-     let length = in_channel_length ic in
-     let bytes = really_input_string ic length in
-     print_endline bytes
-   ]}
+    {[
+      let ic = open_in_bin "test.ml" in
+      [%defer close_in ic];
+      let length = in_channel_length ic in
+      let bytes = really_input_string ic length in
+      print_endline bytes
+    ]}
 
-   will close [ic] after reading and printing its content.
-*)
+    will close [ic] after reading and printing its content. *)
 
 let make_defer ~later ~now =
   (* Evaluate [now] then [later], even if [now] raises an exception *)
+  let loc = now.pexp_loc in
   [%expr
     match [%e now] with
     | __ppx_defer_actual_result ->
-      [%e later]; __ppx_defer_actual_result
+      [%e later];
+      __ppx_defer_actual_result
     | exception __ppx_defer_actual_exception ->
-      [%e later]; raise __ppx_defer_actual_exception
-  ] [@metaloc now.pexp_loc]
+      [%e later];
+      raise __ppx_defer_actual_exception]
 
 let make_defer_lwt ~later ~now =
   (* Evaluate [now] then [later], even if [now] raises an exception *)
-  [%expr
-    Lwt.finalize (fun () -> [%e now]) (fun () -> [%e later])
-  ] [@metaloc now.pexp_loc]
+  let loc = now.pexp_loc in
+  [%expr Lwt.finalize (fun () -> [%e now]) (fun () -> [%e later])]
+
+class mapper =
+  object (_self)
+    inherit Ast_traverse.map as super
 
-let defer_mapper =
-  {
-    default_mapper with
-    expr = (
-      fun mapper expr ->
-        match expr with
-        | [%expr [%defer [%e? later]] ; [%e? now]] ->
-          let later, now = mapper.expr mapper later, mapper.expr mapper now in
-          let generated = make_defer ~later ~now in
-          let pexp_loc =
-            (* [loc_ghost] tells the compiler and other tools than this is
-               generated code *)
-            { generated.pexp_loc with Location.loc_ghost = true }
-          in
-          { generated with pexp_loc }
-        | [%expr [%defer.lwt [%e? later]] ; [%e? now]] ->
-          let later, now = mapper.expr mapper later, mapper.expr mapper now in
-          let generated = make_defer_lwt ~later ~now in
-          let pexp_loc =
-            (* [loc_ghost] tells the compiler and other tools than this is
-               generated code *)
-            { generated.pexp_loc with Location.loc_ghost = true }
-          in
-          { generated with pexp_loc }
-        | _ ->
-          default_mapper.expr mapper expr
-    )
-  }
+    method! expression expr =
+      match expr with
+      | [%expr
+          [%defer [%e? later]];
+          [%e? now]] ->
+        let (later, now) = (super#expression later, super#expression now) in
+        let generated = make_defer ~later ~now in
+        let pexp_loc =
+          (* [loc_ghost] tells the compiler and other tools than this is
+             generated code *)
+          { generated.pexp_loc with Location.loc_ghost = true }
+        in
+        { generated with pexp_loc }
+      | [%expr
+          [%defer.lwt [%e? later]];
+          [%e? now]] ->
+        let (later, now) = (super#expression later, super#expression now) in
+        let generated = make_defer_lwt ~later ~now in
+        let pexp_loc =
+          (* [loc_ghost] tells the compiler and other tools than this is
+             generated code *)
+          { generated.pexp_loc with Location.loc_ghost = true }
+        in
+        { generated with pexp_loc }
+      | _ -> super#expression expr
+  end
 
 let () =
-  Driver.register ~name:"ppx_defer" Versions.ocaml_410
-    (fun _config _cookies -> defer_mapper)
+  let mapper = new mapper in
+  Driver.register_transformation "ppx_defer" ~impl:mapper#structure
+    ~intf:mapper#signature