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

SCM Repository

[diderot] Annotation of /branches/pure-cfg/src/compiler/c-util/tree-to-c-fn.sml
ViewVC logotype

Annotation of /branches/pure-cfg/src/compiler/c-util/tree-to-c-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1285 - (view) (download)

1 : jhr 831 (* tree-to-c.sml
2 :     *
3 :     * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     * All rights reserved.
5 : jhr 919 *
6 :     * Translate TreeIL to the C version of CLang.
7 : jhr 831 *)
8 :    
9 : jhr 1285 signature TREE_VAR_TO_C =
10 :     sig
11 :     type env = CLang.typed_var TreeIL.Var.Map.map
12 :     (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)
13 :     val lvalueVar : env * TreeIL.var -> CLang.exp
14 :     (* translate a variable that occurs in a r-value context *)
15 :     val rvalueVar : env * TreeIL.var -> CLang.exp
16 :     end
17 : jhr 831
18 : jhr 1285 functor TreeToCFn (VarToC : TREE_VAR_TO_C) : sig
19 : jhr 831
20 : jhr 1285 type env = CLang.typed_var TreeIL.Var.Map.map
21 : jhr 840
22 : jhr 831 val trType : TreeIL.Ty.ty -> CLang.ty
23 : jhr 839
24 : jhr 831 val trBlock : env * (env * TreeIL.exp list * CLang.stm -> CLang.stm list) * TreeIL.block -> CLang.stm
25 :    
26 : jhr 1153 val trFragment : env * TreeIL.block -> env * CLang.stm list
27 :    
28 : jhr 839 val trAssign : env * TreeIL.var * TreeIL.exp -> CLang.stm list
29 :    
30 :     val trExp : env * TreeIL.exp -> CLang.exp
31 :    
32 : jhr 842 (* vector indexing support. Arguments are: vector, arity, index *)
33 :     val ivecIndex : CLang.exp * int * int -> CLang.exp
34 :     val vecIndex : CLang.exp * int * int -> CLang.exp
35 :    
36 : jhr 831 end = struct
37 :    
38 :     structure CL = CLang
39 : jhr 1283 structure N = CNames
40 : jhr 831 structure IL = TreeIL
41 :     structure Op = IL.Op
42 :     structure Ty = IL.Ty
43 :     structure V = IL.Var
44 :    
45 : jhr 1285 datatype var = datatype CLang.typed_var
46 :     type env = CLang.typed_var TreeIL.Var.Map.map
47 : jhr 831
48 :     fun lookup (env, x) = (case V.Map.find (env, x)
49 : jhr 840 of SOME(V(_, x')) => x'
50 : jhr 831 | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])
51 :     (* end case *))
52 :    
53 :     (* integer literal expression *)
54 :     fun intExp (i : int) = CL.mkInt(IntInf.fromInt i, CL.int32)
55 :    
56 :     (* translate TreeIL types to CLang types *)
57 :     fun trType ty = (case ty
58 :     of Ty.BoolTy => CLang.T_Named "bool"
59 :     | Ty.StringTy => CL.charPtr
60 : jhr 1262 | Ty.IVecTy 1 => !N.gIntTy
61 :     | Ty.IVecTy n => CL.T_Named(N.ivecTy n)
62 :     | Ty.TensorTy[] => !N.gRealTy
63 :     | Ty.TensorTy[n] => CL.T_Named(N.vecTy n)
64 :     | Ty.TensorTy[n, m] => CL.T_Named(N.matTy(n,m))
65 : jhr 1159 | Ty.AddrTy(ImageInfo.ImgInfo{ty=(_, rTy), ...}) => CL.T_Ptr(CL.T_Num rTy)
66 : jhr 1262 | Ty.ImageTy(ImageInfo.ImgInfo{dim, ...}) => CL.T_Ptr(CL.T_Named(N.imageTy dim))
67 : jhr 831 | _ => raise Fail(concat["TreeToC.trType(", Ty.toString ty, ")"])
68 :     (* end case *))
69 :    
70 :     (* generate new variables *)
71 :     local
72 :     val count = ref 0
73 :     fun freshName prefix = let
74 :     val n = !count
75 :     in
76 :     count := n+1;
77 :     concat[prefix, "_", Int.toString n]
78 :     end
79 :     in
80 :     fun tmpVar ty = freshName "tmp"
81 :     fun freshVar prefix = freshName prefix
82 :     end (* local *)
83 :    
84 :     (* translate IL basis functions *)
85 :     local
86 :     fun mkLookup suffix = let
87 :     val tbl = ILBasis.Tbl.mkTable (16, Fail "basis table")
88 :     fun ins f = ILBasis.Tbl.insert tbl (f, ILBasis.toString f ^ suffix)
89 :     in
90 :     List.app ins ILBasis.allFuns;
91 :     ILBasis.Tbl.lookup tbl
92 :     end
93 :     val fLookup = mkLookup "f"
94 :     val dLookup = mkLookup ""
95 :     in
96 :     fun trApply (f, args) = let
97 : jhr 1262 val f' = if !N.doublePrecision then dLookup f else fLookup f
98 : jhr 831 in
99 :     CL.mkApply(f', args)
100 :     end
101 :     end (* local *)
102 :    
103 : jhr 842 (* vector indexing support. Arguments are: vector, arity, index *)
104 :     fun ivecIndex (v, n, ix) = let
105 : jhr 1262 val unionTy = CL.T_Named(concat["union", Int.toString n, !N.gIntSuffix, "_t"])
106 : jhr 842 val e1 = CL.mkCast(unionTy, v)
107 :     val e2 = CL.mkSelect(e1, "i")
108 :     in
109 :     CL.mkSubscript(e2, intExp ix)
110 :     end
111 :    
112 :     fun vecIndex (v, n, ix) = let
113 : jhr 1262 val unionTy = CL.T_Named(concat["union", Int.toString n, !N.gRealSuffix, "_t"])
114 : jhr 842 val e1 = CL.mkCast(unionTy, v)
115 :     val e2 = CL.mkSelect(e1, "r")
116 :     in
117 :     CL.mkSubscript(e2, intExp ix)
118 :     end
119 :    
120 : jhr 831 (* Translate a TreeIL operator application to a CLang expression *)
121 :     fun trOp (rator, args) = (case (rator, args)
122 :     of (Op.Add ty, [a, b]) =>
123 :     CL.mkBinOp(a, CL.#+, b)
124 :     | (Op.Sub ty, [a, b]) =>
125 :     CL.mkBinOp(a, CL.#-, b)
126 :     | (Op.Mul ty, [a, b]) =>
127 :     CL.mkBinOp(a, CL.#*, b)
128 :     | (Op.Div ty, [a, b]) =>
129 :     CL.mkBinOp(a, CL.#/, b)
130 :     | (Op.Neg ty, [a]) =>
131 :     CL.mkUnOp(CL.%-, a)
132 :     | (Op.Abs(Ty.IVecTy 1), args) =>
133 :     CL.mkApply("abs", args)
134 :     | (Op.Abs(Ty.TensorTy[]), args) =>
135 : jhr 1262 CL.mkApply(N.fabs(), args)
136 : jhr 831 | (Op.Abs ty, [a]) =>
137 :     raise Fail(concat["Abs<", Ty.toString ty, ">"])
138 :     | (Op.LT ty, [a, b]) =>
139 :     CL.mkBinOp(a, CL.#<, b)
140 :     | (Op.LTE ty, [a, b]) =>
141 :     CL.mkBinOp(a, CL.#<=, b)
142 :     | (Op.EQ ty, [a, b]) =>
143 :     CL.mkBinOp(a, CL.#==, b)
144 :     | (Op.NEQ ty, [a, b]) =>
145 :     CL.mkBinOp(a, CL.#!=, b)
146 :     | (Op.GTE ty, [a, b]) =>
147 :     CL.mkBinOp(a, CL.#>=, b)
148 :     | (Op.GT ty, [a, b]) =>
149 :     CL.mkBinOp(a, CL.#>, b)
150 :     | (Op.Not, [a]) =>
151 :     CL.mkUnOp(CL.%!, a)
152 :     | (Op.Max, args) =>
153 : jhr 1262 CL.mkApply(N.max(), args)
154 : jhr 831 | (Op.Min, args) =>
155 : jhr 1262 CL.mkApply(N.min(), args)
156 : jhr 831 | (Op.Lerp ty, args) => (case ty
157 : jhr 1262 of Ty.TensorTy[] => CL.mkApply(N.lerp 1, args)
158 :     | Ty.TensorTy[n] => CL.mkApply(N.lerp n, args)
159 : jhr 831 | _ => raise Fail(concat[
160 :     "lerp<", Ty.toString ty, "> not supported"
161 :     ])
162 :     (* end case *))
163 :     | (Op.Dot d, args) =>
164 : jhr 1262 CL.E_Apply(N.dot d, args)
165 : jhr 831 | (Op.MulVecMat(m, n), args) =>
166 :     if (1 < m) andalso (m < 4) andalso (m = n)
167 : jhr 1262 then CL.E_Apply(N.mulVecMat(m,n), args)
168 : jhr 831 else raise Fail "unsupported vector-matrix multiply"
169 :     | (Op.MulMatVec(m, n), args) =>
170 :     if (1 < m) andalso (m < 4) andalso (m = n)
171 : jhr 1262 then CL.E_Apply(N.mulMatVec(m,n), args)
172 : jhr 831 else raise Fail "unsupported matrix-vector multiply"
173 :     | (Op.MulMatMat(m, n, p), args) =>
174 :     if (1 < m) andalso (m < 4) andalso (m = n) andalso (n = p)
175 : jhr 1262 then CL.E_Apply(N.mulMatMat(m,n,p), args)
176 : jhr 831 else raise Fail "unsupported matrix-matrix multiply"
177 :     | (Op.Cross, args) =>
178 : jhr 1262 CL.E_Apply(N.cross(), args)
179 : jhr 842 | (Op.Select(Ty.IVecTy n, i), [a]) =>
180 :     ivecIndex (a, n, i)
181 :     | (Op.Select(Ty.TensorTy[n], i), [a]) =>
182 :     vecIndex (a, n, i)
183 : jhr 831 | (Op.Norm(Ty.TensorTy[n]), args) =>
184 : jhr 1262 CL.E_Apply(N.length n, args)
185 : jhr 845 | (Op.Norm(Ty.TensorTy[m,n]), args) =>
186 : jhr 1262 CL.E_Apply(N.norm(m,n), args)
187 : jhr 831 | (Op.Normalize d, args) =>
188 : jhr 1262 CL.E_Apply(N.normalize d, args)
189 : jhr 831 | (Op.Trace n, args) =>
190 : jhr 1262 CL.E_Apply(N.trace n, args)
191 : jhr 831 | (Op.Scale(Ty.TensorTy[n]), args) =>
192 : jhr 1262 CL.E_Apply(N.scale n, args)
193 : jhr 831 | (Op.CL, _) =>
194 :     raise Fail "CL unimplemented"
195 :     | (Op.PrincipleEvec ty, _) =>
196 :     raise Fail "PrincipleEvec unimplemented"
197 :     | (Op.Subscript(Ty.IVecTy n), [v, ix]) => let
198 : jhr 1262 val unionTy = CL.T_Named(concat["union", Int.toString n, !N.gIntSuffix, "_t"])
199 : jhr 831 val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "i")
200 :     in
201 :     CL.mkSubscript(vecExp, ix)
202 :     end
203 :     | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let
204 : jhr 1262 val unionTy = CL.T_Named(concat["union", Int.toString n, !N.gRealSuffix, "_t"])
205 : jhr 831 val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "r")
206 :     in
207 :     CL.mkSubscript(vecExp, ix)
208 :     end
209 :     | (Op.Subscript(Ty.TensorTy[_,_]), [m, ix, jx]) =>
210 :     CL.mkSubscript(CL.mkSelect(CL.mkSubscript(m, ix), "r"), jx)
211 :     | (Op.Subscript ty, t::(ixs as _::_)) =>
212 :     raise Fail(concat["Subscript<", Ty.toString ty, "> unsupported"])
213 :     | (Op.Ceiling d, args) =>
214 : jhr 1262 CL.mkApply(N.addTySuffix("ceil", d), args)
215 : jhr 831 | (Op.Floor d, args) =>
216 : jhr 1262 CL.mkApply(N.addTySuffix("floor", d), args)
217 : jhr 831 | (Op.Round d, args) =>
218 : jhr 1262 CL.mkApply(N.addTySuffix("round", d), args)
219 : jhr 831 | (Op.Trunc d, args) =>
220 : jhr 1262 CL.mkApply(N.addTySuffix("trunc", d), args)
221 : jhr 831 | (Op.IntToReal, [a]) =>
222 : jhr 1262 CL.mkCast(!N.gRealTy, a)
223 : jhr 831 | (Op.RealToInt 1, [a]) =>
224 : jhr 1262 CL.mkCast(!N.gIntTy, a)
225 : jhr 831 | (Op.RealToInt d, args) =>
226 : jhr 1262 CL.mkApply(N.vecftoi d, args)
227 : jhr 831 (* FIXME: need type info *)
228 :     | (Op.ImageAddress(ImageInfo.ImgInfo{ty=(_,rTy), ...}), [a]) => let
229 :     val cTy = CL.T_Ptr(CL.T_Num rTy)
230 :     in
231 :     CL.mkCast(cTy, CL.mkIndirect(a, "data"))
232 :     end
233 : jhr 863 | (Op.LoadVoxels(info, 1), [a]) => let
234 : jhr 1262 val realTy as CL.T_Num rTy = !N.gRealTy
235 : jhr 831 val a = CL.E_UnOp(CL.%*, a)
236 :     in
237 : jhr 863 if (rTy = ImageInfo.sampleTy info)
238 : jhr 831 then a
239 :     else CL.E_Cast(realTy, a)
240 :     end
241 :     | (Op.LoadVoxels _, [a]) =>
242 : jhr 843 raise Fail("impossible " ^ Op.toString rator)
243 : jhr 831 | (Op.PosToImgSpace(ImageInfo.ImgInfo{dim, ...}), [img, pos]) =>
244 : jhr 1262 CL.mkApply(N.toImageSpace dim, [img, pos])
245 : jhr 983 | (Op.TensorToWorldSpace(info, ty), [v, x]) =>
246 : jhr 1262 CL.mkApply(N.toWorldSpace ty, [v, x])
247 : jhr 831 | (Op.LoadImage info, [a]) =>
248 : jhr 843 raise Fail("impossible " ^ Op.toString rator)
249 : jhr 831 | (Op.Inside(ImageInfo.ImgInfo{dim, ...}, s), [pos, img]) =>
250 : jhr 1262 CL.mkApply(N.inside dim, [pos, img, intExp s])
251 : jhr 1250 | (Op.Input(ty, desc, name), []) =>
252 : jhr 843 raise Fail("impossible " ^ Op.toString rator)
253 : jhr 1250 | (Op.InputWithDefault(ty, desc, name), [a]) =>
254 : jhr 843 raise Fail("impossible " ^ Op.toString rator)
255 : jhr 831 | _ => raise Fail(concat[
256 :     "unknown or incorrect operator ", Op.toString rator
257 :     ])
258 :     (* end case *))
259 :    
260 :     fun trExp (env, e) = (case e
261 : jhr 1285 of IL.E_Var x => VarToC.rvalueVar (env, x)
262 : jhr 1262 | IL.E_Lit(Literal.Int n) => CL.mkInt(n, !N.gIntTy)
263 : jhr 831 | IL.E_Lit(Literal.Bool b) => CL.mkBool b
264 : jhr 1262 | IL.E_Lit(Literal.Float f) => CL.mkFlt(f, !N.gRealTy)
265 : jhr 831 | IL.E_Lit(Literal.String s) => CL.mkStr s
266 :     | IL.E_Op(rator, args) => trOp (rator, trExps(env, args))
267 :     | IL.E_Apply(f, args) => trApply(f, trExps(env, args))
268 : jhr 1262 | IL.E_Cons(Ty.TensorTy[n], args) => CL.mkApply(N.mkVec n, trExps(env, args))
269 : jhr 833 | IL.E_Cons(ty, _) => raise Fail(concat["E_Cons(", Ty.toString ty, ", _) in expression"])
270 : jhr 831 (* end case *))
271 :    
272 :     and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps
273 :    
274 :     fun trAssign (env, lhs, rhs) = let
275 : jhr 1285 val lhs = VarToC.lvalueVar (env, lhs)
276 : jhr 831 in
277 :     (* certain rhs forms, such as those that return a matrix,
278 :     * require a function call instead of an assignment
279 :     *)
280 :     case rhs
281 : jhr 834 of IL.E_Op(Op.Add(Ty.TensorTy[m,n]), args) =>
282 : jhr 1262 [CL.mkCall(N.addMat(m,n), lhs :: trExps(env, args))]
283 : jhr 834 | IL.E_Op(Op.Sub(Ty.TensorTy[m,n]), args) =>
284 : jhr 1262 [CL.mkCall(N.subMat(m,n), lhs :: trExps(env, args))]
285 : jhr 896 | IL.E_Op(Op.Neg(Ty.TensorTy[m,n]), args) =>
286 : jhr 1262 [CL.mkCall(N.scaleMat(m,n), lhs :: intExp ~1 :: trExps(env, args))]
287 : jhr 834 | IL.E_Op(Op.Scale(Ty.TensorTy[m,n]), args) =>
288 : jhr 1262 [CL.mkCall(N.scaleMat(m,n), lhs :: trExps(env, args))]
289 : jhr 834 | IL.E_Op(Op.MulMatMat(m,n,p), args) =>
290 : jhr 1262 [CL.mkCall(N.mulMatMat(m,n,p), lhs :: trExps(env, args))]
291 : jhr 844 | IL.E_Op(Op.Identity n, args) =>
292 : jhr 1262 [CL.mkCall(N.identityMat n, [lhs])]
293 : jhr 983 | IL.E_Op(Op.Zero(Ty.TensorTy[m,n]), args) =>
294 : jhr 1262 [CL.mkCall(N.zeroMat(m,n), [lhs])]
295 : jhr 993 | IL.E_Op(Op.TensorToWorldSpace(info, ty as Ty.TensorTy[_,_]), args) =>
296 : jhr 1262 [CL.mkCall(N.toWorldSpace ty, lhs :: trExps(env, args))]
297 : jhr 863 | IL.E_Op(Op.LoadVoxels(info, n), [a]) =>
298 : jhr 843 if (n > 1)
299 :     then let
300 : jhr 863 val stride = ImageInfo.stride info
301 :     val rTy = ImageInfo.sampleTy info
302 : jhr 843 val vp = freshVar "vp"
303 : jhr 1262 val needsCast = (CL.T_Num rTy <> !N.gRealTy)
304 : jhr 843 fun mkLoad i = let
305 : jhr 863 val e = CL.mkSubscript(CL.mkVar vp, intExp(i*stride))
306 : jhr 843 in
307 : jhr 1262 if needsCast then CL.mkCast(!N.gRealTy, e) else e
308 : jhr 843 end
309 :     in [
310 :     CL.mkDecl(CL.T_Ptr(CL.T_Num rTy), vp, SOME(CL.I_Exp(trExp(env, a)))),
311 :     CL.mkAssign(lhs,
312 : jhr 1262 CL.mkApply(N.mkVec n, List.tabulate (n, mkLoad)))
313 : jhr 843 ] end
314 :     else [CL.mkAssign(lhs, trExp(env, rhs))]
315 : jhr 831 | IL.E_Cons(Ty.TensorTy[n,m], args) => let
316 :     (* matrices are represented as arrays of union<d><ty>_t vectors *)
317 :     fun doRows (_, []) = []
318 :     | doRows (i, e::es) =
319 :     CL.mkAssign(CL.mkSelect(CL.mkSubscript(lhs, intExp i), "v"), e)
320 :     :: doRows (i+1, es)
321 :     in
322 :     doRows (0, trExps(env, args))
323 :     end
324 :     | IL.E_Var x => (case IL.Var.ty x
325 : jhr 1285 of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, VarToC.rvalueVar(env, x)])]
326 :     | _ => [CL.mkAssign(lhs, VarToC.rvalueVar(env, x))]
327 : jhr 831 (* end case *))
328 :     | _ => [CL.mkAssign(lhs, trExp(env, rhs))]
329 :     (* end case *)
330 :     end
331 :    
332 : jhr 1153 fun trLocals (env : env, locals) =
333 :     List.foldl
334 :     (fn (x, env) => V.Map.insert(env, x, V(trType(V.ty x), V.name x)))
335 :     env locals
336 :    
337 :     (* generate code to check the status of runtime-system calls *)
338 :     fun checkSts mkDecl = let
339 :     val sts = freshVar "sts"
340 :     in
341 :     mkDecl sts @
342 :     [CL.mkIfThen(
343 :     CL.mkBinOp(CL.mkVar "DIDEROT_OK", CL.#!=, CL.mkVar sts),
344 :     CL.mkCall("exit", [intExp 1]))]
345 :     end
346 :    
347 :     fun trStms (env, saveState, stms) = let
348 : jhr 831 fun trStmt (env, stm) = (case stm
349 :     of IL.S_Comment text => [CL.mkComment text]
350 :     | IL.S_Assign(x, exp) => trAssign (env, x, exp)
351 :     | IL.S_IfThen(cond, thenBlk) =>
352 : jhr 1153 [CL.mkIfThen(trExp(env, cond), trBlk(env, saveState, thenBlk))]
353 : jhr 831 | IL.S_IfThenElse(cond, thenBlk, elseBlk) =>
354 :     [CL.mkIfThenElse(trExp(env, cond),
355 : jhr 1153 trBlk(env, saveState, thenBlk),
356 :     trBlk(env, saveState, elseBlk))]
357 : jhr 1128 | IL.S_New _ => raise Fail "new not supported yet" (* FIXME *)
358 : jhr 831 | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let
359 :     val lhs = lookup(env, lhs)
360 :     val name = trExp(env, name)
361 : jhr 1262 val imgTy = CL.T_Named(N.imageTy dim)
362 :     val loadFn = N.loadImage dim
363 : jhr 831 in [
364 :     CL.mkDecl(
365 : jhr 1262 CL.T_Named N.statusTy, sts,
366 : jhr 831 SOME(CL.I_Exp(CL.E_Apply(loadFn, [name, CL.mkUnOp(CL.%&, CL.E_Var lhs)]))))
367 :     ] end)
368 : jhr 1262 | IL.S_Input(lhs, name, desc, optDflt) => let
369 :     val inputFn = N.input(V.ty lhs)
370 : jhr 831 val lhs = lookup(env, lhs)
371 :     val lhs = CL.E_Var lhs
372 :     val (initCode, hasDflt) = (case optDflt
373 :     of SOME e => ([CL.mkAssign(lhs, trExp(env, e))], true)
374 :     | NONE => ([], false)
375 :     (* end case *))
376 : jhr 1262 val code = [CL.mkCall(inputFn, [
377 :     CL.mkVar "opts",
378 :     CL.mkStr name,
379 :     CL.mkStr desc,
380 :     CL.mkUnOp(CL.%&, lhs),
381 :     CL.mkBool hasDflt])]
382 : jhr 831 in
383 :     initCode @ code
384 : jhr 1262 end
385 : jhr 1044 | IL.S_Exit args =>
386 :     saveState (env, args, CL.mkReturn NONE)
387 : jhr 831 | IL.S_Active args =>
388 : jhr 1262 saveState (env, args, CL.mkReturn(SOME(CL.mkVar N.kActive)))
389 : jhr 831 | IL.S_Stabilize args =>
390 : jhr 1262 saveState (env, args, CL.mkReturn(SOME(CL.mkVar N.kStabilize)))
391 :     | IL.S_Die => [CL.mkReturn(SOME(CL.mkVar N.kDie))]
392 : jhr 831 (* end case *))
393 :     in
394 : jhr 1153 List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] stms
395 : jhr 831 end
396 :    
397 : jhr 1153 and trBlk (env, saveState, IL.Block{locals, body}) = let
398 :     val env = trLocals (env, locals)
399 :     val stms = trStms (env, saveState, body)
400 :     fun mkDecl (x, stms) = (case V.Map.find (env, x)
401 :     of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
402 :     | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
403 :     (* end case *))
404 :     val stms = List.foldr mkDecl stms locals
405 :     in
406 :     CL.mkBlock stms
407 :     end
408 :    
409 :     fun trFragment (env, IL.Block{locals, body}) = let
410 :     val env = trLocals (env, locals)
411 :     val stms = trStms (env, fn _ => raise Fail "exit in fragment", body)
412 :     fun mkDecl (x, stms) = (case V.Map.find (env, x)
413 :     of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
414 :     | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
415 :     (* end case *))
416 :     val stms = List.foldr mkDecl stms locals
417 :     in
418 :     (env, stms)
419 :     end
420 :    
421 :     val trBlock = trBlk
422 :    
423 : jhr 831 end

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