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 3349 - (view) (download)

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

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