]> matita.cs.unibo.it Git - helm.git/blob - components/syntax_extensions/profiling_macros.ml
unified: some theorems on Lift started
[helm.git] / 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