Annotation of /trunk/src/compiler/translate/translate.sml

Parent Directory | Revision Log

---

Revision 511 - (view) (download)

1 :	jhr	137	(* translate.sml
2 :			*
3 :	jhr	435	* COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :	jhr	137	* All rights reserved.
5 :			*
6 :	jhr	176	* Translate Simple-AST code into the IL representation.
7 :	jhr	137	*)
8 :
9 :			structure Translate : sig
10 :
11 :	jhr	176	val translate : Simple.program -> HighIL.program
12 :	jhr	137
13 :			end = struct
14 :
15 :	jhr	176	structure S = Simple
16 :	jhr	394	structure Ty = Types
17 :	jhr	137	structure VMap = Var.Map
18 :	jhr	189	structure VSet = Var.Set
19 :	jhr	168	structure IL = HighIL
20 :	jhr	394	structure DstTy = HighILTypes
21 :	jhr	137
22 :	jhr	511	structure Census = CensusFn (IL)
23 :
24 :			type env = IL.var VMap.map
25 :
26 :	jhr	197	fun lookup env x = (case VMap.find (env, x)
27 :	jhr	176	of SOME x' => x'
28 :			| NONE => raise Fail(concat[
29 :	jhr	197	"no binding for ", Var.uniqueNameOf x, " in environment"
30 :	jhr	176	])
31 :			(* end case *))
32 :
33 :	jhr	394	fun cvtTy ty = (case TypeUtil.prune ty
34 :			of Ty.T_Bool => DstTy.BoolTy
35 :			| Ty.T_Int => DstTy.IntTy
36 :			| Ty.T_String => DstTy.StringTy
37 :			| Ty.T_Kernel _ => DstTy.KernelTy
38 :	jhr	426	| Ty.T_Tensor(Ty.Shape dd) => let
39 :			fun cvtDim (Ty.DimConst 1) = NONE
40 :			| cvtDim (Ty.DimConst d) = SOME d
41 :			in
42 :			DstTy.TensorTy(List.mapPartial cvtDim dd)
43 :			end
44 :	jhr	394	| Ty.T_Image _ => DstTy.ImageTy
45 :			| Ty.T_Field _ => DstTy.FieldTy
46 :			| ty => raise Fail("cvtTy: unexpected " ^ TypeUtil.toString ty)
47 :			(* end case *))
48 :
49 :	jhr	189	(* create a new instance of a variable *)
50 :	jhr	394	fun newVar x = IL.Var.new (Var.nameOf x, cvtTy(Var.monoTypeOf x))
51 :	jhr	189
52 :	jhr	168	(* expression translation *)
53 :	jhr	197	fun cvtExp (env, lhs, exp) = (case exp
54 :	jhr	188	of S.E_Var x => [(lhs, IL.VAR(lookup env x))]
55 :			| S.E_Lit lit => [(lhs, IL.LIT lit)]
56 :	jhr	176	| S.E_Tuple xs => raise Fail "E_Tuple not implemeted"
57 :	jhr	188	| S.E_Apply(f, tyArgs, args, ty) => let
58 :			val args' = List.map (lookup env) args
59 :			in
60 :			TranslateBasis.translate (lhs, f, tyArgs, args')
61 :			end
62 :			| S.E_Cons args => [(lhs, IL.CONS(List.map (lookup env) args))]
63 :	jhr	400	| S.E_Slice(x, indices, ty) => let
64 :			val x = lookup env x
65 :			val mask = List.map isSome indices
66 :			fun cvt NONE = NONE
67 :			| cvt (SOME x) = SOME(lookup env x)
68 :			val indices = List.mapPartial cvt indices
69 :			in
70 :			if List.all (fn b => b) mask
71 :			then [(lhs, IL.OP(HighOps.Subscript(IL.Var.ty x), x::indices))]
72 :			else [(lhs, IL.OP(HighOps.Slice(IL.Var.ty lhs, mask), x::indices))]
73 :			end
74 :	jhr	407	| S.E_Input(_, name, NONE) =>
75 :			[(lhs, IL.OP(HighOps.Input(IL.Var.ty lhs, name), []))]
76 :	jhr	229	| S.E_Input(_, name, SOME dflt) =>
77 :	jhr	407	[(lhs, IL.OP(HighOps.InputWithDefault(IL.Var.ty lhs, name), [lookup env dflt]))]
78 :	jhr	226	| S.E_Field fld => [(lhs, IL.OP(HighOps.Field fld, []))]
79 :			| S.E_LoadImage info => [(lhs, IL.OP(HighOps.LoadImage info, []))]
80 :	jhr	176	(* end case *))
81 :	jhr	168
82 :	jhr	192	(* convert a Simple AST block to an IL statement. We return the statement that represents the
83 :			* block, plus the environment mapping Simple AST variables to their current SSA representations
84 :			* and the set of Simple AST variables that were assigned to in the block.
85 :	jhr	189	*)
86 :	jhr	256	fun cvtBlock (env, S.Block stms, optExit) = let
87 :			fun toBlock (env, assigned, [], assignments) = let
88 :			val stm = IL.Stmt.mkBLOCK(List.rev assignments, optExit)
89 :			in
90 :			(stm, IL.Stmt.tail stm, env, assigned)
91 :			end
92 :	jhr	192	| toBlock (env, assigned, S.S_Assign(x, e)::rest, assignments) = let
93 :	jhr	189	val x' = newVar x
94 :			val stms = cvtExp(env, x', e)
95 :			val assigned = VSet.add(assigned, x)
96 :			val env = VMap.insert(env, x, x')
97 :			in
98 :	jhr	197	toBlock (env, assigned, rest, stms@assignments)
99 :	jhr	189	end
100 :	jhr	192	| toBlock (env, assigned, stms, assignments) = let
101 :	jhr	256	val (next, last, env, assigned) = toStmt (env, assigned, stms)
102 :			val blk = IL.Stmt.mkBLOCK(List.rev assignments, SOME next)
103 :	jhr	192	in
104 :	jhr	256	IL.Node.addEdge (IL.Stmt.tail blk, IL.Stmt.entry next);
105 :			(blk, last, env, assigned)
106 :	jhr	192	end
107 :	jhr	256	and toStmt (env, assigned, []) = let
108 :			(* this case only occurs for the empty else arm of an if-then-else statement *)
109 :			val stm = IL.Stmt.mkBLOCK([], optExit)
110 :			in
111 :			(stm, IL.Stmt.tail stm, env, assigned)
112 :			end
113 :	jhr	197	| toStmt (env, assigned, stms as stm::rest) = (case stm
114 :			of S.S_Assign _ => toBlock (env, assigned, stms, [])
115 :	jhr	192	| S.S_IfThenElse(x, b1, b2) => let
116 :			val x' = lookup env x
117 :	jhr	256	val (s1, last1, env1, assigned1) = cvtBlock(env, b1, NONE)
118 :			val (s2, last2, env2, assigned2) = cvtBlock(env, b2, NONE)
119 :	jhr	192	val assigned = VSet.union(assigned1, assigned2)
120 :	jhr	240	(* PROBLEM: what about variables that are assigned for the first time in one branch
121 :			* and not the other? This situation should only occur for variables who's scope is
122 :			* the branch of the if. Short-term solution is to ignore variables that are defined
123 :			* in only one branch.
124 :			*)
125 :	jhr	192	val (env, phis) = let
126 :	jhr	240	fun mkPhi (x, (env, phis)) = (
127 :			case (VMap.find(env1, x), VMap.find(env2, x))
128 :			of (SOME x1, SOME x2) => let
129 :			val x' = newVar x
130 :			in
131 :			(VMap.insert(env, x, x'), (x', [x1, x2])::phis)
132 :			end
133 :			| _ => (env, phis)
134 :			(* end case *))
135 :	jhr	190	in
136 :	jhr	192	VSet.foldl mkPhi (env, []) assigned
137 :	jhr	190	end
138 :			in
139 :	jhr	192	case rest
140 :	jhr	256	of [] => let
141 :			val join = IL.Stmt.mkJOIN (phis, optExit)
142 :			val joinNd = IL.Stmt.entry join
143 :			val stm = IL.Stmt.mkIF(x', s1, s2, SOME join)
144 :			in
145 :			IL.Node.addEdge (last2, joinNd);
146 :			IL.Node.addEdge (last1, joinNd);
147 :			(stm, joinNd, env, assigned)
148 :			end
149 :	jhr	192	| _ => let
150 :	jhr	256	val (next, last, env, assigned) = toStmt (env, assigned, rest)
151 :			val join = IL.Stmt.mkJOIN (phis, SOME next)
152 :			val joinNd = IL.Stmt.entry join
153 :			val stm = IL.Stmt.mkIF(x', s1, s2, SOME join)
154 :	jhr	192	in
155 :	jhr	256	IL.Node.addEdge (last2, joinNd);
156 :			IL.Node.addEdge (last1, joinNd);
157 :			IL.Node.addEdge (joinNd, IL.Stmt.entry next);
158 :			(stm, last, env, assigned)
159 :	jhr	192	end
160 :			(* end case *)
161 :	jhr	190	end
162 :	jhr	192	| S.S_New(name, xs) => let
163 :			val xs' = List.map (lookup env) xs
164 :			in
165 :			case rest
166 :	jhr	256	of [] => let
167 :			val stm = IL.Stmt.mkNEW(name, xs', optExit)
168 :			in
169 :			(stm, IL.Stmt.tail stm, env, assigned)
170 :			end
171 :	jhr	192	| _ => let
172 :	jhr	256	val (next, last, env, assigned) = toStmt (env, assigned, rest)
173 :			val stm = IL.Stmt.mkNEW(name, xs', SOME next)
174 :	jhr	192	in
175 :	jhr	256	IL.Node.addEdge (IL.Stmt.tail stm, IL.Stmt.entry next);
176 :			(stm, last, env, assigned)
177 :	jhr	192	end
178 :	jhr	194	end
179 :	jhr	256	| S.S_Die => let
180 :			val stm = IL.Stmt.mkDIE()
181 :			in
182 :			(stm, IL.Stmt.tail stm, env, assigned)
183 :			end
184 :			| S.S_Stabilize => let
185 :			val stm = IL.Stmt.mkSTABILIZE()
186 :			in
187 :			(stm, IL.Stmt.tail stm, env, assigned)
188 :			end
189 :	jhr	192	(* end case *))
190 :			in
191 :			toStmt (env, VSet.empty, stms)
192 :			end
193 :	jhr	168
194 :	jhr	256	fun cvtTopLevelBlock (env, blk) = let
195 :			val exit = IL.Stmt.mkEXIT ()
196 :			val (stm, last, env, assigned) = cvtBlock (env, blk, SOME exit)
197 :			val entry = IL.Stmt.mkENTRY (SOME stm)
198 :			in
199 :			IL.Node.addEdge (IL.Stmt.tail entry, IL.Stmt.entry stm);
200 :			(* NOTE: this could fail if all control paths end in DIE or STABILIZE, so we
201 :			* wrap it in a handler
202 :			*)
203 :			IL.Node.addEdge (last, IL.Stmt.entry exit) handle _ => ();
204 :			(entry, env)
205 :			end
206 :
207 :			(* generate fresh SSA variables and add them to the environment *)
208 :			fun freshVars (env, xs) = let
209 :			fun cvtVar (x, (env, xs)) = let
210 :			val x' = newVar x
211 :			in
212 :			(VMap.insert(env, x, x'), x'::xs)
213 :			end
214 :			val (env, xs) = List.foldl cvtVar (env, []) xs
215 :			in
216 :			(env, List.rev xs)
217 :			end
218 :
219 :	jhr	511	fun translate (S.Program{globals, globalInit, strands}) = let
220 :	jhr	256	val (globalInit, env) = cvtTopLevelBlock (VMap.empty, globalInit)
221 :			(* get the SSA names for the globals and a reduced environment that just defines
222 :			* the globals.
223 :			*)
224 :	jhr	200	val (env, globs) = let
225 :			val lookup = lookup env
226 :			fun cvtVar (x, (env, globs)) = let
227 :			val x' = lookup x
228 :			in
229 :			(VMap.insert(env, x, x'), x'::globs)
230 :			end
231 :			val (env, globs) = List.foldl cvtVar (VMap.empty, []) globals
232 :			in
233 :			(env, List.rev globs)
234 :			end
235 :	jhr	511	fun cvtStrand (S.Strand{name, params, state, stateInit, methods}) = let
236 :	jhr	200	val (env, params) = let
237 :			fun cvtParam (x, (env, xs)) = let
238 :			val x' = newVar x
239 :			in
240 :			(VMap.insert(env, x, x'), x'::xs)
241 :			end
242 :			val (env, params) = List.foldl cvtParam (env, []) params
243 :			in
244 :			(env, List.rev params)
245 :			end
246 :	jhr	256	val (stateInit, env) = cvtTopLevelBlock (env, stateInit)
247 :			val state' = List.map (lookup env) state
248 :	jhr	200	fun cvtMethod (S.Method(name, blk)) = let
249 :	jhr	256	(* allocate fresh variables for the state variables *)
250 :			val (env, stateIn) = freshVars (env, state)
251 :			val (body, env) = cvtTopLevelBlock (env, blk)
252 :			val stateOut = List.map (lookup env) state
253 :	jhr	200	in
254 :	jhr	256	IL.Method{name=name, stateIn=stateIn, stateOut=stateOut, body=body}
255 :	jhr	200	end
256 :			in
257 :	jhr	511	IL.Strand{
258 :	jhr	200	name = name,
259 :			params = params,
260 :	jhr	256	state = state',
261 :	jhr	200	stateInit = stateInit,
262 :			methods = List.map cvtMethod methods
263 :			}
264 :			end
265 :	jhr	511	val prog = IL.Program{
266 :	jhr	200	globals = globs,
267 :			globalInit = globalInit,
268 :	jhr	511	strands = List.map cvtStrand strands
269 :	jhr	200	}
270 :	jhr	511	in
271 :			Census.init prog;
272 :			prog
273 :	jhr	200	end
274 :	jhr	176
275 :	jhr	137	end

---

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