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

SCM Repository

[diderot] Annotation of /trunk/src/compiler/IL/ssa-fn.sml
ViewVC logotype

Annotation of /trunk/src/compiler/IL/ssa-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 367 - (view) (download)

1 : jhr 137 (* ssa-fn.sml
2 : jhr 124 *
3 :     * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
4 :     * All rights reserved.
5 : jhr 137 *
6 :     * The IL is a combination of a block-structured tree and an SSA control-flow
7 :     * graph of blocks.
8 : jhr 124 *)
9 :    
10 : jhr 198 signature SSA =
11 :     sig
12 :    
13 :     structure Op : OPERATORS
14 :    
15 : jhr 256 (***** CFG *****)
16 : jhr 198
17 : jhr 256 datatype node = ND of {
18 :     id : Stamp.stamp,
19 :     props : PropList.holder,
20 :     kind : node_kind
21 : jhr 198 }
22 :    
23 : jhr 256 and node_kind
24 :     = NULL
25 :     | ENTRY of {
26 :     succ : node ref
27 :     }
28 :     | JOIN of {
29 :     preds : node list ref,
30 :     phis : (var * var list) list ref, (* phi statements *)
31 :     succ : node ref
32 :     }
33 :     | COND of {
34 :     pred : node ref,
35 :     cond : var,
36 :     trueBranch : node ref,
37 :     falseBranch : node ref
38 :     }
39 :     | BLOCK of {
40 :     pred : node ref,
41 :     body : assign list ref,
42 :     succ : node ref
43 :     }
44 :     | NEW of {
45 :     pred : node ref,
46 :     actor : Atom.atom,
47 :     args : var list,
48 :     succ : node ref
49 :     }
50 :     | DIE of {
51 :     pred : node ref
52 :     }
53 :     | STABILIZE of {
54 :     pred : node ref
55 :     }
56 :     | EXIT of {
57 :     pred : node ref
58 :     }
59 : jhr 198
60 : jhr 256 (***** Statements *****)
61 :    
62 : jhr 198 and stmt = STM of {
63 :     id : Stamp.stamp,
64 :     props : PropList.holder,
65 : jhr 256 kind : stmt_kind,
66 :     next : stmt option (* next statement at this structural level *)
67 : jhr 198 }
68 :    
69 :     and stmt_kind
70 : jhr 256 = S_SIMPLE of node (* ENTRY, JOIN, BLOCK, NEW, DIE, STABILIZE, or EXIT node *)
71 :     | S_IF of {
72 :     cond : node, (* COND node *)
73 : jhr 198 thenBranch : stmt,
74 :     elseBranch : stmt
75 :     }
76 : jhr 256 | S_LOOP of {
77 : jhr 198 hdr : stmt,
78 : jhr 256 cond : node, (* COND node *)
79 :     body : stmt
80 : jhr 198 }
81 :    
82 :     and rhs
83 :     = VAR of var
84 :     | LIT of Literal.literal
85 :     | OP of Op.rator * var list
86 :     | CONS of var list (* tensor-value construction *)
87 :    
88 :     and var = V of {
89 :     name : string, (* name *)
90 :     id : Stamp.stamp, (* unique ID *)
91 : jhr 367 bind : var_bind ref, (* binding *)
92 : jhr 198 useCnt : int ref, (* count of uses *)
93 :     props : PropList.holder
94 :     }
95 :    
96 : jhr 367 and var_bind
97 :     = VB_NONE
98 :     | VB_RHS of rhs
99 :     | VB_STATE_VAR
100 :    
101 : jhr 198 withtype assign = (var * rhs)
102 :    
103 : jhr 256 datatype program = Program of {
104 :     globals : var list,
105 :     globalInit : stmt,
106 :     actors : actor list
107 :     (* initialization *)
108 :     }
109 : jhr 198
110 : jhr 256 and actor = Actor of {
111 :     name : Atom.atom,
112 :     params : var list,
113 :     state : var list,
114 :     stateInit : stmt,
115 :     methods : method list
116 :     }
117 : jhr 198
118 : jhr 256 and method = Method of {
119 :     name : Atom.atom,
120 :     stateIn : var list, (* names of state variables on method entry *)
121 :     stateOut : var list, (* names of state variables on method exit *)
122 :     body : stmt (* method body *)
123 :     }
124 : jhr 198
125 : jhr 256 structure Node : sig
126 :     val same : node * node -> bool
127 :     val compare : node * node -> order
128 :     val hash : node -> word
129 :     val toString : node -> string
130 : jhr 360 (* dummy node *)
131 :     val dummy : node
132 : jhr 359 (* CFG edges *)
133 : jhr 256 val preds : node -> node list
134 :     val setPred : node * node -> unit
135 :     val hasSucc : node -> bool
136 :     val succs : node -> node list
137 :     val setSucc : node * node -> unit
138 :     val setTrueBranch : node * node -> unit (* set trueBranch successor for COND node *)
139 :     val setFalseBranch : node * node -> unit (* set falseBranch successor for COND node *)
140 :     val addEdge : node * node -> unit
141 : jhr 359 (* constructors *)
142 :     val mkENTRY : unit -> node
143 :     val mkJOIN : (var * var list) list -> node
144 :     val mkCOND : {cond : var, trueBranch : node, falseBranch : node} -> node
145 :     val mkBLOCK : assign list -> node
146 : jhr 360 val mkNEW : {actor : Atom.atom, args : var list} -> node
147 : jhr 359 val mkDIE : unit -> node
148 :     val mkSTABILIZE : unit -> node
149 :     val mkEXIT : unit -> node
150 : jhr 283 (* properties *)
151 :     val newProp : (node -> 'a) -> {
152 :     getFn : node -> 'a,
153 :     peekFn : node -> 'a option,
154 :     setFn : node * 'a -> unit,
155 :     clrFn : node -> unit
156 :     }
157 :     val newFlag : unit -> {
158 :     getFn : node -> bool,
159 :     setFn : node * bool -> unit
160 :     }
161 : jhr 256 end
162 : jhr 198
163 : jhr 256 structure Stmt : sig
164 :     val same : stmt * stmt -> bool
165 :     val compare : stmt * stmt -> order
166 :     val hash : stmt -> word
167 :     val toString : stmt -> string
168 :     (* return the entry node of the statement *)
169 :     val entry : stmt -> node
170 :     (* return the tail-end node of a statement (not applicable to S_IF or S_LOOP) *)
171 :     val tail : stmt -> node
172 :     (* statement constructor functions *)
173 : jhr 361 val new : (stmt_kind * stmt option) -> stmt
174 : jhr 256 val mkENTRY : stmt option -> stmt
175 :     val mkJOIN : (var * var list) list * stmt option -> stmt
176 :     val mkIF : var * stmt * stmt * stmt option -> stmt
177 :     val mkBLOCK : assign list * stmt option -> stmt
178 :     val mkNEW : Atom.atom * var list * stmt option -> stmt
179 :     val mkDIE : unit -> stmt
180 :     val mkSTABILIZE : unit -> stmt
181 :     val mkEXIT : unit -> stmt
182 : jhr 283 (* properties *)
183 :     val newProp : (stmt -> 'a) -> {
184 :     getFn : stmt -> 'a,
185 :     peekFn : stmt -> 'a option,
186 :     setFn : stmt * 'a -> unit,
187 :     clrFn : stmt -> unit
188 :     }
189 :     val newFlag : unit -> {
190 :     getFn : stmt -> bool,
191 :     setFn : stmt * bool -> unit
192 :     }
193 : jhr 256 end
194 : jhr 198
195 : jhr 199 structure Var : sig
196 :     val new : string -> var
197 : jhr 364 val name : var -> string
198 : jhr 367 val binding : var -> var_bind
199 :     val setBinding : var * var_bind -> unit
200 : jhr 199 val same : var * var -> bool
201 :     val compare : var * var -> order
202 :     val hash : var -> word
203 :     val toString : var -> string
204 : jhr 283 (* properties *)
205 :     val newProp : (var -> 'a) -> {
206 :     getFn : var -> 'a,
207 :     peekFn : var -> 'a option,
208 :     setFn : var * 'a -> unit,
209 :     clrFn : var -> unit
210 :     }
211 :     val newFlag : unit -> {
212 :     getFn : var -> bool,
213 :     setFn : var * bool -> unit
214 :     }
215 :     (* collections *)
216 : jhr 199 structure Map : ORD_MAP where type Key.ord_key = var
217 :     structure Set : ORD_SET where type Key.ord_key = var
218 :     structure Tbl : MONO_HASH_TABLE where type Key.hash_key = var
219 :     end
220 : jhr 198
221 : jhr 319 (* DFS sorting of the graph rooted at the entry to a statement; the resulting list will
222 :     * be in preorder with parents before children.
223 :     *)
224 : jhr 257 val sortNodes : stmt -> node list
225 :    
226 : jhr 341 (* apply a function to all of the nodes in the graph rooted at the entry to the statement *)
227 :     val applyToNodes : (node -> unit) -> stmt -> unit
228 :    
229 : jhr 198 end
230 :    
231 :     functor SSAFn (Op : OPERATORS) : SSA =
232 : jhr 192 struct
233 : jhr 137
234 : jhr 192 structure Op = Op
235 : jhr 137
236 : jhr 256 datatype node = ND of {
237 :     id : Stamp.stamp,
238 :     props : PropList.holder,
239 :     kind : node_kind
240 : jhr 197 }
241 :    
242 : jhr 256 and node_kind
243 :     = NULL
244 :     | ENTRY of {
245 :     succ : node ref
246 :     }
247 :     | JOIN of {
248 :     preds : node list ref,
249 :     phis : (var * var list) list ref, (* phi statements *)
250 :     succ : node ref
251 :     }
252 :     | COND of {
253 :     pred : node ref,
254 :     cond : var,
255 :     trueBranch : node ref,
256 :     falseBranch : node ref
257 :     }
258 :     | BLOCK of {
259 :     pred : node ref,
260 :     body : assign list ref,
261 :     succ : node ref
262 :     }
263 :     | NEW of {
264 :     pred : node ref,
265 :     actor : Atom.atom,
266 :     args : var list,
267 :     succ : node ref
268 :     }
269 :     | DIE of {
270 :     pred : node ref
271 :     }
272 :     | STABILIZE of {
273 :     pred : node ref
274 :     }
275 :     | EXIT of {
276 :     pred : node ref
277 :     }
278 : jhr 197
279 : jhr 256 (***** Statements *****)
280 : jhr 197
281 :     and stmt = STM of {
282 : jhr 188 id : Stamp.stamp,
283 :     props : PropList.holder,
284 : jhr 256 kind : stmt_kind,
285 :     next : stmt option (* next statement at this structural level *)
286 : jhr 188 }
287 :    
288 : jhr 192 and stmt_kind
289 : jhr 256 = S_SIMPLE of node (* ENTRY, JOIN, BLOCK, NEW, DIE, STABILIZE, or EXIT node *)
290 :     | S_IF of {
291 :     cond : node, (* COND node *)
292 : jhr 192 thenBranch : stmt,
293 :     elseBranch : stmt
294 :     }
295 : jhr 256 | S_LOOP of {
296 : jhr 192 hdr : stmt,
297 : jhr 256 cond : node, (* COND node *)
298 :     body : stmt
299 : jhr 192 }
300 :    
301 : jhr 188 and rhs
302 :     = VAR of var
303 :     | LIT of Literal.literal
304 :     | OP of Op.rator * var list
305 :     | CONS of var list (* tensor-value construction *)
306 :    
307 : jhr 192 and var = V of {
308 : jhr 137 name : string, (* name *)
309 : jhr 367 bind : var_bind ref, (* binding *)
310 : jhr 137 id : Stamp.stamp, (* unique ID *)
311 :     useCnt : int ref, (* count of uses *)
312 :     props : PropList.holder
313 : jhr 124 }
314 :    
315 : jhr 367 and var_bind
316 :     = VB_NONE
317 :     | VB_RHS of rhs
318 :     | VB_STATE_VAR
319 :    
320 : jhr 192 withtype assign = (var * rhs)
321 : jhr 188
322 : jhr 256 datatype program = Program of {
323 :     globals : var list,
324 :     globalInit : stmt,
325 :     actors : actor list
326 :     (* initialization *)
327 :     }
328 : jhr 188
329 : jhr 256 and actor = Actor of {
330 :     name : Atom.atom,
331 :     params : var list,
332 :     state : var list,
333 :     stateInit : stmt,
334 :     methods : method list
335 :     }
336 : jhr 188
337 : jhr 256 and method = Method of {
338 :     name : Atom.atom,
339 :     stateIn : var list, (* names of state variables on method entry *)
340 :     stateOut : var list, (* names of state variables on method exit *)
341 :     body : stmt (* method body *)
342 :     }
343 : jhr 188
344 : jhr 256 structure Node =
345 :     struct
346 :     fun same (ND{id=a, ...}, ND{id=b, ...}) = Stamp.same(a, b)
347 :     fun compare (ND{id=a, ...}, ND{id=b, ...}) = Stamp.compare(a, b)
348 :     fun hash (ND{id, ...}) = Stamp.hash id
349 :     fun toString (ND{id, kind, ...}) = let
350 :     val tag = (case kind
351 :     of NULL => "NULL"
352 :     | ENTRY _ => "ENTRY"
353 :     | JOIN _ => "JOIN"
354 :     | COND _ => "COND"
355 :     | BLOCK _ => "BLOCK"
356 :     | NEW _ => "NEW"
357 :     | DIE _ => "DIE"
358 :     | STABILIZE _ => "STABILIZE"
359 :     | EXIT _ => "EXIT"
360 :     (* end case *))
361 :     in
362 :     tag ^ Stamp.toString id
363 :     end
364 :     fun new kind = ND{id = Stamp.new(), props = PropList.newHolder(), kind = kind}
365 :     val dummy = new NULL
366 :     fun mkENTRY () = new (ENTRY{succ = ref dummy})
367 :     fun mkJOIN phis = new (JOIN{preds = ref [], phis = ref phis, succ = ref dummy})
368 :     fun mkCOND {cond, trueBranch, falseBranch} = new (COND{
369 :     pred = ref dummy, cond = cond,
370 :     trueBranch = ref trueBranch, falseBranch = ref falseBranch
371 :     })
372 :     fun mkBLOCK body = new (BLOCK{pred = ref dummy, body = ref body, succ = ref dummy})
373 :     fun mkNEW {actor, args} = new (NEW{
374 :     pred = ref dummy, actor = actor, args = args, succ = ref dummy
375 :     })
376 :     fun mkDIE () = new (DIE{pred = ref dummy})
377 :     fun mkSTABILIZE () = new (STABILIZE{pred = ref dummy})
378 :     fun mkEXIT () = new (EXIT{pred = ref dummy})
379 :     (* editing node edges *)
380 :     fun setPred (ND{kind, ...}, nd) = (case kind
381 :     of NULL => raise Fail "setPred on NULL node"
382 :     | ENTRY _ => raise Fail "setPred on ENTRY node"
383 :     | JOIN{preds, ...} => if List.exists (fn nd' => same(nd, nd')) (!preds)
384 :     then ()
385 :     else preds := nd :: !preds
386 :     | COND{pred, ...} => pred := nd
387 :     | BLOCK{pred, ...} => pred := nd
388 :     | NEW{pred, ...} => pred := nd
389 :     | DIE{pred} => pred := nd
390 :     | STABILIZE{pred} => pred := nd
391 :     | EXIT{pred} => pred := nd
392 :     (* end case *))
393 :     fun preds (ND{kind, ...}) = (case kind
394 :     of NULL => raise Fail "preds on NULL node"
395 :     | ENTRY _ => []
396 :     | JOIN{preds, ...} => !preds
397 :     | COND{pred, ...} => [!pred]
398 :     | BLOCK{pred, ...} => [!pred]
399 :     | NEW{pred, ...} => [!pred]
400 :     | DIE{pred} => [!pred]
401 :     | STABILIZE{pred} => [!pred]
402 :     | EXIT{pred} => [!pred]
403 :     (* end case *))
404 :     fun hasSucc (ND{kind, ...}) = (case kind
405 :     of NULL => false
406 :     | ENTRY{succ} => true
407 :     | JOIN{succ, ...} => true
408 :     | COND{trueBranch, falseBranch, ...} => true
409 :     | BLOCK{succ, ...} => true
410 :     | NEW{succ, ...} => true
411 :     | DIE _ => false
412 :     | STABILIZE _ => false
413 :     | EXIT _ => false
414 :     (* end case *))
415 :     fun setSucc (ND{kind, ...}, nd) = (case kind
416 :     of NULL => raise Fail "setSucc on NULL node"
417 :     | ENTRY{succ} => succ := nd
418 :     | JOIN{succ, ...} => succ := nd
419 :     | COND _ => raise Fail "setSucc on COND node"
420 :     | BLOCK{succ, ...} => succ := nd
421 :     | NEW{succ, ...} => succ := nd
422 :     | DIE _ => raise Fail "setSucc on DIE node"
423 :     | STABILIZE _ => raise Fail "setSucc on STABILIZE node"
424 :     | EXIT _ => raise Fail "setSucc on EXIT node"
425 :     (* end case *))
426 :     fun succs (ND{kind, ...}) = (case kind
427 :     of NULL => raise Fail "succs on NULL node"
428 :     | ENTRY{succ} => [!succ]
429 :     | JOIN{succ, ...} => [!succ]
430 :     | COND{trueBranch, falseBranch, ...} => [!trueBranch, !falseBranch]
431 :     | BLOCK{succ, ...} => [!succ]
432 :     | NEW{succ, ...} => [!succ]
433 :     | DIE _ => []
434 :     | STABILIZE _ => []
435 :     | EXIT _ => []
436 :     (* end case *))
437 :     fun setTrueBranch (ND{kind=COND{trueBranch, ...}, ...}, nd) = trueBranch := nd
438 :     | setTrueBranch (nd, _) = raise Fail("setTrueBranch on " ^ toString nd)
439 :     fun setFalseBranch (ND{kind=COND{falseBranch, ...}, ...}, nd) = falseBranch := nd
440 :     | setFalseBranch (nd, _) = raise Fail("setFalseBranch on " ^ toString nd)
441 :     fun addEdge (nd1, nd2) = (
442 :     if hasSucc nd1
443 :     then (
444 :     setSucc (nd1, nd2);
445 :     setPred (nd2, nd1))
446 :     else ())
447 :     (*DEBUG*)handle ex => (
448 :     print(concat["error in addEdge(", toString nd1, ",", toString nd2, ")\n"]);
449 :     raise ex)
450 : jhr 283 (* properties *)
451 :     fun newProp initFn =
452 :     PropList.newProp (fn (ND{props, ...}) => props, initFn)
453 :     fun newFlag () =
454 :     PropList.newFlag (fn (ND{props, ...}) => props)
455 : jhr 256 end
456 : jhr 124
457 : jhr 256 structure Stmt =
458 :     struct
459 :     fun same (STM{id=a, ...}, STM{id=b, ...}) = Stamp.same(a, b)
460 :     fun compare (STM{id=a, ...}, STM{id=b, ...}) = Stamp.compare(a, b)
461 :     fun hash (STM{id, ...}) = Stamp.hash id
462 :     fun toString (STM{id, kind, ...}) = let
463 :     val tag = (case kind
464 :     of S_SIMPLE(ND{kind, ...}) => (case kind
465 :     of NULL => "NULL"
466 :     | ENTRY _ => "ENTRY"
467 :     | JOIN _ => "JOIN"
468 :     | COND _ => raise Fail "unexpected S_SIMPLE with COND node"
469 :     | BLOCK _ => "BLOCK"
470 :     | NEW _ => "NEW"
471 :     | DIE _ => "DIE"
472 :     | STABILIZE _ => "STABILIZE"
473 :     | EXIT _ => "EXIT"
474 :     (* end case *))
475 :     | S_IF _ => "IF"
476 :     | S_LOOP _ => "LOOP"
477 :     (* end case *))
478 :     in
479 :     tag ^ Stamp.toString id
480 :     end
481 :     (* return the entry node of the statement *)
482 :     fun entry (STM{kind, ...}) = (case kind
483 :     of S_SIMPLE nd => nd
484 :     | S_IF{cond, ...} => cond
485 :     | S_LOOP{hdr, ...} => entry hdr
486 :     (* end case *))
487 :     (* return the tail-end node of a statement (not applicable to S_IF or S_LOOP) *)
488 :     fun tail (STM{kind, ...}) = (case kind
489 :     of S_SIMPLE nd => nd
490 :     | S_IF{cond, ...} => raise Fail "tail of IF"
491 :     | S_LOOP{hdr, ...} => raise Fail "tail of LOOP"
492 :     (* end case *))
493 :     (* statement constructor functions *)
494 :     fun new (kind, next) = STM{
495 : jhr 137 id = Stamp.new(),
496 : jhr 188 props = PropList.newHolder(),
497 : jhr 256 kind = kind,
498 :     next = next
499 : jhr 137 }
500 : jhr 256 val dummy = new (S_SIMPLE(Node.dummy), NONE)
501 :     fun mkENTRY next = new (S_SIMPLE(Node.mkENTRY ()), next)
502 :     fun mkJOIN (phis, next) = new (S_SIMPLE(Node.mkJOIN phis), next)
503 :     fun mkIF (cond, thenBranch, elseBranch, next) = let
504 :     val cond = Node.mkCOND {
505 :     cond = cond,
506 :     trueBranch = entry thenBranch,
507 :     falseBranch = entry elseBranch
508 :     }
509 :     in
510 :     Node.setPred (entry thenBranch, cond);
511 :     Node.setPred (entry elseBranch, cond);
512 :     new (S_IF{cond = cond, thenBranch = thenBranch, elseBranch = elseBranch}, next)
513 :     end
514 :     fun mkBLOCK (body, next) = new (S_SIMPLE(Node.mkBLOCK body), next)
515 :     fun mkNEW (actor, args, next) = new (S_SIMPLE(Node.mkNEW{actor=actor, args=args}), next)
516 :     fun mkDIE () = new (S_SIMPLE(Node.mkDIE ()), NONE)
517 :     fun mkSTABILIZE () = new (S_SIMPLE(Node.mkSTABILIZE ()), NONE)
518 :     fun mkEXIT () = new (S_SIMPLE(Node.mkEXIT ()), NONE)
519 : jhr 283 (* properties *)
520 :     fun newProp initFn =
521 :     PropList.newProp (fn (STM{props, ...}) => props, initFn)
522 :     fun newFlag () =
523 :     PropList.newFlag (fn (STM{props, ...}) => props)
524 : jhr 256 end
525 : jhr 137
526 : jhr 199 structure Var =
527 :     struct
528 :     fun new name = V{
529 :     name = name,
530 :     id = Stamp.new(),
531 : jhr 367 bind = ref VB_NONE,
532 : jhr 199 useCnt = ref 0,
533 :     props = PropList.newHolder()
534 :     }
535 : jhr 364 fun name (V{name, ...}) = name
536 : jhr 367 fun binding (V{bind, ...}) = !bind
537 :     fun setBinding (V{bind, ...}, vb) = bind := vb
538 : jhr 199 fun same (V{id=a, ...}, V{id=b, ...}) = Stamp.same(a, b)
539 :     fun compare (V{id=a, ...}, V{id=b, ...}) = Stamp.compare(a, b)
540 :     fun hash (V{id, ...}) = Stamp.hash id
541 :     fun toString (V{name, id, ...}) = name ^ Stamp.toString id
542 : jhr 283 (* properties *)
543 :     fun newProp initFn =
544 :     PropList.newProp (fn (V{props, ...}) => props, initFn)
545 :     fun newFlag () =
546 :     PropList.newFlag (fn (V{props, ...}) => props)
547 : jhr 199 local
548 :     structure V =
549 :     struct
550 :     type ord_key = var
551 :     val compare = compare
552 :     end
553 :     in
554 :     structure Map = RedBlackMapFn (V)
555 :     structure Set = RedBlackSetFn (V)
556 :     end
557 :     structure Tbl = HashTableFn (
558 :     struct
559 :     type hash_key = var
560 :     val hashVal = hash
561 :     val sameKey = same
562 :     end)
563 :     end
564 : jhr 197
565 : jhr 319 (* DFS sorting of the graph rooted at the entry to a statement; the resulting list will
566 :     * be in preorder with parents before children.
567 :     *)
568 : jhr 257 fun sortNodes stmt = let
569 :     val {getFn, setFn} = PropList.newFlag (fn (ND{props, ...}) => props)
570 :     fun dfs (nd, l) =
571 :     if getFn nd
572 :     then l
573 :     else (
574 :     setFn (nd, true);
575 :     nd :: List.foldl dfs l (Node.succs nd))
576 : jhr 319 val nodes = dfs (Stmt.entry stmt, [])
577 : jhr 257 in
578 : jhr 319 List.app (fn nd => setFn(nd, false)) nodes;
579 :     nodes
580 : jhr 257 end
581 :    
582 : jhr 341 (* apply a function to all of the nodes in the graph rooted at the entry to the statement *)
583 :     fun applyToNodes (f : node -> unit) stmt = let
584 :     val {getFn, setFn} = PropList.newFlag (fn (ND{props, ...}) => props)
585 :     fun dfs (nd, l) =
586 :     if getFn nd
587 :     then l
588 :     else (
589 :     f nd; (* visit *)
590 :     setFn (nd, true);
591 :     nd :: List.foldl dfs l (Node.succs nd))
592 :     val nodes = dfs (Stmt.entry stmt, [])
593 :     in
594 :     List.app (fn nd => setFn(nd, false)) nodes
595 :     end
596 :    
597 : jhr 124 end

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