From 91b2f18ef8731c31501de0d27f60288706b969e3 Mon Sep 17 00:00:00 2001
From: Alain Frisch <alain@frisch.fr>
Date: Sep 26 2013 08:03:49 +0000
Subject: Cleanup ppx API.


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14180 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

---

diff --git a/experimental/frisch/ifdef.ml b/experimental/frisch/ifdef.ml
index c784a1e..6263b59 100644
--- a/experimental/frisch/ifdef.ml
+++ b/experimental/frisch/ifdef.ml
@@ -45,7 +45,7 @@ let getenv loc arg =
 
 let empty_str_item = Str.include_ (Mod.structure [])
 
-let ifdef =
+let ifdef _args =
   let stack = ref [] in
   let eval_attributes =
     List.for_all
@@ -115,4 +115,4 @@ let ifdef =
       );
   }
 
-let () = Ast_mapper.main ifdef
+let () = Ast_mapper.run_main ifdef
diff --git a/experimental/frisch/test_ifdef.ml b/experimental/frisch/test_ifdef.ml
index 4b7eafb..8a18cda 100644
--- a/experimental/frisch/test_ifdef.ml
+++ b/experimental/frisch/test_ifdef.ml
@@ -22,3 +22,4 @@ let () =
   Printf.printf "compiled by user %s in directory %s\n%!"
     [%GETENV USER]
     [%GETENV PWD]
+
diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml
index 8e242d0..5fa8e5b 100644
--- a/parsing/ast_mapper.ml
+++ b/parsing/ast_mapper.ml
@@ -544,20 +544,19 @@ let apply ~source ~target mapper =
   really_input ic magic 0 (String.length magic);
   if magic <> Config.ast_impl_magic_number
   && magic <> Config.ast_intf_magic_number then
-    failwith "Bad magic";
-  let input_name = input_value ic in
+    failwith "Ast_mapper: unknown magic number";
+  Location.input_name := input_value ic;
   let ast = input_value ic in
   close_in ic;
 
-  let (input_name, ast) =
+  let ast =
     if magic = Config.ast_impl_magic_number
-    then Obj.magic (mapper.implementation mapper (input_name, Obj.magic ast))
-    else Obj.magic (mapper.interface mapper (input_name, Obj.magic ast))
+    then Obj.magic (mapper.structure mapper (Obj.magic ast))
+    else Obj.magic (mapper.signature mapper (Obj.magic ast))
   in
-  Printf.printf "target = %s\n%!" target;
   let oc = open_out_bin target in
   output_string oc magic;
-  output_value oc input_name;
+  output_value oc !Location.input_name;
   output_value oc ast;
   close_out oc
 
@@ -571,13 +570,13 @@ let run_main mapper =
     else begin
       Printf.eprintf "Usage: %s [extra_args] <infile> <outfile>\n%!"
                      Sys.executable_name;
-      exit 1
+      exit 2
     end
   with exn ->
-    prerr_endline (Printexc.to_string exn);
+    begin try Location.report_exception Format.err_formatter exn
+    with exn -> prerr_endline (Printexc.to_string exn)
+    end;
     exit 2
 
-let main mapper = run_main (fun _ -> mapper)
-
 let register_function = ref (fun _name f -> run_main f)
-let register name f = !register_function name (f :> string list -> mapper)
+let register name f = !register_function name f
diff --git a/parsing/ast_mapper.mli b/parsing/ast_mapper.mli
index bf23a7a..651717e 100644
--- a/parsing/ast_mapper.mli
+++ b/parsing/ast_mapper.mli
@@ -62,15 +62,17 @@ val default_mapper: mapper
 
 
 val apply: source:string -> target:string -> mapper -> unit
-    (** Apply a mapper to a dumped parsetree found in the [source] file
-        and put the result in the [target] file. *)
-
-val main: mapper -> unit
-    (** Entry point to call to implement a standalone -ppx rewriter
-        from a mapper object. *)
+(** Apply a mapper (parametrized by the unit name) to a dumped
+    parsetree found in the [source] file and put the result in the
+    [target] file. The [structure] or [signature] field of the mapper
+    is applied to the implementation or interface.  *)
 
 val run_main: (string list -> mapper) -> unit
-    (** Same as [main], but with extra arguments from the command line. *)
+(** Entry point to call to implement a standalone -ppx rewriter from a
+    mapper, parametrized by the command line arguments.  The current
+    unit name can be obtained from [Location.input_name].  This
+    function implements proper error reporting for uncaught
+    exceptions. *)
 
 (** {2 Registration API} *)
 
@@ -78,19 +80,22 @@ val register_function: (string -> (string list -> mapper) -> unit) ref
 
 val register: string -> (string list -> mapper) -> unit
 
-    (** Apply the [register_function].  The default behavior is to run
-        the mapper immediately, taking arguments from the process
-        command line.  This is to support a scenario where a mapper is
-        linked as a stand-alone executable.
-
-        It is possible to overwrite the [register_function] to define
-        "-ppx drivers", which combine several mappers in a single
-        process.  Typically, a driver starts by defining
-        [register_function] to a custom implementation, then lets ppx
-        rewriters (linked statically or dynamically) register
-        themselves, and then run all or some of them.  It is also
-        possible to have -ppx drivers apply rewriters to only specific
-        parts of an AST.  *)
+(** Apply the [register_function].  The default behavior is to run the
+    mapper immediately, taking arguments from the process command
+    line.  This is to support a scenario where a mapper is linked as a
+    stand-alone executable.
+
+    It is possible to overwrite the [register_function] to define
+    "-ppx drivers", which combine several mappers in a single process.
+    Typically, a driver starts by defining [register_function] to a
+    custom implementation, then lets ppx rewriters (linked statically
+    or dynamically) register themselves, and then run all or some of
+    them.  It is also possible to have -ppx drivers apply rewriters to
+    only specific parts of an AST.
+
+    The first argument to [register] is a symbolic name to be used by
+    the ppx driver.  *)
+
 
 (** {2 Convenience functions to write mappers} *)