Diff of /branches/lamont_dev/src/compiler/translate/translate.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 49	Line 49
49	* block, plus the environment mapping Simple AST variables to their current SSA representations	* block, plus the environment mapping Simple AST variables to their current SSA representations
50	* and the set of Simple AST variables that were assigned to in the block.	* and the set of Simple AST variables that were assigned to in the block.
51	*)	*)
52	fun cvtBlock (env, S.Block stms) = let	fun cvtBlock (env, S.Block stms, optExit) = let
53	fun toBlock (env, assigned, [], assignments) =	fun toBlock (env, assigned, [], assignments) = let
54	(IL.mkBLOCK{succ=IL.dummy, body=List.rev assignments}, env, assigned)	val stm = IL.Stmt.mkBLOCK(List.rev assignments, optExit)
55		in
56		(stm, IL.Stmt.tail stm, env, assigned)
57		end
58	| toBlock (env, assigned, S.S_Assign(x, e)::rest, assignments) = let	| toBlock (env, assigned, S.S_Assign(x, e)::rest, assignments) = let
59	val x' = newVar x	val x' = newVar x
60	val stms = cvtExp(env, x', e)	val stms = cvtExp(env, x', e)
#	Line 61	Line 64
64	toBlock (env, assigned, rest, stms@assignments)	toBlock (env, assigned, rest, stms@assignments)
65	end	end
66	| toBlock (env, assigned, stms, assignments) = let	| toBlock (env, assigned, stms, assignments) = let
67	val (succ, env, assigned) = toStmt (env, assigned, stms)	val (next, last, env, assigned) = toStmt (env, assigned, stms)
68	val blk = IL.mkBLOCK{succ=succ, body=List.rev assignments}	val blk = IL.Stmt.mkBLOCK(List.rev assignments, SOME next)
69		in
70		IL.Node.addEdge (IL.Stmt.tail blk, IL.Stmt.entry next);
71		(blk, last, env, assigned)
72		end
73		and toStmt (env, assigned, []) = let
74		(* this case only occurs for the empty else arm of an if-then-else statement *)
75		val stm = IL.Stmt.mkBLOCK([], optExit)
76	in	in
77	IL.addPred (succ, blk);	(stm, IL.Stmt.tail stm, env, assigned)
	(blk, env, assigned)
78	end	end
	and toStmt (env, assigned, []) =
	(IL.mkBLOCK{succ=IL.dummy, body=[]}, env, assigned)
