Improve the profiler by providing a separate tool to analyse results

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

3 files changed, 55 insertions, 36 deletions

diff --git a/camlp4/Camlp4Filters/Profiler.ml b/camlp4/Camlp4Filters/Profiler.ml
index 218b284a7..d4c881889 100644
--- a/camlp4/Camlp4Filters/Profiler.ml
+++ b/camlp4/Camlp4Filters/Profiler.ml
@@ -52,29 +52,26 @@ module Make (AstFilters : Camlp4.Sig.AstFilters.S) = struct
       | e -> super#expr e ];
   end;
 
-  value rec decorate_fun id =
+  value decorate_this_expr e id =
     let buf = Buffer.create 42 in
-    let decorate_expr = (decorate decorate_fun)#expr in
+    let _loc = Ast.loc_of_expr e in
+    let () = Format.bprintf buf "%s @@ %a@?" id Loc.dump _loc in
+    let s = Buffer.contents buf in
+    <:expr< let () = Camlp4Profiler.count $`str:s$ in $e$ >>;
+
+  value rec decorate_fun id =
+    let decorate = decorate decorate_fun in
+    let decorate_expr = decorate#expr in
+    let decorate_match_case = decorate#match_case in
     fun
     [ <:expr@_loc< fun $p$ -> $e$ >> ->
         <:expr< fun $p$ -> $decorate_fun id e$ >>
-    | e ->
-        let _loc = Ast.loc_of_expr e in
-        let () = Format.bprintf buf "%s @@ %a@?" id Loc.dump _loc in
-        let s = Buffer.contents buf in
-        <:expr< let () = Camlp4Filters.Profiler.count $`str:s$
-                in $decorate_expr e$ >> ];
+    | <:expr@_loc< fun [ $m$ ] >> ->
+        decorate_this_expr <:expr< fun [ $decorate_match_case m$ ] >> id
+    | e -> decorate_this_expr (decorate_expr e) id ];
 
   register_str_item_filter (decorate decorate_fun)#str_item;
 
 end;
 
-value count =
-  let h = Hashtbl.create 1007 in
-  let () = at_exit (fun () ->
-    Hashtbl.iter (fun k v -> Format.eprintf "%s: %d@." k v.val) h) in
-  fun s ->
-    try incr (Hashtbl.find h s)
-    with [ Not_found -> Hashtbl.add h s (ref 1) ];
-
 let module M = Camlp4.Register.AstFilter Id Make in ();
diff --git a/camlp4/Makefile.ml b/camlp4/Makefile.ml
index c180de4f3..52d075b12 100644
--- a/camlp4/Makefile.ml
+++ b/camlp4/Makefile.ml
@@ -44,12 +44,14 @@ let camlp4_modules =
   if debug_mode then "env STATIC_CAMLP4_DEBUG=\\*" :: camlp4_modules
   else camlp4_modules
 
+let debug_opt x = if debug_mode && Sys.file_exists x then [x] else []
+let filter_opt x = if Sys.file_exists x then [x] else []
+
 let camlp4boot = "'" ^ String.concat " " camlp4_modules ^ "'"
 let camlp4boot_may_debug mods =
-  let tracer = "./boot/ExceptionTracer.cmo" in
-  let tracer_opt =
-    if debug_mode && Sys.file_exists tracer then [tracer] else [] in
-  let camlp4_modules = camlp4_modules @ tracer_opt @ mods
+  let camlp4_modules = camlp4_modules @
+    debug_opt "./boot/ExceptionTracer.cmo" @
+    filter_opt "./boot/Profiler.cmo" @ mods
   in "'" ^ String.concat " " camlp4_modules ^ "'"
 
 let () =
@@ -67,7 +69,7 @@ let () =
 let options_without_camlp4 = new_scope (lazy !options)
 
 let () =
-  !options.ocaml_Flags  ^= "-w Ale -warn-error Ale";
+  !options.ocaml_Flags ^= "-w Ale -warn-error Ale";
   !options.ocaml_P4     := camlp4boot_may_debug [];
   !options.ocaml_P4_opt := camlp4boot_may_debug ["-D OPT"];
   ()
@@ -80,6 +82,7 @@ and typing = "../typing"
 and toplevel = "../toplevel"
 and utils = "../utils"
 and dynlink = "../otherlibs/dynlink"
+and unix = "../otherlibs/unix"
 and build = "build"
 
 let ocaml_Module_with_meta =
@@ -209,6 +212,7 @@ let camlp4_printers =
     ocaml_Module "OCaml";
     ocaml_Module "OCamlr";
     ocaml_Module "Null";
+    ocaml_Module ~includes:[unix] "Auto";
   ])
 
 let camlp4_filters =
@@ -218,6 +222,7 @@ let camlp4_filters =
     ocaml_Module "StripLocations";
     ocaml_Module "LiftCamlp4Ast";
     ocaml_Module "GenerateMap";
+    ocaml_Module "Profiler";
   ])
 
 let camlp4_top =
@@ -243,6 +248,7 @@ let pa_debug = ocaml_Module "Camlp4Parsers/Debug"
 let pr_dump = ocaml_Module "Camlp4Printers/DumpOCamlAst"
 let pr_r = ocaml_Module "Camlp4Printers/OCamlr"
 let pr_o = ocaml_Module "Camlp4Printers/OCaml"
+let pr_a = ocaml_Module "Camlp4Printers/Auto"
 let fi_exc = ocaml_Module "Camlp4Filters/ExceptionTracer"
 let fi_tracer = ocaml_Module "Camlp4Filters/Tracer"
 let camlp4_bin = ocaml_Module "Camlp4Bin"
