From af7fb20c2a6325ff0d39e73b37e640d6ac15bab1 Mon Sep 17 00:00:00 2001 From: Anurag Soni Date: Fri, 23 Apr 2021 14:32:11 -0400 Subject: [PATCH 1/2] use ppxlib --- src/dune | 4 +- src/ppx_defer.ml | 109 +++++++++++++++++++++++------------------------ 2 files changed, 56 insertions(+), 57 deletions(-) diff --git a/src/dune b/src/dune index dc9edee..8f6adad 100644 --- a/src/dune +++ b/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))) diff --git a/src/ppx_defer.ml b/src/ppx_defer.ml index 1a7f410..7b11f56 100644 --- a/src/ppx_defer.ml +++ b/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 From ed3c22e3de75cdf5a30456fe3a7864c36d1dc81b Mon Sep 17 00:00:00 2001 From: Anurag Soni Date: Fri, 23 Apr 2021 21:18:07 -0400 Subject: [PATCH 2/2] update opam metadata and github workflow --- .github/workflows/main.yml | 5 ++--- dune-project | 5 ++--- ppx_defer.opam | 5 ++--- 3 files changed, 6 insertions(+), 9 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index af79b22..b34aa0a 100644 --- a/.github/workflows/main.yml +++ b/.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 }} diff --git a/dune-project b/dune-project index a101cb3..5244142 100644 --- a/dune-project +++ b/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)))) diff --git a/ppx_defer.opam b/ppx_defer.opam index 4d212a7..1b9892e 100644 --- a/ppx_defer.opam +++ b/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}