79	| toStmt (env, assigned, stms as stm::rest) = (case stm	| toStmt (env, assigned, stms as stm::rest) = (case stm
80	of S.S_Assign _ => toBlock (env, assigned, stms, [])	of S.S_Assign _ => toBlock (env, assigned, stms, [])
81	| S.S_IfThenElse(x, b1, b2) => let	| S.S_IfThenElse(x, b1, b2) => let
82	val x' = lookup env x	val x' = lookup env x
83	val (s1, env1, assigned1) = cvtBlock(env, b1)	val (s1, last1, env1, assigned1) = cvtBlock(env, b1, NONE)
84	val (s2, env2, assigned2) = cvtBlock(env, b2)	val (s2, last2, env2, assigned2) = cvtBlock(env, b2, NONE)
85	val assigned = VSet.union(assigned1, assigned2)	val assigned = VSet.union(assigned1, assigned2)
86	(* PROBLEM: what about variables that are assigned for the first time in one branch	(* PROBLEM: what about variables that are assigned for the first time in one branch
87	* and not the other?  This situation should only occur for variables who's scope is	* and not the other?  This situation should only occur for variables who's scope is
#	Line 94	Line 101
101	in	in
102	VSet.foldl mkPhi (env, []) assigned	VSet.foldl mkPhi (env, []) assigned
103	end	end
	val stm = IL.mkIF{cond=x', thenBranch=s1, elseBranch=s2}
104	in	in
105	case rest	case rest
106	of [] => (stm, env, assigned)	of [] => let
107		val join = IL.Stmt.mkJOIN (phis, optExit)
108		val joinNd = IL.Stmt.entry join
109		val stm = IL.Stmt.mkIF(x', s1, s2, SOME join)
110		in
111		IL.Node.addEdge (last2, joinNd);
112		IL.Node.addEdge (last1, joinNd);
113		(stm, joinNd, env, assigned)
114		end
115	| _ => let	| _ => let
116	val (join, env, assigned) = toStmt (env, assigned, rest)	val (next, last, env, assigned) = toStmt (env, assigned, rest)
117	in	val join = IL.Stmt.mkJOIN (phis, SOME next)
118	IL.addPred (join, stm);	val joinNd = IL.Stmt.entry join
119	IL.setSucc (stm, join);	val stm = IL.Stmt.mkIF(x', s1, s2, SOME join)
120	(stm, env, assigned)	in
121		IL.Node.addEdge (last2, joinNd);
122		IL.Node.addEdge (last1, joinNd);
123		IL.Node.addEdge (joinNd, IL.Stmt.entry next);
124		(stm, last, env, assigned)
125	end	end
126	(* end case *)	(* end case *)
127	end	end
#	Line 111	Line 129
129	val xs' = List.map (lookup env) xs	val xs' = List.map (lookup env) xs
130	in	in
131	case rest	case rest
132	of [] => (IL.mkNEW{actor=name, args=xs', succ=IL.dummy}, env, assigned)	of [] => let
133		val stm = IL.Stmt.mkNEW(name, xs', optExit)
134		in
135		(stm, IL.Stmt.tail stm, env, assigned)
136		end
137	| _ => let	| _ => let
138	val (succ, env, assigned) = toStmt (env, assigned, rest)	val (next, last, env, assigned) = toStmt (env, assigned, rest)
139	val stm = IL.mkNEW{actor=name, args=xs', succ=succ}	val stm = IL.Stmt.mkNEW(name, xs', SOME next)
140		in
141		IL.Node.addEdge (IL.Stmt.tail stm, IL.Stmt.entry next);
142		(stm, last, env, assigned)
143		end
144		end
145		| S.S_Die => let
146		val stm = IL.Stmt.mkDIE()
147	in	in
148	IL.addPred (succ, stm);	(stm, IL.Stmt.tail stm, env, assigned)
	(stm, env, assigned)
149	end	end
150		| S.S_Stabilize => let
151		val stm = IL.Stmt.mkSTABILIZE()
152		in
153		(stm, IL.Stmt.tail stm, env, assigned)
154	end	end
	| S.S_Die => (IL.mkDIE(), env, assigned)
	| S.S_Stabilize => (IL.mkSTABILIZE(), env, assigned)
155	(* end case *))	(* end case *))
156	in	in
157	toStmt (env, VSet.empty, stms)	toStmt (env, VSet.empty, stms)
158	end	end
159
160		fun cvtTopLevelBlock (env, blk) = let
161		val exit = IL.Stmt.mkEXIT ()
162		val (stm, last, env, assigned) = cvtBlock (env, blk, SOME exit)
163		val entry = IL.Stmt.mkENTRY (SOME stm)
164		in
165		IL.Node.addEdge (IL.Stmt.tail entry, IL.Stmt.entry stm);
166		(* NOTE: this could fail if all control paths end in DIE or STABILIZE, so we
167		* wrap it in a handler
168		*)
169		IL.Node.addEdge (last, IL.Stmt.entry exit) handle _ => ();
170		(entry, env)
171		end
172
173		(* generate fresh SSA variables and add them to the environment *)
174		fun freshVars (env, xs) = let
175		fun cvtVar (x, (env, xs)) = let
176		val x' = newVar x
177		in
178		(VMap.insert(env, x, x'), x'::xs)
179		end
180		val (env, xs) = List.foldl cvtVar (env, []) xs
181		in
182		(env, List.rev xs)
183		end
184
185	fun translate (S.Program{globals, globalInit, actors}) = let	fun translate (S.Program{globals, globalInit, actors}) = let
186	val (globalInit, env, _) = cvtBlock (VMap.empty, globalInit)	val (globalInit, env) = cvtTopLevelBlock (VMap.empty, globalInit)
187	(* get the SSA names for the globals and a reduced environment *)	(* get the SSA names for the globals and a reduced environment that just defines
188		* the globals.
189		*)
190	val (env, globs) = let	val (env, globs) = let
191	val lookup = lookup env	val lookup = lookup env
192	fun cvtVar (x, (env, globs)) = let	fun cvtVar (x, (env, globs)) = let
#	Line 152	Line 209
209	in	in
210	(env, List.rev params)	(env, List.rev params)
211	end	end
212	val (stateInit, env, _) = cvtBlock (env, stateInit)	val (stateInit, env) = cvtTopLevelBlock (env, stateInit)
213	val state = List.map (lookup env) state	val state' = List.map (lookup env) state
214	fun cvtMethod (S.Method(name, blk)) = let	fun cvtMethod (S.Method(name, blk)) = let
215	val (body, _, _) = cvtBlock (env, blk)	(* allocate fresh variables for the state variables *)
216		val (env, stateIn) = freshVars (env, state)
217		val (body, env) = cvtTopLevelBlock (env, blk)
218		val stateOut = List.map (lookup env) state
219	in	in
220	IL.Method(name, body)	IL.Method{name=name, stateIn=stateIn, stateOut=stateOut, body=body}
221	end	end
222	in	in
223	IL.Actor{	IL.Actor{
224	name = name,	name = name,
225	params = params,	params = params,
226	state = state,	state = state',
227	stateInit = stateInit,	stateInit = stateInit,
228	methods = List.map cvtMethod methods	methods = List.map cvtMethod methods
229	}	}

---

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