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

Parent Directory | Revision Log | Patch

	revision 255, Sun Aug 8 14:55:53 2010 UTC	revision 256, Mon Aug 9 17:28:57 2010 UTC
#	Line 12	Line 12
12
13	structure Op : OPERATORS	structure Op : OPERATORS
14
15	datatype program = Program of {	(***** CFG *****)
16	globals : var list,
17	globalInit : stmt,	datatype node = ND of {
18	actors : actor list	id : Stamp.stamp,
19	(* initialization *)	props : PropList.holder,
20		kind : node_kind
21	}	}
22
23	and actor = Actor of {	and node_kind
24	name : Atom.atom,	= NULL
25	params : var list,	| ENTRY of {
26	state : var list,	succ : node ref
27	stateInit : stmt,	}
28	methods : method list	| 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
60	and method = Method of Atom.atom * stmt	(***** Statements *****)
61
62	and stmt = STM of {	and stmt = STM of {
63	id : Stamp.stamp,	id : Stamp.stamp,
64	props : PropList.holder,	props : PropList.holder,
65	preds : stmt list ref,	kind : stmt_kind,
66	phis : (var * var list) list ref,       (* phi statements *)	next : stmt option              (* next statement at this structural level *)
	kind : stmt_kind ref
67	}	}
68
69	and stmt_kind	and stmt_kind
70	= BLOCK of {	= S_SIMPLE of node                (* ENTRY, JOIN, BLOCK, NEW, DIE, STABILIZE, or EXIT node *)
71	succ : stmt,	| S_IF of {
72	body : assign list	cond : node,                (* COND node *)
	}
	| IF of {
	cond : var,
73	thenBranch : stmt,	thenBranch : stmt,
74	elseBranch : stmt	elseBranch : stmt
75	}	}
76	| LOOP of {	| S_LOOP of {
77	hdr : stmt,	hdr : stmt,
78	cond : var,	cond : node,                (* COND node *)
79	body : stmt,	body : stmt
	exit : stmt
	}
	| NEW of {
	actor : Atom.atom,
	args : var list,
	succ : stmt
80	}	}
	| DIE
	| STABILIZE
	| EXIT
81
82	and rhs	and rhs
83	= VAR of var	= VAR of var
#	Line 77	Line 94
94
95	withtype assign = (var * rhs)	withtype assign = (var * rhs)
96
97	val same : stmt * stmt -> bool	datatype program = Program of {
98	val compare : stmt * stmt -> order	globals : var list,
99	val hash : stmt -> word	globalInit : stmt,
100		actors : actor list
101	val succs : stmt -> stmt list	(* initialization *)
102		}
	(* set the successor of a statement *)
	val setSucc : stmt * stmt -> unit
	val preds : stmt -> stmt list
103
104	val addPred : stmt * stmt -> unit	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
112	val dummy : stmt	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
119		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		end
133
134	val mkBLOCK : {succ : stmt, body : assign list} -> stmt	structure Stmt : sig
135	val mkIF : {cond : var, thenBranch : stmt, elseBranch : stmt} -> stmt	val same : stmt * stmt -> bool
136	val mkLOOP : {hdr : stmt, cond : var, body : stmt, exit : stmt} -> stmt	val compare : stmt * stmt -> order
137	val mkNEW : {actor : Atom.atom, args : var list, succ : stmt} -> stmt	val hash : stmt -> word
138		val toString : stmt -> string
139		(* return the entry node of the statement *)
140		val entry : stmt -> node
141		(* return the tail-end node of a statement (not applicable to S_IF or S_LOOP) *)
142		val tail : stmt -> node
143		(* statement constructor functions *)
144		val mkENTRY : stmt option -> stmt
145		val mkJOIN : (var * var list) list * stmt option -> stmt
146		val mkIF : var * stmt * stmt * stmt option -> stmt
147		val mkBLOCK : assign list * stmt option -> stmt
148		val mkNEW : Atom.atom * var list * stmt option -> stmt
149	val mkDIE : unit -> stmt	val mkDIE : unit -> stmt
150	val mkSTABILIZE : unit -> stmt	val mkSTABILIZE : unit -> stmt
151	val mkEXIT : unit -> stmt	val mkEXIT : unit -> stmt
152		end
153
154	structure Var : sig	structure Var : sig
155	val new : string -> var	val new : string -> var
#	Line 118	Line 169
169
170	structure Op = Op	structure Op = Op
171
172	datatype program = Program of {	datatype node = ND of {
173	globals : var list,	id : Stamp.stamp,
174	globalInit : stmt,	props : PropList.holder,
175	actors : actor list	kind : node_kind
	(* initialization *)
176	}	}
177
178	and actor = Actor of {	and node_kind
179	name : Atom.atom,	= NULL
180	params : var list,	| ENTRY of {
181	state : var list,	succ : node ref
182	stateInit : stmt,	}
183	methods : method list	| JOIN of {
184		preds : node list ref,
185		phis : (var * var list) list ref,   (* phi statements *)
186		succ : node ref
187		}
188		| COND of {
189		pred : node ref,
190		cond : var,
191		trueBranch : node ref,
192		falseBranch : node ref
193		}
194		| BLOCK of {
195		pred : node ref,
196		body : assign list ref,
197		succ : node ref
198		}
199		| NEW of {
200		pred : node ref,
201		actor : Atom.atom,
202		args : var list,
203		succ : node ref
204		}
205		| DIE of {
206		pred : node ref
207		}
208		| STABILIZE of {
209		pred : node ref
210		}
211		| EXIT of {
212		pred : node ref
213	}	}
214
215	and method = Method of Atom.atom * stmt	(***** Statements *****)
216
217	and stmt = STM of {	and stmt = STM of {
218	id : Stamp.stamp,	id : Stamp.stamp,
219	props : PropList.holder,	props : PropList.holder,
220	preds : stmt list ref,	kind : stmt_kind,
221	phis : (var * var list) list ref,       (* phi statements *)	next : stmt option              (* next statement at this structural level *)
	kind : stmt_kind ref
222	}	}
223
224	and stmt_kind	and stmt_kind
225	= BLOCK of {	= S_SIMPLE of node                (* ENTRY, JOIN, BLOCK, NEW, DIE, STABILIZE, or EXIT node *)
226	succ : stmt,	| S_IF of {
227	body : assign list	cond : node,                (* COND node *)
	}
	| IF of {
	cond : var,
228	thenBranch : stmt,	thenBranch : stmt,
229	elseBranch : stmt	elseBranch : stmt
230	}	}
231	| LOOP of {	| S_LOOP of {
232	hdr : stmt,	hdr : stmt,
233	cond : var,	cond : node,                (* COND node *)
234	body : stmt,	body : stmt
	exit : stmt
	}
	| NEW of {
	actor : Atom.atom,
	args : var list,
	succ : stmt
235	}	}
	| DIE
	| STABILIZE
	| EXIT
236
237	and rhs	and rhs
238	= VAR of var	= VAR of var
#	Line 183	Line 249
249
250	withtype assign = (var * rhs)	withtype assign = (var * rhs)
251
252		datatype program = Program of {
253		globals : var list,
254		globalInit : stmt,
255		actors : actor list
256		(* initialization *)
257		}
258
259		and actor = Actor of {
260		name : Atom.atom,
261		params : var list,
262		state : var list,
263		stateInit : stmt,
264		methods : method list
265		}
266
267		and method = Method of {
268		name : Atom.atom,
269		stateIn : var list,     (* names of state variables on method entry *)
270		stateOut : var list,    (* names of state variables on method exit *)
271		body : stmt             (* method body *)
272		}
273
274		structure Node =
275		struct
276		fun same (ND{id=a, ...}, ND{id=b, ...}) = Stamp.same(a, b)
277		fun compare (ND{id=a, ...}, ND{id=b, ...}) = Stamp.compare(a, b)
278		fun hash (ND{id, ...}) = Stamp.hash id
279		fun toString (ND{id, kind, ...}) = let
280		val tag = (case kind
281		of NULL => "NULL"
282		| ENTRY _ => "ENTRY"
283		| JOIN _ => "JOIN"
284		| COND _ => "COND"
285		| BLOCK _ => "BLOCK"
286		| NEW _ => "NEW"
287		| DIE _ => "DIE"
288		| STABILIZE _ => "STABILIZE"
289		| EXIT _ => "EXIT"
290		(* end case *))
291		in
292		tag ^ Stamp.toString id
293		end
294		fun new kind = ND{id = Stamp.new(), props = PropList.newHolder(), kind = kind}
295		val dummy = new NULL
296		fun mkENTRY () = new (ENTRY{succ = ref dummy})
297		fun mkJOIN phis = new (JOIN{preds = ref [], phis = ref phis, succ = ref dummy})
298		fun mkCOND {cond, trueBranch, falseBranch} = new (COND{
299		pred = ref dummy, cond = cond,
300		trueBranch = ref trueBranch, falseBranch = ref falseBranch
301		})
302		fun mkBLOCK body = new (BLOCK{pred = ref dummy, body = ref body, succ = ref dummy})
303		fun mkNEW {actor, args} = new (NEW{
304		pred = ref dummy, actor = actor, args = args, succ = ref dummy
305		})
306		fun mkDIE () = new (DIE{pred = ref dummy})
307		fun mkSTABILIZE () = new (STABILIZE{pred = ref dummy})
308		fun mkEXIT () = new (EXIT{pred = ref dummy})
309		(* editing node edges *)
310		fun setPred (ND{kind, ...}, nd) = (case kind
311		of NULL => raise Fail "setPred on NULL node"
312		| ENTRY _ => raise Fail "setPred on ENTRY node"
313		| JOIN{preds, ...} => if List.exists (fn nd' => same(nd, nd')) (!preds)
314		then ()
315		else preds := nd :: !preds
316		| COND{pred, ...} => pred := nd
317		| BLOCK{pred, ...} => pred := nd
318		| NEW{pred, ...} => pred := nd
319		| DIE{pred} => pred := nd
320		| STABILIZE{pred} => pred := nd
321		| EXIT{pred} => pred := nd
322		(* end case *))
323		fun preds (ND{kind, ...}) = (case kind
324		of NULL => raise Fail "preds on NULL node"
325		| ENTRY _ => []
326		| JOIN{preds, ...} => !preds
327		| COND{pred, ...} => [!pred]
328		| BLOCK{pred, ...} => [!pred]
329		| NEW{pred, ...} => [!pred]
330		| DIE{pred} => [!pred]
331		| STABILIZE{pred} => [!pred]
332		| EXIT{pred} => [!pred]
333		(* end case *))
334		fun hasSucc (ND{kind, ...}) = (case kind
335		of NULL => false
336		| ENTRY{succ} => true
337		| JOIN{succ, ...} => true
338		| COND{trueBranch, falseBranch, ...} => true
339		| BLOCK{succ, ...} => true
340		| NEW{succ, ...} => true
341		| DIE _ => false
342		| STABILIZE _ => false
343		| EXIT _ => false
344		(* end case *))
345		fun setSucc (ND{kind, ...}, nd) = (case kind
346		of NULL => raise Fail "setSucc on NULL node"
347		| ENTRY{succ} => succ := nd
348		| JOIN{succ, ...} => succ := nd
349		| COND _ => raise Fail "setSucc on COND node"
350		| BLOCK{succ, ...} => succ := nd
351		| NEW{succ, ...} => succ := nd
352		| DIE _ => raise Fail "setSucc on DIE node"
353		| STABILIZE _ => raise Fail "setSucc on STABILIZE node"
354		| EXIT _ => raise Fail "setSucc on EXIT node"
355		(* end case *))
356		fun succs (ND{kind, ...}) = (case kind
357		of NULL => raise Fail "succs on NULL node"
358		| ENTRY{succ} => [!succ]
359		| JOIN{succ, ...} => [!succ]
360		| COND{trueBranch, falseBranch, ...} => [!trueBranch, !falseBranch]
361		| BLOCK{succ, ...} => [!succ]
362		| NEW{succ, ...} => [!succ]
363		| DIE _ => []
364		| STABILIZE _ => []
365		| EXIT _ => []
366		(* end case *))
367		fun setTrueBranch (ND{kind=COND{trueBranch, ...}, ...}, nd) = trueBranch := nd
368		| setTrueBranch (nd, _) = raise Fail("setTrueBranch on " ^ toString nd)
369		fun setFalseBranch (ND{kind=COND{falseBranch, ...}, ...}, nd) = falseBranch := nd
370		| setFalseBranch (nd, _) = raise Fail("setFalseBranch on " ^ toString nd)
371		fun addEdge (nd1, nd2) = (
372		if hasSucc nd1
373		then (
374		setSucc (nd1, nd2);
375		setPred (nd2, nd1))
376		else ())
377		(*DEBUG*)handle ex => (
378		print(concat["error in addEdge(", toString nd1, ",", toString nd2, ")\n"]);
379		raise ex)
380		end
381
382		structure Stmt =
383		struct
384	fun same (STM{id=a, ...}, STM{id=b, ...}) = Stamp.same(a, b)	fun same (STM{id=a, ...}, STM{id=b, ...}) = Stamp.same(a, b)
385	fun compare (STM{id=a, ...}, STM{id=b, ...}) = Stamp.compare(a, b)	fun compare (STM{id=a, ...}, STM{id=b, ...}) = Stamp.compare(a, b)
386	fun hash (STM{id, ...}) = Stamp.hash id	fun hash (STM{id, ...}) = Stamp.hash id
387		fun toString (STM{id, kind, ...}) = let
388	fun succs (STM{kind, ...}) = (case !kind	val tag = (case kind
389	of BLOCK{succ, ...} => [succ]	of S_SIMPLE(ND{kind, ...}) => (case kind
390	| IF{thenBranch, elseBranch, ...} => [thenBranch, elseBranch]	of NULL => "NULL"
391	| LOOP{exit, ...} => [exit]	| ENTRY _ => "ENTRY"
392	| NEW{succ, ...} => [succ]	| JOIN _ => "JOIN"
393	| _ => []	| COND _ => raise Fail "unexpected S_SIMPLE with COND node"
394	(* end case *))	| BLOCK _ => "BLOCK"
395		| NEW _ => "NEW"
396	(* set the successor of a statement *)	| DIE _ => "DIE"
397	fun setSucc (STM{kind, ...}, stm) = (case !kind	| STABILIZE _ => "STABILIZE"
398	of BLOCK{succ, body} => kind := BLOCK{succ=stm, body=body}	| EXIT _ => "EXIT"
399	| IF{thenBranch, elseBranch, ...} => (	(* end case *))
400	setSucc(thenBranch, stm);	| S_IF _ => "IF"
401	setSucc(elseBranch, stm))	| S_LOOP _ => "LOOP"
402	| LOOP{hdr, cond, body, exit} => kind := LOOP{hdr=hdr, cond=cond, body=body, exit=stm}	(* end case *))
403	| NEW{actor, args, succ} => kind := NEW{actor=actor, args=args, succ=stm}	in
404	| _ => () (* no successor *)	tag ^ Stamp.toString id
405	(* end case *))	end
406		(* return the entry node of the statement *)
407	fun preds (STM{preds, ...}) = !preds	fun entry (STM{kind, ...}) = (case kind
408		of S_SIMPLE nd => nd
409	fun addPred (STM{preds, ...}, stm) =	| S_IF{cond, ...} => cond
410	if not(List.exists (fn b => same(stm, b)) (!preds))	| S_LOOP{hdr, ...} => entry hdr
411	then preds := stm :: !preds	(* end case *))
412	else ();	(* return the tail-end node of a statement (not applicable to S_IF or S_LOOP) *)
413		fun tail (STM{kind, ...}) = (case kind
414	fun mkSTM kind = STM{	of S_SIMPLE nd => nd
415		| S_IF{cond, ...} => raise Fail "tail of IF"
416		| S_LOOP{hdr, ...} => raise Fail "tail of LOOP"
417		(* end case *))
418		(* statement constructor functions *)
419		fun new (kind, next) = STM{
420	id = Stamp.new(),	id = Stamp.new(),
421	props = PropList.newHolder(),	props = PropList.newHolder(),
422	preds = ref [],	kind = kind,
423	phis = ref [],	next = next
	kind = ref kind
424	}	}
425		val dummy = new (S_SIMPLE(Node.dummy), NONE)
426	val dummy = mkSTM EXIT	fun mkENTRY next = new (S_SIMPLE(Node.mkENTRY ()), next)
427		fun mkJOIN (phis, next) = new (S_SIMPLE(Node.mkJOIN phis), next)
428	fun mkBLOCK args = mkSTM(BLOCK args)	fun mkIF (cond, thenBranch, elseBranch, next) = let
429	fun mkIF args = mkSTM(IF args)	val cond = Node.mkCOND {
430	fun mkLOOP args = mkSTM(LOOP args)	cond = cond,
431	fun mkNEW args = mkSTM(NEW args)	trueBranch = entry thenBranch,
432	fun mkDIE () = mkSTM DIE	falseBranch = entry elseBranch
433	fun mkSTABILIZE () = mkSTM STABILIZE	}
434	fun mkEXIT () = mkSTM EXIT	in
435		Node.setPred (entry thenBranch, cond);
436		Node.setPred (entry elseBranch, cond);
437		new (S_IF{cond = cond, thenBranch = thenBranch, elseBranch = elseBranch}, next)
438		end
439		fun mkBLOCK (body, next) = new (S_SIMPLE(Node.mkBLOCK body), next)
440		fun mkNEW (actor, args, next) = new (S_SIMPLE(Node.mkNEW{actor=actor, args=args}), next)
441		fun mkDIE () = new (S_SIMPLE(Node.mkDIE ()), NONE)
442		fun mkSTABILIZE () = new (S_SIMPLE(Node.mkSTABILIZE ()), NONE)
443		fun mkEXIT () = new (S_SIMPLE(Node.mkEXIT ()), NONE)
444		end
445
446	structure Var =	structure Var =
447	struct	struct

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.255   changed lines   Added in v.256

---

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