Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /trunk/src/compiler/common/phase-timer.sml
ViewVC logotype

Annotation of /trunk/src/compiler/common/phase-timer.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1115 - (view) (download)

1 : jhr 1115 (* phase-timer.sml
2 :     *
3 :     * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *)
6 :    
7 :     structure PhaseTimer : sig
8 :    
9 :     type timer
10 :    
11 :     val newTimer : string -> timer
12 :    
13 :     val newPhase : timer * string -> timer
14 :    
15 :     val start : timer -> unit
16 :     val stop : timer -> unit
17 :     val withTimer : timer -> ('a -> 'b) -> 'a -> 'b
18 :    
19 :     val report : TextIO.outstream * timer -> unit
20 :    
21 :     end = struct
22 :    
23 :     datatype timer = T of {
24 :     parent : timer option,
25 :     label : string,
26 :     start : Time.time option ref, (* SOME t when on, otherwise NONE *)
27 :     tot : Time.time ref,
28 :     childTot : Time.time ref,
29 :     children : timer list ref
30 :     }
31 :    
32 :     fun newTimer l = T{
33 :     parent = NONE,
34 :     label = l,
35 :     start = ref NONE,
36 :     tot = ref Time.zeroTime,
37 :     childTot = ref Time.zeroTime,
38 :     children = ref []
39 :     }
40 :    
41 :     fun newPhase (timer as T{children, ...}, l) = let
42 :     val newT = T{
43 :     parent = SOME timer,
44 :     label = l,
45 :     start = ref NONE,
46 :     tot = ref Time.zeroTime,
47 :     childTot = ref Time.zeroTime,
48 :     children = ref []
49 :     }
50 :     in
51 :     children := newT :: !children;
52 :     newT
53 :     end
54 :    
55 :     fun start (T{label, start, ...}) = (case !start
56 :     of NONE => start := SOME(Time.now())
57 :     | SOME _ => ()
58 :     (* end case *))
59 :    
60 :     fun stop (T{label, parent, start, tot, ...}) = (case !start
61 :     of SOME t0 => let
62 :     val t = Time.-(Time.now(), t0)
63 :     in
64 :     start := NONE;
65 :     tot := Time.+(!tot, t);
66 :     case parent
67 :     of SOME(T{childTot, ...}) => childTot := Time.+(!childTot, t)
68 :     | _ => ()
69 :     (* end case *)
70 :     end
71 :     | NONE => ()
72 :     (* end case *))
73 :    
74 :     fun withTimer timer f x = let
75 :     val () = start timer
76 :     val y = (f x) handle ex => (stop timer; raise ex)
77 :     in
78 :     stop timer;
79 :     y
80 :     end
81 :    
82 :     fun report (outS, timer) = let
83 :     fun pr s = TextIO.output(outS, s)
84 :     (* create a string by repeating a character n times *)
85 :     fun repeat (c, n) = CharVector.tabulate(n, fn _ => c)
86 :     (* figure out the length of the longest label in the tree and the depth of the tree *)
87 :     val (maxLabelLen, depth) = let
88 :     fun walk (T{label, children, ...}, maxLen, depth) = let
89 :     fun doChild (timer, (maxLen, depth)) = let
90 :     val (l, d) = walk (timer, maxLen, depth)
91 :     in
92 :     (Int.max(maxLen, l), Int.max(depth, d))
93 :     end
94 :     in
95 :     List.foldl doChild (Int.max(size label, maxLen), depth+1) (!children)
96 :     end
97 :     in
98 :     walk (timer, 0, 0)
99 :     end
100 :     val labelWid = maxLabelLen + 2*depth + 4
101 :     (* display a report line *)
102 :     fun display (indent, T{label, tot, childTot, children, ...}) = let
103 :     fun prTime t = pr(StringCvt.padLeft #" " 7 (Time.fmt 3 t))
104 :     in
105 :     pr(repeat (#" ", indent));
106 :     pr(StringCvt.padRight #"." (labelWid+4-indent) (label^" "));
107 :     pr " "; prTime (Time.-(!tot, !childTot));
108 :     pr " "; prTime (!tot); pr "\n";
109 :     List.app (fn t => display(indent+2, t)) (List.rev (!children))
110 :     end
111 :     fun center (s, wid) = let
112 :     val padding = wid - String.size s
113 :     val lPad = padding div 2
114 :     val rPad = padding - lPad
115 :     in
116 :     if padding < 0 then s
117 :     else concat[repeat(#" ", lPad), s, repeat(#" ", rPad)]
118 :     end
119 :     in
120 :     pr (center ("Phase", labelWid + 2));
121 :     pr " "; pr(center ("Exclusive", 9));
122 :     pr " "; pr(center ("Total", 9));
123 :     pr "\n";
124 :     display (2, timer)
125 :     end
126 :    
127 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0