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

SCM Repository

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

Annotation of /branches/pure-cfg/src/compiler/IL/ssa-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


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

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