@@ -254,16 +260,23 @@ let opt_programs = ref []
 let byte_libraries = ref []
 let opt_libraries = ref []
 
+let special_modules =
+  if Sys.file_exists "./boot/Profiler.cmo" then
+    [ocaml_IModule "Camlp4Profiler"]
+  else []
+
+
 let mk_camlp4_top_lib name modules =
   byte_libraries += (name ^ ".cma");
   opt_libraries  @= [name ^ ".cmxa"; name ^ ".a"];
-  ocaml_Library ~default:`Byte ~libraries:["Camlp4"] ~flags:"-linkall" name (modules @ [top_camlp4_top])
+  ocaml_Library ~default:`Byte ~libraries:["Camlp4"] ~flags:"-linkall" name
+  (special_modules @ modules @ [top_camlp4_top])
 
 let mk_camlp4 name modules =
   byte_programs += (name ^ ".run");
   opt_programs  += (name ^ ".opt");
-  ocaml_Program ~default:`Byte ~libraries:["Camlp4"] ~flags:"-linkall" name
-  (modules @ [camlp4_bin])
+  ocaml_Program ~default:`Byte ~includes:[unix] ~libraries:["unix"; "Camlp4"] ~flags:"-linkall" name
+  (special_modules @ modules @ [camlp4_bin])
 
 let mk_camlp4_tool name modules =
   byte_programs += (name ^ ".run");
@@ -383,21 +396,21 @@ let other_byte_objs = String.concat " " (List.map (fun x -> x ^ ".cmo") other_ob
 let other_opt_objs = String.concat " " (List.map (fun x -> x ^ ".cmx") other_objs)
 let all =
  [ocaml_Library ~default:`Byte
-                ~includes:["../otherlibs/dynlink"]
+                ~includes:[dynlink]
                 ~byte_flags:("dynlink.cma"^^other_byte_objs) ~opt_flags:other_opt_objs
-                ~flags:"-linkall" "Camlp4" (misc_modules @ [camlp4_package]);
-  (* ocaml_Library ~default:`Byte ~flags:"-linkall" "Camlp4Parsers" []; *)
+                ~flags:"-linkall" "Camlp4" (misc_modules @ special_modules @ [camlp4_package]);
   mk_camlp4 "camlp4" [];
-  mk_camlp4 "camlp4boot" [pa_r; pa_qb; pa_q; pa_rp; pa_g; pa_macro; pa_debug; pr_o; pr_dump];
-  mk_camlp4 "camlp4r"  [pa_r; pa_rp; pr_dump];
-  mk_camlp4 "camlp4rf" [pa_r; pa_qb; pa_q; pa_rp; pa_g; pa_macro; pr_dump];
-  mk_camlp4 "camlp4o"  [pa_r; pa_o; pa_rp; pa_op; pr_dump];
-  mk_camlp4 "camlp4of" [pa_r; pa_qb; pa_rq; pa_o; pa_rp; pa_op; pa_g; pa_macro; pr_dump];
+  mk_camlp4 "camlp4boot" [pa_r; pa_qb; pa_q; pa_rp; pa_g; pa_macro; pa_debug; pr_o; pr_a];
+  mk_camlp4 "camlp4r"  [pa_r; pa_rp; pr_a];
+  mk_camlp4 "camlp4rf" [pa_r; pa_qb; pa_q; pa_rp; pa_g; pa_macro; pr_a];
+  mk_camlp4 "camlp4o"  [pa_r; pa_o; pa_rp; pa_op; pr_a];
+  mk_camlp4 "camlp4of" [pa_r; pa_qb; pa_rq; pa_o; pa_rp; pa_op; pa_g; pa_macro; pr_a];
   mk_camlp4_tool "mkcamlp4" [ocaml_Module ~o:(options_without_debug ()) "mkcamlp4"];
-  mk_camlp4_top_lib "camlp4r"  [pa_r; pa_rp; (* pr_r; *) top_rprint];
-  mk_camlp4_top_lib "camlp4rf" [pa_r; pa_rp; pa_qb; pa_q; pa_g; pa_macro; (* pr_r; *) top_rprint];
-  mk_camlp4_top_lib "camlp4o"  [pa_r; pa_o; pa_rp; pa_op; (* pr_o; *)];
-  mk_camlp4_top_lib "camlp4of" [pa_r; pa_qb; pa_rq; pa_o; pa_rp; pa_op; pa_g; pa_macro; (* pr_o; *)];
+  mk_camlp4_tool "camlp4prof" [ocaml_Module ~o:(options_without_debug ()) "camlp4prof"];
+  mk_camlp4_top_lib "camlp4r"  [pa_r; pa_rp; top_rprint];
+  mk_camlp4_top_lib "camlp4rf" [pa_r; pa_rp; pa_qb; pa_q; pa_g; pa_macro; top_rprint];
+  mk_camlp4_top_lib "camlp4o"  [pa_r; pa_o; pa_rp; pa_op];
+  mk_camlp4_top_lib "camlp4of" [pa_r; pa_qb; pa_rq; pa_o; pa_rp; pa_op; pa_g; pa_macro];
  ] @ extensions
 
 
diff --git a/camlp4/camlp4prof.ml b/camlp4/camlp4prof.ml
new file mode 100644
index 000000000..26123873a
--- /dev/null
+++ b/camlp4/camlp4prof.ml
@@ -0,0 +1,9 @@
+open Camlp4Profiler;
+
+value profile = load stdin;
+
+value profile = List.sort (fun (_, v1) (_, v2) -> compare v1 v2) profile;
+
+List.iter
+  (fun (k, v) -> Format.printf "%-75s: %d@." k v)
+  profile;