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

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

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