Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /trunk/src/compiler/translate/translate.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log 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