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

Parent Directory | Revision Log | Patch

	revision 191, Mon Aug 2 14:05:11 2010 UTC	revision 192, Mon Aug 2 16:23:42 2010 UTC
#	Line 7	Line 7
7	* graph of blocks.	* graph of blocks.
8	*)	*)
9
10	signature SSA =	functor SSAFn (Op : OPERATORS) (*: SSA*) =
11	sig	struct
	structure Op : OPERATORS
12
13	datatype var = V of {	structure Op = Op
	name : string,                  (* name *)
	id : Stamp.stamp,               (* unique ID *)
	useCnt : int ref,               (* count of uses *)
	props : PropList.holder
	}
14
15	datatype block = BLK of {	datatype stmt = STM of {
16	id : Stamp.stamp,	id : Stamp.stamp,
17	props : PropList.holder,	props : PropList.holder,
18	preds : block list ref,	preds : stmt list ref,
19	succs : block list ref,	phis : (var * var list) list ref,       (* phi statements *)
20	phi : (var * var list) list ref,        (* phi statements *)	kind : stmt_kind ref
	body : assign list ref,
	exit : transfer ref
21	}	}
22
23	and rhs	and stmt_kind
24	= VAR of var	= BLOCK of {
25	| LIT of Literal.literal	succ : stmt,
26	| OP of Op.rator * var list	body : assign list
27	| CONS of var list                (* tensor-value construction *)	}
	and transfer
	= EXIT
	| GOTO of block
	| COND of var * block * block
	| DIE
	| STABILIZE
	withtype assign = (var * rhs)
	(* we layer a block-structured statement tree over the CFG to preserve
	* the high-level control-flow structure for when we need to produce
	* code.
	*)
	datatype stmt
	= BLOCK of block
	| SEQ of stmt list
28	| IF of {	| IF of {
29	cond : var,	cond : var,
30	trueBranch : stmt,	thenBranch : stmt,
31	falseBranch : stmt	elseBranch : stmt
32	}	}
33	| WHILE of {	| LOOP of {
34	hdr : block,	hdr : stmt,
35	cond : var,	cond : var,
36	body : stmt	body : stmt,
37	}	exit : stmt
	val newVar : string -> var
	val newBlock : unit -> block
	(*
	val entryBlock : stmt -> block
	val nextBlock : stmt -> block
	*)
	end
	functor SSAFn (Op : OPERATORS) : SSA =
	struct
	structure Op = Op
	datatype var = V of {
	name : string,                  (* name *)
	id : Stamp.stamp,               (* unique ID *)
	useCnt : int ref,               (* count of uses *)
	props : PropList.holder
38	}	}
39		| NEW of {
40	datatype block = BLK of {	actor : Atom.atom,
41	id : Stamp.stamp,	args : var list,
42	props : PropList.holder,	succ : stmt
	preds : block list ref,
	succs : block list ref,
	phi : (var * var list) list ref,        (* phi statements *)
	body : assign list ref,
	exit : transfer ref
43	}	}
44		| DIE
45		| STABILIZE
46		| EXIT
47
48	and rhs	and rhs
49	= VAR of var	= VAR of var
#	Line 99	Line 51
51	| OP of Op.rator * var list	| OP of Op.rator * var list
52	| CONS of var list                (* tensor-value construction *)	| CONS of var list                (* tensor-value construction *)
53
54	and transfer	and var = V of {
55	= EXIT	name : string,                  (* name *)
56	| GOTO of block	id : Stamp.stamp,               (* unique ID *)
57	| COND of var * block * block	useCnt : int ref,               (* count of uses *)
58	| DIE	props : PropList.holder
59	| STABILIZE	}
60
61	withtype assign = (var * rhs)	withtype assign = (var * rhs)
62
63	(* we layer a block-structured statement tree over the CFG to preserve	fun same (STM{id=a, ...}, STM{id=b, ...}) = Stamp.same(a, b)
64	* the high-level control-flow structure for when we need to produce	fun compare (STM{id=a, ...}, STM{id=b, ...}) = Stamp.compare(a, b)
65	* code.	fun hash (STM{id, ...}) = Stamp.hash id
66	*)
67	datatype stmt	fun succs (STM{kind, ...}) = (case !kind
68	= BLOCK of block	of BLOCK{succ, ...} => [succ]
69	| SEQ of stmt list	| IF{thenBranch, elseBranch, ...} => [thenBranch, elseBranch]
70	| IF of {	| LOOP{exit, ...} => [exit]
71	cond : var,	| NEW{succ, ...} => [succ]
72	trueBranch : stmt,	| _ => []
73	falseBranch : stmt	(* end case *))
74	}
75	| WHILE of {	(* set the successor of a statement *)
76	hdr : block,	fun setSucc (STM{kind, ...}, stm) = (case !kind
77	cond : var,	of BLOCK{succ, body} => kind := BLOCK{succ=stm, body=body}
78	body : stmt	| IF{thenBranch, elseBranch, ...} => (
79	}	setSucc(thenBranch, stm);
80		setSucc(elseBranch, stm))
81		| LOOP{hdr, cond, body, exit} => kind := LOOP{hdr=hdr, cond=cond, body=body, exit=stm}
82		| NEW{actor, args, succ} => kind := NEW{actor=actor, args=args, succ=stm}
83		| _ => () (* no successor *)
84		(* end case *))
85
86		fun preds (STM{preds, ...}) = !preds
87
88		fun addPred (STM{preds, ...}, stm) =
89		if not(List.exists (fn b => same(stm, b)) (!preds))
90		then preds := stm :: !preds
91		else ();
92
93	(* IL construction code *)	fun mkSTM kind = STM{
	fun newVar name = V{
	name = name,
	id = Stamp.new(),
	useCnt = ref 0,
	props = PropList.newHolder()
	}
	fun newBlock () = BLK{
94	id = Stamp.new(),	id = Stamp.new(),
95	props = PropList.newHolder(),	props = PropList.newHolder(),
96	preds = ref[],	preds = ref[],
97	succs = ref[],	phis = ref [],
98	phi = ref[],	kind = ref kind
99	body = ref[],	}
	exit = ref EXIT
	}
	(*
	local
	fun setParent (BLK{parent, ...}, s) = (parent := s)
	in
	fun mkIF (pre, cond, t, f) = let
	val s = IF{pre=pre, cond=cond, trueBranch=t, falseBranch=f}
	in
	setParent (pre, s);
	s
	end
	fun mkWHILE (hdr, cond, body) = let
	val s = WHILE{hdr=hdr, cond=cond, body=body}
	in
	setParent (hdr, s);
	s
	end
100
101	end (* local *)	val dummy = mkSTM EXIT
	*)
102
103	(*	fun mkBLOCK args = mkSTM(BLOCK args)
104	fun entryBlock (BLOCK blk) = blk	fun mkIF args = mkSTM(IF args)
105	| entryBlock (SEQ(s1::_)) = entryBlock s1	fun mkLOOP args = mkSTM(LOOP args)
106	| entryBlock (IF{pre, ...}) = entryBlock pre	fun mkDIE () = mkSTM DIE
107	| entryBlock (WHILE{hdr, ...}) = entryBlock hdr	fun mkSTABILIZE () = mkSTM STABILIZE
108		fun mkEXIT () = mkSTM EXIT
	fun nextBlock (BLOCK(_, next)) = nextBlock next
	| nextBlock (SEQ stms) = nextBlock(List.last stms)
	| nextBlock (IF{pre, ...}) = entryBlock pre
	| nextBlock (WHILE{hdr, ...}) = entryBlock hdr
	*)
109
110	end	end

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.191   changed lines   Added in v.192

---

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