ppx_defer example

Makefile

all:
	ocamlbuild -use-ocamlfind -package ppx_tools,ppx_tools.metaquot ppx_defer.native
	ocamlfind ppx_tools/rewriter ./ppx_defer.native test.ml
	ocamlfind c -ppx ./ppx_defer.native test2.ml

ppx_defer.ml

open Ast_mapper
open Parsetree

(**
   {[
     [%defer later];
     now
   ]}

   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
   ]}

   will close [ic] after reading and printing its content.
*)

let make_defer ~later ~now =
  [%expr
    match [%e now] with
    | __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]

let defer_mapper _args =
  {
    default_mapper with
    expr = (
      fun mapper expr ->
(*
        Ast_helper.with_default_loc expr.pexp_loc (
          fun () ->
*)
            match expr with
            | [%expr [%defer [%e? later]] ; [%e? now]] ->
              let generated = make_defer ~later ~now in
              { generated with pexp_loc = { generated.pexp_loc with Location.loc_ghost = true } } 
            | _ ->
              default_mapper.expr mapper expr
(*         ) *)
    )
  }

let () = register "defer" defer_mapper

test.ml

let () =
  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

test2.ml

(* Made to fail *)
let x : string =
  [%defer ()] ;
  3