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 let banner _ pname =
   7   name := pname;
   8  "(Array.make "^string_of_int max_profilers^" (0,0.)), "^
   9  "(Array.make "^string_of_int max_profilers^" (0.))"
  10 ;;
  11
  12 let ensure_label_in_table label =
  13   if not (Hashtbl.mem profiler_label2int label) then
  14     begin
  15       if !profiler_no > max_profilers then
  16         raise (Invalid_argument "Too many profilers.");
  17       Hashtbl.add profiler_label2int label !profiler_no;
  18       incr profiler_no;
  19     end
  20 ;;
  21
  22
  23 let start label =
  24   ensure_label_in_table label;
  25   let id = Hashtbl.find profiler_label2int label in
  26   " ((snd "^ !name^").("^string_of_int id^") <- Unix.gettimeofday()) "
  27 ;;
  28
  29 let stop label extra =
  30   ensure_label_in_table label;
  31   let id = Hashtbl.find profiler_label2int label in
  32   "(let __res = " ^ extra ^ "  in ( "^
  33   "let interval = Unix.gettimeofday () -. "^
  34     "(snd "^ !name^").("^string_of_int id^") in "^
  35   "let oldcount,oldval = (fst "^ !name^").("^string_of_int id^") in "^
  36   "(fst "^ !name^").("^string_of_int id^") <- "^
  37     "(oldcount+1,interval +. oldval)); __res )"
  38 ;;
  39
  40 let profile_start_stop _ label =
  41   let label,extra =
  42     match Str.bounded_split (Str.regexp "\n") label 2 with
  43     | [label;extra] -> label,extra
  44     | _ ->
  45         raise (Invalid_argument ("Profiler 'stop' with a bad label:" ^ label))
  46   in
  47   let start = start label in
  48   let stop = stop label extra in
  49   "let _ = " ^ start ^ " in " ^ stop
  50 ;;
  51
  52 let profile_show _ prefix =
  53   (Hashtbl.fold
  54     (fun k v acc ->
  55       acc ^
  56       "let t = (fst "^ !name^").("^string_of_int v^") in "^
  57       "let acc = acc ^ Printf.sprintf \"%-15s %25s: %8d %8.4f\\n\" \"" ^
  58       prefix ^ "\" \"" ^  k ^
  59       "\" (fst t) (snd t) in ")
  60     profiler_label2int "let acc = \"\" in ") ^ " acc "
  61 ;;
  62
  63 let profile_start _ label = start label ;;
  64 let profile_stop _ label =
  65   let label,extra =
  66     match Str.bounded_split (Str.regexp "\n") label 2 with
  67     | [label;extra] -> label,extra
  68     | [label] -> label,"()"
  69     | _ ->
  70         raise (Invalid_argument ("Profiler 'stop' with a bad label:" ^ label))
  71   in
  72   stop label extra
  73 ;;
  74
  75 (*
  76 Quotation.add "profiler" (Quotation.ExStr banner);;
  77 Quotation.add "profile" (Quotation.ExStr profile_start_stop);;
  78 Quotation.add "start" (Quotation.ExStr profile_start);;
  79 Quotation.add "stop" (Quotation.ExStr profile_stop);;
  80 Quotation.add "show" (Quotation.ExStr profile_show);;
  81 *)
  82