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 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 =
  34       Unix.gettimeofday () -. (snd "^ !name^").("^string_of_int id^")
  35     in
  36     let oldcount,oldval = (fst "^ !name^").("^string_of_int id^") in
  37     (fst "^ !name^").("^string_of_int id^") <- (oldcount+1,interval +. oldval)
  38         ); __res )"
  39 ;;
  40
  41 let profile_start_stop _ label =
  42   let label,extra =
  43     match Str.bounded_split (Str.regexp "\n") label 2 with
  44     | [label;extra] -> label,extra
  45     | _ ->
  46         raise (Invalid_argument ("Profiler 'stop' with a bad label:" ^ label))
  47   in
  48   let start = start label in
  49   let stop = stop label extra in
  50   "let _ = " ^ start ^ " in " ^ stop
  51 ;;
  52
  53 let profile_show _ prefix =
  54   (Hashtbl.fold
  55     (fun k v acc ->
  56       acc ^
  57       "let t = (fst "^ !name^").("^string_of_int v^") in "^
  58       "let acc = acc ^ Printf.sprintf \"%-15s %25s: %8d %8.4f\\n\" \"" ^
  59       prefix ^ "\" \"" ^  k ^
  60       "\" (fst t) (snd t) in ")
  61     profiler_label2int "let acc = \"\" in ") ^ " acc "
  62 ;;
  63
  64 let profile_start _ label = start label ;;
  65 let profile_stop _ label =
  66   let label,extra =
  67     match Str.bounded_split (Str.regexp "\n") label 2 with
  68     | [label;extra] -> label,extra
  69     | [label] -> label,"()"
  70     | _ ->
  71         raise (Invalid_argument ("Profiler 'stop' with a bad label:" ^ label))
  72   in
  73   stop label extra
  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);;