helm/software/components/syntax_extensions/profiling_macros.ml

   1 let max_profilers = 20;;
   2 let profiler_no = ref 0;;
   3 let profiler_label2int = Hashtbl.create 3;;
   4 let name = ref "";;
   5
   6
   7 let banner _ pname =
   8   name := pname;
   9  "(Array.make "^string_of_int max_profilers^" (0,0.)),
  10   (Array.make "^string_of_int max_profilers^" (0.))"
  11 ;;
  12
  13 let profile_start _ label =
  14   if !profiler_no > max_profilers then
  15     raise (Invalid_argument "Too many profilers.");
  16   if not (Hashtbl.mem profiler_label2int label) then
  17     begin
  18       Hashtbl.add profiler_label2int label !profiler_no;
  19       incr profiler_no;
  20     end;
  21   let id = Hashtbl.find profiler_label2int label in
  22   " ((snd "^ !name^").("^string_of_int id^") <- Unix.gettimeofday()) "
  23 ;;
  24
  25 let profile_stop _ label =
  26   if not (Hashtbl.mem profiler_label2int label) then
  27     raise (Invalid_argument "Profiler 'stop' before 'begin'.");
  28   let id = Hashtbl.find profiler_label2int label in
  29   " (
  30     let interval =
  31       Unix.gettimeofday () -. (snd "^ !name^").("^string_of_int id^")
  32     in
  33     let oldcount,oldval = (fst "^ !name^").("^string_of_int id^") in
  34     (fst "^ !name^").("^string_of_int id^") <- (oldcount+1,interval +. oldval)
  35    ) "
  36 ;;
  37
  38 let profile_show _ _ =
  39   (Hashtbl.fold
  40     (fun k v acc ->
  41       acc ^
  42       "let t = (fst "^ !name^").("^string_of_int v^") in "^
  43       "let acc = acc ^ Printf.sprintf \"%20s: %5d %8.4f\" \""^k^"\" (fst t) (snd t) in")
  44     profiler_label2int "let acc = \"\" in ") ^ " acc "
  45 ;;
  46
  47 Quotation.add "profiler" (Quotation.ExStr banner);;
  48 Quotation.add "start" (Quotation.ExStr profile_start);;
  49 Quotation.add "stop" (Quotation.ExStr profile_stop);;
  50 Quotation.add "show" (Quotation.ExStr profile_show);;