use ppxlib

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