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

Parent Directory | Revision Log

---

Revision 283 - (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 :			useCnt : int ref, (* count of uses *)
92 :			props : PropList.holder
93 :			}
94 :
95 :			withtype assign = (var * rhs)
96 :
97 :	jhr	256	datatype program = Program of {
98 :			globals : var list,
99 :			globalInit : stmt,
100 :			actors : actor list
101 :			(* initialization *)
102 :			}
103 :	jhr	198
104 :	jhr	256	and actor = Actor of {
105 :			name : Atom.atom,
106 :			params : var list,
107 :			state : var list,
108 :			stateInit : stmt,
109 :			methods : method list
110 :			}
111 :	jhr	198
112 :	jhr	256	and method = Method of {
113 :			name : Atom.atom,
114 :			stateIn : var list, (* names of state variables on method entry *)
115 :			stateOut : var list, (* names of state variables on method exit *)
116 :			body : stmt (* method body *)
117 :			}
118 :	jhr	198
119 :	jhr	256	structure Node : sig
120 :			val same : node * node -> bool
121 :			val compare : node * node -> order
122 :			val hash : node -> word
123 :			val toString : node -> string
124 :			val preds : node -> node list
125 :			val setPred : node * node -> unit
126 :			val hasSucc : node -> bool
127 :			val succs : node -> node list
128 :			val setSucc : node * node -> unit
129 :			val setTrueBranch : node * node -> unit (* set trueBranch successor for COND node *)
130 :			val setFalseBranch : node * node -> unit (* set falseBranch successor for COND node *)
131 :			val addEdge : node * node -> unit
132 :	jhr	283	(* properties *)
133 :			val newProp : (node -> 'a) -> {
134 :			getFn : node -> 'a,
135 :			peekFn : node -> 'a option,
136 :			setFn : node * 'a -> unit,
137 :			clrFn : node -> unit
138 :			}
139 :			val newFlag : unit -> {
140 :			getFn : node -> bool,
141 :			setFn : node * bool -> unit
142 :			}
143 :	jhr	256	end
144 :	jhr	198
145 :	jhr	256	structure Stmt : sig
146 :			val same : stmt * stmt -> bool
147 :			val compare : stmt * stmt -> order
148 :			val hash : stmt -> word
149 :			val toString : stmt -> string
150 :			(* return the entry node of the statement *)
151 :			val entry : stmt -> node
152 :			(* return the tail-end node of a statement (not applicable to S_IF or S_LOOP) *)
153 :			val tail : stmt -> node
154 :			(* statement constructor functions *)
155 :			val mkENTRY : stmt option -> stmt
156 :			val mkJOIN : (var * var list) list * stmt option -> stmt
157 :			val mkIF : var * stmt * stmt * stmt option -> stmt
158 :			val mkBLOCK : assign list * stmt option -> stmt
159 :			val mkNEW : Atom.atom * var list * stmt option -> stmt
160 :			val mkDIE : unit -> stmt
161 :			val mkSTABILIZE : unit -> stmt
162 :			val mkEXIT : unit -> stmt
163 :	jhr	283	(* properties *)
164 :			val newProp : (stmt -> 'a) -> {
165 :			getFn : stmt -> 'a,
166 :			peekFn : stmt -> 'a option,
167 :			setFn : stmt * 'a -> unit,
168 :			clrFn : stmt -> unit
169 :			}
170 :			val newFlag : unit -> {
171 :			getFn : stmt -> bool,
172 :			setFn : stmt * bool -> unit
173 :			}
174 :	jhr	256	end
175 :	jhr	198
176 :	jhr	199	structure Var : sig
177 :			val new : string -> var
178 :			val same : var * var -> bool
179 :			val compare : var * var -> order
180 :			val hash : var -> word
181 :			val toString : var -> string
182 :	jhr	283	(* properties *)
183 :			val newProp : (var -> 'a) -> {
184 :			getFn : var -> 'a,
185 :			peekFn : var -> 'a option,
186 :			setFn : var * 'a -> unit,
187 :			clrFn : var -> unit
188 :			}
189 :			val newFlag : unit -> {
190 :			getFn : var -> bool,
191 :			setFn : var * bool -> unit
192 :			}
193 :			(* collections *)
194 :	jhr	199	structure Map : ORD_MAP where type Key.ord_key = var
195 :			structure Set : ORD_SET where type Key.ord_key = var
196 :			structure Tbl : MONO_HASH_TABLE where type Key.hash_key = var
197 :			end
198 :	jhr	198
199 :	jhr	257	(* DFS sorting of the graph rooted at the entry to a statement *)
200 :			val sortNodes : stmt -> node list
201 :
202 :	jhr	198	end
203 :
204 :			functor SSAFn (Op : OPERATORS) : SSA =
205 :	jhr	192	struct
206 :	jhr	137
207 :	jhr	192	structure Op = Op
208 :	jhr	137
209 :	jhr	256	datatype node = ND of {
210 :			id : Stamp.stamp,
211 :			props : PropList.holder,
212 :			kind : node_kind
213 :	jhr	197	}
214 :
215 :	jhr	256	and node_kind
216 :			= NULL
217 :			| ENTRY of {
218 :			succ : node ref
219 :			}
220 :			| JOIN of {
221 :			preds : node list ref,
222 :			phis : (var * var list) list ref, (* phi statements *)
223 :			succ : node ref
224 :			}
225 :			| COND of {
226 :			pred : node ref,
227 :			cond : var,
228 :			trueBranch : node ref,
229 :			falseBranch : node ref
230 :			}
231 :			| BLOCK of {
232 :			pred : node ref,
233 :			body : assign list ref,
234 :			succ : node ref
235 :			}
236 :			| NEW of {
237 :			pred : node ref,
238 :			actor : Atom.atom,
239 :			args : var list,
240 :			succ : node ref
241 :			}
242 :			| DIE of {
243 :			pred : node ref
244 :			}
245 :			| STABILIZE of {
246 :			pred : node ref
247 :			}
248 :			| EXIT of {
249 :			pred : node ref
250 :			}
251 :	jhr	197
252 :	jhr	256	(***** Statements *****)
253 :	jhr	197
254 :			and stmt = STM of {
255 :	jhr	188	id : Stamp.stamp,
256 :			props : PropList.holder,
257 :	jhr	256	kind : stmt_kind,
258 :			next : stmt option (* next statement at this structural level *)
259 :	jhr	188	}
260 :
261 :	jhr	192	and stmt_kind
262 :	jhr	256	= S_SIMPLE of node (* ENTRY, JOIN, BLOCK, NEW, DIE, STABILIZE, or EXIT node *)
263 :			| S_IF of {
264 :			cond : node, (* COND node *)
265 :	jhr	192	thenBranch : stmt,
266 :			elseBranch : stmt
267 :			}
268 :	jhr	256	| S_LOOP of {
269 :	jhr	192	hdr : stmt,
270 :	jhr	256	cond : node, (* COND node *)
271 :			body : stmt
272 :	jhr	192	}
273 :
274 :	jhr	188	and rhs
275 :			= VAR of var
276 :			| LIT of Literal.literal
277 :			| OP of Op.rator * var list
278 :			| CONS of var list (* tensor-value construction *)
279 :
280 :	jhr	192	and var = V of {
281 :	jhr	137	name : string, (* name *)
282 :			id : Stamp.stamp, (* unique ID *)
283 :			useCnt : int ref, (* count of uses *)
284 :			props : PropList.holder
285 :	jhr	124	}
286 :
287 :	jhr	192	withtype assign = (var * rhs)
288 :	jhr	188
289 :	jhr	256	datatype program = Program of {
290 :			globals : var list,
291 :			globalInit : stmt,
292 :			actors : actor list
293 :			(* initialization *)
294 :			}
295 :	jhr	188
296 :	jhr	256	and actor = Actor of {
297 :			name : Atom.atom,
298 :			params : var list,
299 :			state : var list,
300 :			stateInit : stmt,
301 :			methods : method list
302 :			}
303 :	jhr	188
304 :	jhr	256	and method = Method of {
305 :			name : Atom.atom,
306 :			stateIn : var list, (* names of state variables on method entry *)
307 :			stateOut : var list, (* names of state variables on method exit *)
308 :			body : stmt (* method body *)
309 :			}
310 :	jhr	188
311 :	jhr	256	structure Node =
312 :			struct
313 :			fun same (ND{id=a, ...}, ND{id=b, ...}) = Stamp.same(a, b)
314 :			fun compare (ND{id=a, ...}, ND{id=b, ...}) = Stamp.compare(a, b)
315 :			fun hash (ND{id, ...}) = Stamp.hash id
316 :			fun toString (ND{id, kind, ...}) = let
317 :			val tag = (case kind
318 :			of NULL => "NULL"
319 :			| ENTRY _ => "ENTRY"
320 :			| JOIN _ => "JOIN"
321 :			| COND _ => "COND"
322 :			| BLOCK _ => "BLOCK"
323 :			| NEW _ => "NEW"
324 :			| DIE _ => "DIE"
325 :			| STABILIZE _ => "STABILIZE"
326 :			| EXIT _ => "EXIT"
327 :			(* end case *))
328 :			in
329 :			tag ^ Stamp.toString id
330 :			end
331 :			fun new kind = ND{id = Stamp.new(), props = PropList.newHolder(), kind = kind}
332 :			val dummy = new NULL
333 :			fun mkENTRY () = new (ENTRY{succ = ref dummy})
334 :			fun mkJOIN phis = new (JOIN{preds = ref [], phis = ref phis, succ = ref dummy})
335 :			fun mkCOND {cond, trueBranch, falseBranch} = new (COND{
336 :			pred = ref dummy, cond = cond,
337 :			trueBranch = ref trueBranch, falseBranch = ref falseBranch
338 :			})
339 :			fun mkBLOCK body = new (BLOCK{pred = ref dummy, body = ref body, succ = ref dummy})
340 :			fun mkNEW {actor, args} = new (NEW{
341 :			pred = ref dummy, actor = actor, args = args, succ = ref dummy
342 :			})
343 :			fun mkDIE () = new (DIE{pred = ref dummy})
344 :			fun mkSTABILIZE () = new (STABILIZE{pred = ref dummy})
345 :			fun mkEXIT () = new (EXIT{pred = ref dummy})
346 :			(* editing node edges *)
347 :			fun setPred (ND{kind, ...}, nd) = (case kind
348 :			of NULL => raise Fail "setPred on NULL node"
349 :			| ENTRY _ => raise Fail "setPred on ENTRY node"
350 :			| JOIN{preds, ...} => if List.exists (fn nd' => same(nd, nd')) (!preds)
351 :			then ()
352 :			else preds := nd :: !preds
353 :			| COND{pred, ...} => pred := nd
354 :			| BLOCK{pred, ...} => pred := nd
355 :			| NEW{pred, ...} => pred := nd
356 :			| DIE{pred} => pred := nd
357 :			| STABILIZE{pred} => pred := nd
358 :			| EXIT{pred} => pred := nd
359 :			(* end case *))
360 :			fun preds (ND{kind, ...}) = (case kind
361 :			of NULL => raise Fail "preds on NULL node"
362 :			| ENTRY _ => []
363 :			| JOIN{preds, ...} => !preds
364 :			| COND{pred, ...} => [!pred]
365 :			| BLOCK{pred, ...} => [!pred]
366 :			| NEW{pred, ...} => [!pred]
367 :			| DIE{pred} => [!pred]
368 :			| STABILIZE{pred} => [!pred]
369 :			| EXIT{pred} => [!pred]
370 :			(* end case *))
371 :			fun hasSucc (ND{kind, ...}) = (case kind
372 :			of NULL => false
373 :			| ENTRY{succ} => true
374 :			| JOIN{succ, ...} => true
375 :			| COND{trueBranch, falseBranch, ...} => true
376 :			| BLOCK{succ, ...} => true
377 :			| NEW{succ, ...} => true
378 :			| DIE _ => false
379 :			| STABILIZE _ => false
380 :			| EXIT _ => false
381 :			(* end case *))
382 :			fun setSucc (ND{kind, ...}, nd) = (case kind
383 :			of NULL => raise Fail "setSucc on NULL node"
384 :			| ENTRY{succ} => succ := nd
385 :			| JOIN{succ, ...} => succ := nd
386 :			| COND _ => raise Fail "setSucc on COND node"
387 :			| BLOCK{succ, ...} => succ := nd
388 :			| NEW{succ, ...} => succ := nd
389 :			| DIE _ => raise Fail "setSucc on DIE node"
390 :			| STABILIZE _ => raise Fail "setSucc on STABILIZE node"
391 :			| EXIT _ => raise Fail "setSucc on EXIT node"
392 :			(* end case *))
393 :			fun succs (ND{kind, ...}) = (case kind
394 :			of NULL => raise Fail "succs on NULL node"
395 :			| ENTRY{succ} => [!succ]
396 :			| JOIN{succ, ...} => [!succ]
397 :			| COND{trueBranch, falseBranch, ...} => [!trueBranch, !falseBranch]
398 :			| BLOCK{succ, ...} => [!succ]
399 :			| NEW{succ, ...} => [!succ]
400 :			| DIE _ => []
401 :			| STABILIZE _ => []
402 :			| EXIT _ => []
403 :			(* end case *))
404 :			fun setTrueBranch (ND{kind=COND{trueBranch, ...}, ...}, nd) = trueBranch := nd
405 :			| setTrueBranch (nd, _) = raise Fail("setTrueBranch on " ^ toString nd)
406 :			fun setFalseBranch (ND{kind=COND{falseBranch, ...}, ...}, nd) = falseBranch := nd
407 :			| setFalseBranch (nd, _) = raise Fail("setFalseBranch on " ^ toString nd)
408 :			fun addEdge (nd1, nd2) = (
409 :			if hasSucc nd1
410 :			then (
411 :			setSucc (nd1, nd2);
412 :			setPred (nd2, nd1))
413 :			else ())
414 :			(*DEBUG*)handle ex => (
415 :			print(concat["error in addEdge(", toString nd1, ",", toString nd2, ")\n"]);
416 :			raise ex)
417 :	jhr	283	(* properties *)
418 :			fun newProp initFn =
419 :			PropList.newProp (fn (ND{props, ...}) => props, initFn)
420 :			fun newFlag () =
421 :			PropList.newFlag (fn (ND{props, ...}) => props)
422 :	jhr	256	end
423 :	jhr	124
424 :	jhr	256	structure Stmt =
425 :			struct
426 :			fun same (STM{id=a, ...}, STM{id=b, ...}) = Stamp.same(a, b)
427 :			fun compare (STM{id=a, ...}, STM{id=b, ...}) = Stamp.compare(a, b)
428 :			fun hash (STM{id, ...}) = Stamp.hash id
429 :			fun toString (STM{id, kind, ...}) = let
430 :			val tag = (case kind
431 :			of S_SIMPLE(ND{kind, ...}) => (case kind
432 :			of NULL => "NULL"
433 :			| ENTRY _ => "ENTRY"
434 :			| JOIN _ => "JOIN"
435 :			| COND _ => raise Fail "unexpected S_SIMPLE with COND node"
436 :			| BLOCK _ => "BLOCK"
437 :			| NEW _ => "NEW"
438 :			| DIE _ => "DIE"
439 :			| STABILIZE _ => "STABILIZE"
440 :			| EXIT _ => "EXIT"
441 :			(* end case *))
442 :			| S_IF _ => "IF"
443 :			| S_LOOP _ => "LOOP"
444 :			(* end case *))
445 :			in
446 :			tag ^ Stamp.toString id
447 :			end
448 :			(* return the entry node of the statement *)
449 :			fun entry (STM{kind, ...}) = (case kind
450 :			of S_SIMPLE nd => nd
451 :			| S_IF{cond, ...} => cond
452 :			| S_LOOP{hdr, ...} => entry hdr
453 :			(* end case *))
454 :			(* return the tail-end node of a statement (not applicable to S_IF or S_LOOP) *)
455 :			fun tail (STM{kind, ...}) = (case kind
456 :			of S_SIMPLE nd => nd
457 :			| S_IF{cond, ...} => raise Fail "tail of IF"
458 :			| S_LOOP{hdr, ...} => raise Fail "tail of LOOP"
459 :			(* end case *))
460 :			(* statement constructor functions *)
461 :			fun new (kind, next) = STM{
462 :	jhr	137	id = Stamp.new(),
463 :	jhr	188	props = PropList.newHolder(),
464 :	jhr	256	kind = kind,
465 :			next = next
466 :	jhr	137	}
467 :	jhr	256	val dummy = new (S_SIMPLE(Node.dummy), NONE)
468 :			fun mkENTRY next = new (S_SIMPLE(Node.mkENTRY ()), next)
469 :			fun mkJOIN (phis, next) = new (S_SIMPLE(Node.mkJOIN phis), next)
470 :			fun mkIF (cond, thenBranch, elseBranch, next) = let
471 :			val cond = Node.mkCOND {
472 :			cond = cond,
473 :			trueBranch = entry thenBranch,
474 :			falseBranch = entry elseBranch
475 :			}
476 :			in
477 :			Node.setPred (entry thenBranch, cond);
478 :			Node.setPred (entry elseBranch, cond);
479 :			new (S_IF{cond = cond, thenBranch = thenBranch, elseBranch = elseBranch}, next)
480 :			end
481 :			fun mkBLOCK (body, next) = new (S_SIMPLE(Node.mkBLOCK body), next)
482 :			fun mkNEW (actor, args, next) = new (S_SIMPLE(Node.mkNEW{actor=actor, args=args}), next)
483 :			fun mkDIE () = new (S_SIMPLE(Node.mkDIE ()), NONE)
484 :			fun mkSTABILIZE () = new (S_SIMPLE(Node.mkSTABILIZE ()), NONE)
485 :			fun mkEXIT () = new (S_SIMPLE(Node.mkEXIT ()), NONE)
486 :	jhr	283	(* properties *)
487 :			fun newProp initFn =
488 :			PropList.newProp (fn (STM{props, ...}) => props, initFn)
489 :			fun newFlag () =
490 :			PropList.newFlag (fn (STM{props, ...}) => props)
491 :	jhr	256	end
492 :	jhr	137
493 :	jhr	199	structure Var =
494 :			struct
495 :			fun new name = V{
496 :			name = name,
497 :			id = Stamp.new(),
498 :			useCnt = ref 0,
499 :			props = PropList.newHolder()
500 :			}
501 :			fun same (V{id=a, ...}, V{id=b, ...}) = Stamp.same(a, b)
502 :			fun compare (V{id=a, ...}, V{id=b, ...}) = Stamp.compare(a, b)
503 :			fun hash (V{id, ...}) = Stamp.hash id
504 :			fun toString (V{name, id, ...}) = name ^ Stamp.toString id
505 :	jhr	283	(* properties *)
506 :			fun newProp initFn =
507 :			PropList.newProp (fn (V{props, ...}) => props, initFn)
508 :			fun newFlag () =
509 :			PropList.newFlag (fn (V{props, ...}) => props)
510 :	jhr	199	local
511 :			structure V =
512 :			struct
513 :			type ord_key = var
514 :			val compare = compare
515 :			end
516 :			in
517 :			structure Map = RedBlackMapFn (V)
518 :			structure Set = RedBlackSetFn (V)
519 :			end
520 :			structure Tbl = HashTableFn (
521 :			struct
522 :			type hash_key = var
523 :			val hashVal = hash
524 :			val sameKey = same
525 :			end)
526 :			end
527 :	jhr	197
528 :	jhr	257	(* DFS sorting of the graph rooted at the entry to a statement *)
529 :			fun sortNodes stmt = let
530 :			val {getFn, setFn} = PropList.newFlag (fn (ND{props, ...}) => props)
531 :			fun dfs (nd, l) =
532 :			if getFn nd
533 :			then l
534 :			else (
535 :			setFn (nd, true);
536 :			nd :: List.foldl dfs l (Node.succs nd))
537 :			in
538 :			dfs (Stmt.entry stmt, [])
539 :			end
540 :
541 :	jhr	124	end

---

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