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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3706 - (view) (download)

1 : jhr 1640 (* tree-to-c.sml
2 : jhr 3060 *
3 : jhr 3349 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2015 The University of Chicago
6 : jhr 1640 * All rights reserved.
7 :     *
8 :     * Translate TreeIL to the C version of CLang.
9 :     *)
10 :    
11 :     signature TREE_VAR_TO_C =
12 :     sig
13 :     type env = CLang.typed_var TreeIL.Var.Map.map
14 :     (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)
15 :     val lvalueVar : env * TreeIL.var -> CLang.exp
16 :     (* translate a variable that occurs in a r-value context *)
17 :     val rvalueVar : env * TreeIL.var -> CLang.exp
18 :     (* translate a strand state variable that occurs in an l-value context *)
19 :     val lvalueStateVar : TreeIL.state_var -> CLang.exp
20 :     (* translate a strand state variable that occurs in a r-value context *)
21 :     val rvalueStateVar : TreeIL.state_var -> CLang.exp
22 :     end
23 :    
24 :     functor TreeToCFn (VarToC : TREE_VAR_TO_C) : sig
25 :    
26 :     type env = CLang.typed_var TreeIL.Var.Map.map
27 :    
28 :     val trType : TreeIL.Ty.ty -> CLang.ty
29 : cchiw 3706
30 :     val tyTransform : TreeIL.Ty.ty -> CLang.ty
31 : jhr 1640
32 : jhr 3060 val trBlock : env * TreeIL.block * (int -> bool) -> CLang.stm
33 : jhr 1640
34 : jhr 3060 val trFragment : env * TreeIL.block * (int -> bool) -> env * CLang.stm list
35 : cchiw 2668
36 : jhr 1640 val trExp : env * TreeIL.exp -> CLang.exp
37 : jhr 3060
38 : jhr 1640 (* vector indexing support. Arguments are: vector, arity, index *)
39 :     val ivecIndex : CLang.exp * int * int -> CLang.exp
40 :     val vecIndex : CLang.exp * int * int -> CLang.exp
41 : cchiw 3700 val prntArr1 : CLang.exp * int -> CLang.exp
42 : jhr 1640
43 :     end = struct
44 :    
45 :     structure CL = CLang
46 :     structure N = CNames
47 :     structure IL = TreeIL
48 :     structure Op = IL.Op
49 :     structure Ty = IL.Ty
50 :     structure V = IL.Var
51 : cchiw 2789 structure StV = IL.StateVar
52 : cchiw 2664
53 : jhr 1640 datatype var = datatype CLang.typed_var
54 :     type env = CLang.typed_var TreeIL.Var.Map.map
55 : cchiw 3699
56 : jhr 1640 fun lookup (env, x) = (case V.Map.find (env, x)
57 :     of SOME(V(_, x')) => x'
58 :     | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])
59 :     (* end case *))
60 :    
61 :     (* integer literal expression *)
62 :     fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)
63 :    
64 : jhr 1923 fun addrOf e = CL.mkUnOp(CL.%&, e)
65 : jhr 3060
66 : jhr 1640 (* translate TreeIL types to CLang types *)
67 : cchiw 3700
68 :     fun trType ty =
69 :     (case ty
70 :     of Ty.BoolTy => CLang.T_Named "bool"
71 : jhr 1640 | Ty.StringTy => CL.charPtr
72 :     | Ty.IntTy => !N.gIntTy
73 :     | Ty.TensorTy[] => !N.gRealTy
74 : jhr 3155 | Ty.TensorTy t => CL.mkRealArr(N.tprog ,t)
75 : jhr 1640 | Ty.SeqTy(Ty.IntTy, n) => CL.T_Named(N.ivecTy n)
76 : cchiw 3190 | Ty.SeqTy(ty, n) => let
77 : cchiw 3194 in CL.T_Array(trType ty, SOME n)
78 : cchiw 3190 end
79 : jhr 3155 | Ty.AddrTy info => CL.T_Ptr(CL.T_Num(ImageInfo.sampleTy info))
80 :     | Ty.ImageTy info => CL.T_Ptr(CL.T_Named(N.imageTy(ImageInfo.dim info)))
81 : cchiw 3700 | _ => raise Fail(concat["TreeToC.trType(", Ty.toString ty, ")"])
82 : jhr 1640 (* end case *))
83 : cchiw 3444
84 : cchiw 3700 fun tyTransform ty =
85 :     (case ty
86 :     of Ty.TensorTy[2] => CLang.T_Named(N.LocalTy [2])
87 :     | Ty.TensorTy[3] => CLang.T_Named(N.LocalTy [3])
88 :     | Ty.TensorTy[4] => CLang.T_Named(N.LocalTy [4])
89 : cchiw 3706 | _ => trType ty
90 : cchiw 3700 (* end case *))
91 : cchiw 3444
92 :     (*creates global var if it's not a vector type*)
93 : cchiw 2789 fun localType(ty,isVecTy) = (case ty
94 : cchiw 3700 of Ty.TensorTy[]=> !N.gRealTy
95 : jhr 3155 | Ty.TensorTy[1]=> !N.gRealTy
96 : cchiw 3700 (*
97 : jhr 3155 | Ty.TensorTy [3]=>CLang.T_Named(N.LocalTy [4])
98 : cchiw 3700 *)
99 :     | Ty.TensorTy[2] => CLang.T_Named(N.LocalTy [2])
100 :     | Ty.TensorTy[3] => CLang.T_Named(N.LocalTy [3])
101 :     | Ty.TensorTy[4] => CLang.T_Named(N.LocalTy [4])
102 :    
103 :    
104 : jhr 3155 | Ty.TensorTy [t] =>(case (isVecTy t)
105 :     of true => CLang.T_Named(N.LocalTy [t])
106 :     | _ => trType ty
107 :     (* end case *))
108 : cchiw 3192 | Ty.SeqTy(Ty.TensorTy[3], 3) => let (*added for evecs 3x3*)
109 : cchiw 3700 in
110 :     CL.T_Array(CLang.T_Named(N.LocalTy [4]), SOME 4)
111 : cchiw 3192 end
112 :     | Ty.SeqTy(Ty.TensorTy[2], 2) => let (*added for evecs 2x2*)
113 : cchiw 3194 in
114 :     CL.T_Array(CLang.T_Named(N.LocalTy [2]), SOME 2)
115 : cchiw 3192 end
116 : cchiw 2789 | _ => trType ty
117 : jhr 3155 (* end case *))
118 : cchiw 2668
119 : jhr 1640 (* generate new variables *)
120 :     local
121 :     val count = ref 0
122 :     fun freshName prefix = let
123 :     val n = !count
124 :     in
125 :     count := n+1;
126 :     concat[prefix, "_", Int.toString n]
127 :     end
128 :     in
129 :     fun tmpVar ty = freshName "tmp"
130 :     fun freshVar prefix = freshName prefix
131 :     end (* local *)
132 :    
133 :     (* translate IL basis functions *)
134 :     local
135 :     fun mkLookup suffix = let
136 : jhr 1923 val tbl = MathFuns.Tbl.mkTable (16, Fail "basis table")
137 :     fun ins f = MathFuns.Tbl.insert tbl (f, MathFuns.toString f ^ suffix)
138 : jhr 1640 in
139 : jhr 1923 List.app ins MathFuns.allFuns;
140 :     MathFuns.Tbl.lookup tbl
141 : jhr 1640 end
142 :     val fLookup = mkLookup "f"
143 :     val dLookup = mkLookup ""
144 :     in
145 :     fun trApply (f, args) = let
146 :     val f' = if !N.doublePrecision then dLookup f else fLookup f
147 :     in
148 :     CL.mkApply(f', args)
149 :     end
150 :     end (* local *)
151 :    
152 :     (* vector indexing support. Arguments are: vector, arity, index *)
153 :     fun ivecIndex (v, n, ix) = let
154 : cchiw 2830 val unionTy = CL.T_Named(concat["Diderot_",!N.gIntSuffix,"union", Int.toString n, "_t"])
155 : jhr 1640 val e1 = CL.mkCast(unionTy, v)
156 :     val e2 = CL.mkSelect(e1, "i")
157 :     in
158 :     CL.mkSubscript(e2, intExp ix)
159 :     end
160 :    
161 :     fun vecIndex (v, n, ix) = let
162 : cchiw 2795 val unionTy = CL.T_Named(concat["Diderot_union", Int.toString n(*, !N.gRealSuffix*), "_t"])
163 : jhr 1640 val e1 = CL.mkCast(unionTy, v)
164 :     val e2 = CL.mkSelect(e1, "r")
165 :     in
166 :     CL.mkSubscript(e2, intExp ix)
167 :     end
168 :    
169 : cchiw 2668 (*prnt arrays *)
170 : cchiw 3700 fun prntArr1(v,ix)= CL.mkSubscript(v, intExp ix)
171 : cchiw 2845 fun prntArr2(v,ix)= CL.mkSubscript(v,CL.mkInt ix)
172 : cchiw 2671
173 : cchiw 2668
174 : cchiw 2845 (* matrix indexing *)
175 :     fun matIndex (m, ix, jx) = CL.mkSubscript(CL.mkSubscript(m, ix), jx)
176 : cchiw 3699 (*
177 : cchiw 2845 fun dumpStore ([])=[]
178 :     | dumpStore (IL.E_Mux(_,_,_,_,ops)::es)=ops@dumpStore es
179 :     | dumpStore (e1::es)=[e1] @dumpStore es
180 : cchiw 3699 *)
181 :     fun dumpStore args =args
182 : cchiw 2845
183 : cchiw 3544 (*Indextensor:TreeIL.OP(bool*indexTy*ty))*TreeIL.Var->CL
184 : cchiw 2844 *isLocalVar, IndexTy, ArgTy
185 :     *decides if there needs to be a cast
186 :     *)
187 :     fun indexTensor e=(case e
188 : cchiw 3544 of (Op.IndexTensor(true, [0],Ty.TensorTy[1]),[a])=> a
189 :     | (Op.IndexTensor(true, [i],Ty.TensorTy[n]),[a])=> vecIndex (a,n,i) (*Index Local Vector*)(*Same as Op.Index _ *)
190 :     | (Op.IndexTensor(_, [i],Ty.SeqTy (_,n)),[a])=> ivecIndex (a,n,i) (*Same as Op.Index _ *)
191 : cchiw 3700 | (Op.IndexTensor(false, [i],Ty.TensorTy[_]),[a])=>prntArr1(a,i) (*Index Global Vector *)
192 :     | (Op.IndexTensor(_,[i,j] ,Ty.TensorTy[_,m]),[a])=>prntArr1(a,m*i+j)
193 :     | (Op.IndexTensor(_,[i,j,k] ,Ty.TensorTy[_,m,n]),[a])=>prntArr1(a,(m*i*n)+n*j+k)
194 :     | (Op.IndexTensor(_,[i,j,k,l] ,Ty.TensorTy[_,m,n,p]),[a])=>prntArr1(a,(m*i*n*p)+(n*j*p)+(p*k)+l)
195 : cchiw 2845 | (rator,_) => raise Fail(concat[
196 :     "--unknown how to index tensor", Op.toString rator
197 :     ])
198 :     (*end case*))
199 : cchiw 2844
200 : jhr 1640 (* Translate a TreeIL operator application to a CLang expression *)
201 :     fun trOp (rator, args) = (case (rator, args)
202 : cchiw 2525 of (Op.IAdd , [a, b]) => CL.mkBinOp(a, CL.#+, b)
203 :     | (Op.ISub , [a, b]) => CL.mkBinOp(a, CL.#-, b)
204 :     | (Op.IMul , [a, b]) => CL.mkBinOp(a, CL.#*, b)
205 :     | (Op.IDiv , [a, b]) => CL.mkBinOp(a, CL.#/, b)
206 :     | (Op.INeg , [a]) => CL.mkUnOp(CL.%-, a)
207 : cchiw 2620 | (Op.addSca,[a,b]) => CL.mkBinOp(a, CL.#+, b)
208 :     | (Op.subSca, [a, b]) => CL.mkBinOp(a, CL.#-, b)
209 :     | (Op.prodSca, [a, b]) => CL.mkBinOp(a, CL.#*, b)
210 : cchiw 2870 | (Op.divSca, [a, b]) => CL.mkBinOp(a, CL.#/,b)
211 :     (* CL.mkBinOp(CL.mkCast(!N.gRealTy,a), CL.#/,CL.mkCast(!N.gRealTy,b))*)
212 : cchiw 2827 | (Op.subVec _ ,[a,b]) => CL.mkBinOp(a, CL.#-, b)
213 :     | (Op.addVec _ ,[a,b]) => CL.mkBinOp(a, CL.#+, b)
214 :     | (Op.prodVec _ ,[a, b]) => CL.mkBinOp(a, CL.#*, b)
215 : cchiw 2830 | (Op.clampVec n, args) => CL.mkApply(N.NameClampV n, args)
216 :     | (Op.lerpVec n, args) => CL.mkApply(N.NameLerpV n, args)
217 : cchiw 2838 | (Op.prodScaV 1,[a,b]) => CL.mkBinOp(a, CL.#*, b)
218 : cchiw 2664 | (Op.prodScaV d,args) => CL.E_Apply(N.NameScaV d, args)
219 : cchiw 2870 | (Op.sumVec ([1],_),[a]) => a
220 :     | (Op.sumVec (_,oSize),args) => CL.E_Apply(N.NameSumV oSize, args)
221 : cchiw 2844 | (Op.IndexTensor _,_ )=> indexTensor(rator,args)
222 : jhr 1640 | (Op.LT ty, [a, b]) => CL.mkBinOp(a, CL.#<, b)
223 : cchiw 3699 | (Op.LTE ty, [a, b]) => CL.mkBinOp(a, CL.#<=, b)
224 :     | (Op.EQ ty, [a, b]) => CL.mkBinOp(a, CL.#==, b)
225 : jhr 1640 | (Op.NEQ ty, [a, b]) => CL.mkBinOp(a, CL.#!=, b)
226 :     | (Op.GTE ty, [a, b]) => CL.mkBinOp(a, CL.#>=, b)
227 :     | (Op.GT ty, [a, b]) => CL.mkBinOp(a, CL.#>, b)
228 : cchiw 3699 | (Op.Abs(Ty.IntTy), args) => CL.mkApply("abs", args)
229 :     | (Op.Abs(Ty.TensorTy[]), args) => CL.mkApply(N.fabs(), args)
230 :     | (Op.Abs ty, [a]) => raise Fail(concat["Abs<", Ty.toString ty, ">"])
231 : jhr 1640 | (Op.Not, [a]) => CL.mkUnOp(CL.%!, a)
232 : cchiw 3699
233 : jhr 1640 | (Op.Max, args) => CL.mkApply(N.max(), args)
234 :     | (Op.Min, args) => CL.mkApply(N.min(), args)
235 :     | (Op.Clamp(Ty.TensorTy[]), args) => CL.mkApply(N.clamp 1, args)
236 : cchiw 2830 | (Op.Clamp ty, args) =>raise Fail(concat["Clamp<", Ty.toString ty, "> not supported"])
237 :     | (Op.Lerp (Ty.TensorTy[]) , args) => CL.mkApply(N.lerp 1, args)
238 :     | (Op.Lerp ty , args) => raise Fail(concat["lerp<", Ty.toString ty, "> not supported" ])
239 : jhr 1640 | (Op.PrincipleEvec ty, _) => raise Fail "PrincipleEvec unimplemented"
240 :     | (Op.Select(Ty.TupleTy tys, i), [a]) => raise Fail "Select unimplemented"
241 :     | (Op.Index(Ty.SeqTy(Ty.IntTy, n), i), [a]) => ivecIndex (a, n, i)
242 : cchiw 2669 | (Op.Index(Ty.TensorTy[n], i), [a]) => vecIndex (a, n, i)
243 : cchiw 3194 | (Op.Subscript(Ty.SeqTy(Ty.IntTy, n)), [v, ix]) =>
244 :    
245 :     let
246 : cchiw 2845 val unionTy = CL.T_Named(concat["union", Int.toString n, !N.gIntSuffix, "_t"])
247 : jhr 1640 val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "i")
248 :     in
249 : cchiw 3194 CL.mkSubscript(vecExp, ix)
250 :    
251 : jhr 1640 end
252 : cchiw 2840 (*| (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) =>CL.mkSubscript(v, ix)*)
253 : cchiw 2845 | (Op.Subscript(Ty.SeqTy(ty, n)), [v, CL.E_Int(ix,_)]) => prntArr2(v, ix)
254 : cchiw 3194 (*| (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let
255 : cchiw 2838 val unionTy = CL.T_Named(concat["union", Int.toString n, !N.gRealSuffix, "_t"])
256 : jhr 1640 val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "r")
257 :     in
258 : cchiw 3194 CL.mkSubscript(vecExp, ix)
259 :     end*)
260 :     | (Op.Subscript(Ty.TensorTy[n]), [v, CL.E_Int(ix,_)]) => prntArr2 (v,ix)
261 :    
262 :     | (Op.Subscript ty0, [a, CL.E_Int(ix,_), CL.E_Int(jx,_)] ) =>
263 : cchiw 3544 indexTensor (Op.IndexTensor(false,[IntInf.toInt ix,IntInf.toInt jx] ,ty0),[a])
264 : cchiw 3444 | (Op.Subscript ty0, [a, CL.E_Int(ix,_), CL.E_Int(jx,_),CL.E_Int(kx,_)] ) =>
265 : cchiw 3544 indexTensor (Op.IndexTensor(false,[IntInf.toInt ix,IntInf.toInt jx,IntInf.toInt kx] ,ty0),[a])
266 : cchiw 2845 | (Op.Subscript ty, t::(ixs as _::_)) =>
267 : jhr 3060 raise Fail(concat["Subscript<", Ty.toString ty, "> unsupported"])
268 : jhr 1640 | (Op.Ceiling d, args) => CL.mkApply(N.addTySuffix("ceil", d), args)
269 : cchiw 2838 | (Op.Floor 1, args) => CL.mkApply(N.NameFloor , args)
270 : cchiw 2680 | (Op.Floor d, args) => CL.mkApply(N.NameFloorV d, args)
271 : jhr 1640 | (Op.Round d, args) => CL.mkApply(N.addTySuffix("round", d), args)
272 :     | (Op.Trunc d, args) => CL.mkApply(N.addTySuffix("trunc", d), args)
273 :     | (Op.IntToReal, [a]) => CL.mkCast(!N.gRealTy, a)
274 :     | (Op.RealToInt 1, [a]) => CL.mkCast(!N.gIntTy, a)
275 :     | (Op.RealToInt d, args) => CL.mkApply(N.vecftoi d, args)
276 : cchiw 2845 | (Op.Sqrt,[a])=>CL.mkApply(N.NameSqrt,[a])
277 : cchiw 3138 | (Op.Cosine,[a])=>CL.mkApply(N.NameCosine,[a])
278 :     | (Op.ArcCosine,[a])=>CL.mkApply(N.NameArcCosine,[a])
279 :     | (Op.Sine,[a])=>CL.mkApply(N.NameSine,[a])
280 :     | (Op.ArcSine,[a])=>CL.mkApply(N.NameArcSine,[a])
281 : cchiw 3444 | (Op.Tangent,[a])=>CL.mkApply(N.NameTangent,[a])
282 :     | (Op.ArcTangent,[a])=>CL.mkApply(N.NameArcTangent,[a])
283 :     | (Op.Exp,[a])=>CL.mkApply(N.NameExp,[a])
284 : cchiw 2870 | (Op.powInt,[a,b])=>CL.mkApply(N.NamePowInt,[a,b])
285 :     | (Op.powSca,[a,b])=>CL.mkApply(N.NamePowReal,[a,b])
286 : jhr 3060 | (Op.Normalize d,args) => CL.mkApply(N.normalize d, args)
287 :     | (Op.baseAddr img, [a] ) =>
288 : jhr 3155 CL.E_Cast(CL.T_Ptr(CL.T_Num(ImageInfo.sampleTy img)), CL.mkIndirect(a, "data"))
289 : cchiw 2844 | (Op.Transform(v,i),[a]) =>(case (ImageInfo.dim v)
290 :     of 1=>CL.mkIndirect(a, "s")
291 :     | _ =>CL.mkIndirect(a, "w2i["^(Int.toString i)^"].v")
292 :     (*end case*))
293 : jhr 3060 | (Op.Translate v, [a]) => (case (ImageInfo.dim v)
294 :     of 1 => CL.mkIndirect(a, "t")
295 :     | _ => CL.mkIndirect(a, "tVec")
296 : cchiw 2844 (*end case*))
297 :     (*Replaced with baseAddr operator*)
298 : jhr 3060 | (Op.ImageAddress info, [a]) => let
299 :     val cTy = CL.T_Ptr(CL.T_Num(ImageInfo.sampleTy info))
300 :     in
301 :     CL.mkCast(cTy, CL.mkIndirect(a, "data"))
302 :     end
303 : jhr 1640 | (Op.LoadVoxels(info, 1), [a]) => let
304 :     val realTy as CL.T_Num rTy = !N.gRealTy
305 :     val a = CL.E_UnOp(CL.%*, a)
306 :     in
307 :     if (rTy = ImageInfo.sampleTy info)
308 :     then a
309 :     else CL.E_Cast(realTy, a)
310 :     end
311 :     | (Op.LoadVoxels _, [a]) =>
312 :     raise Fail("impossible " ^ Op.toString rator)
313 : jhr 3060 | (Op.Inside(info, s), [pos, img]) =>
314 :     CL.mkApply(N.inside(ImageInfo.dim info), [pos, img, intExp s])
315 :     | (Op.LoadImage info, [a]) =>
316 : jhr 1640 raise Fail("impossible " ^ Op.toString rator)
317 : jhr 3060 | (Op.LoadImage(ty, nrrd, info), []) =>
318 : jhr 1640 raise Fail("impossible " ^ Op.toString rator)
319 : jhr 3060 | (Op.Input _, []) => raise Fail("impossible " ^ Op.toString rator)
320 : jhr 1640 | _ => raise Fail(concat[
321 : jhr 3060 "unknown or incorrect operator ", Op.toString rator
322 : jhr 1640 ])
323 :     (* end case *))
324 : cchiw 2680
325 : cchiw 3194 fun trSubscript(rator, args) = (case (rator, args)
326 :     of (Op.Subscript(Ty.SeqTy(ty, n)), [v, CL.E_Int(ix,_)]) => prntArr2(v, ix)
327 :     | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let
328 :     val unionTy = CL.T_Named(concat["union", Int.toString n, !N.gRealSuffix, "_t"])
329 :     val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "r")
330 :     in
331 :     CL.mkSubscript(vecExp, ix)
332 :     end
333 :     (*end case*))
334 :    
335 : cchiw 3197 fun trExp (env, e) = (("\nExp: "^(IL.toString e) );case e
336 : jhr 3060 of IL.E_State x => VarToC.rvalueStateVar x
337 : jhr 1640 | IL.E_Var x => VarToC.rvalueVar (env, x)
338 :     | IL.E_Lit(Literal.Int n) => CL.mkIntTy(n, !N.gIntTy)
339 :     | IL.E_Lit(Literal.Bool b) => CL.mkBool b
340 :     | IL.E_Lit(Literal.Float f) => CL.mkFlt(f, !N.gRealTy)
341 :     | IL.E_Lit(Literal.String s) => CL.mkStr s
342 : cchiw 3700 (*
343 : cchiw 3197 | IL.E_Op(Op.Subscript(Ty.TensorTy[2]),[IL.E_Op(Op.Subscript(Ty.SeqTy(Ty.TensorTy[2],2)),[v,i]),arg1])=>
344 : cchiw 3194 let
345 :     val arg0=(Op.Subscript(Ty.SeqTy(Ty.TensorTy[2],2)), trExps(env,[v,i]))
346 :     val exp0=trSubscript arg0
347 :     val exp1=trExp(env,arg1)
348 :     val rator=Op.Subscript(Ty.TensorTy[2])
349 :     val b=trSubscript(rator,[exp0,exp1])
350 :     in b
351 :     end
352 : cchiw 3197 | IL.E_Op(Op.Subscript(Ty.TensorTy[3]),[IL.E_Op(Op.Subscript(Ty.SeqTy(Ty.TensorTy[3],3)),[v,i]),arg1])=>
353 : cchiw 3194 let
354 :     val arg0=(Op.Subscript(Ty.SeqTy(Ty.TensorTy[3],3)), trExps(env,[v,i]))
355 :     val exp0=trSubscript arg0
356 :     val exp1=trExp(env,arg1)
357 :     val rator=Op.Subscript(Ty.TensorTy[3])
358 :     val b=trSubscript(rator,[exp0,exp1])
359 :     in b
360 :     end
361 : cchiw 3700 *)
362 : cchiw 3196 | IL.E_Op(Op.IndexTensor(e1,ty0,ty1) , [IL.E_LoadArr(_,_,_, v,IL.E_Lit(Literal.Int 0))])=>
363 :     let
364 :     val _ =("\n\n****** 1-"^IL.toString e)
365 :     in
366 : cchiw 3700 (*prntArr1(trExp(env,v),IntInf.toInt i+ x)*)
367 : cchiw 3196 trOp(Op.IndexTensor (false,ty0,ty1), [trExp(env,v)])
368 :     end
369 : jhr 1640 | IL.E_Op(rator, args) => trOp (rator, trExps(env, args))
370 :     | IL.E_Apply(f, args) => trApply(f, trExps(env, args))
371 : cchiw 2838 | IL.E_Cons(nSize,1,args) => (case (dumpStore args)
372 :     of [a1]=> trExp(env, a1)
373 : cchiw 2844 | a=>CL.mkApply(N.NameConsVec nSize, trExps(env, a))
374 : cchiw 2838 (*end case*))
375 :     | IL.E_Cons(nSize,oSize,args) => CL.mkApply(N.NameConsVec nSize, trExps(env, dumpStore args))
376 : cchiw 2844 | IL.E_LoadArr(_,1, _, v,IL.E_Lit(Literal.Int i)) =>
377 : cchiw 3196 ( ("\n\n****** 2-"^IL.toString e);CL.mkSubscript(trExp(env,v),CL.mkIntTy(i,!N.gIntTy)))
378 :     | IL.E_LoadArr(aligned,n, orig, v,arg) =>(
379 :     ("\n\n****** 3-"^IL.toString e);
380 :     (CL.mkApply(N.NameLdArr(aligned,n,orig), trExps(env, [v,arg]))))
381 : cchiw 2838 | IL.E_Mux (_,_,_,_,[a1]) => trExp(env,a1)
382 :     | IL.E_Mux (_,_,n,_,args) => (*raise Fail "Mux in tree-il stage, try trExp()"*)
383 :     CL.mkApply(N.NameMux n, trExps(env, args))
384 : cchiw 2664 (* end case *))
385 : cchiw 2844 and trExps (env, exps) = (List.map (fn exp => trExp(env, exp)) exps)
386 : cchiw 3700
387 :    
388 : jhr 1640 (* translate an expression to a variable form; return the variable and the
389 :     * (optional) declaration.
390 :     *)
391 : cchiw 2628 fun expToVar (env, ty, name, exp) =let
392 : cchiw 3700
393 : cchiw 2628 in (case trExp(env, exp)
394 : jhr 1640 of x as CL.E_Var _ => (x, [])
395 :     | exp => let
396 :     val x = freshVar name
397 :     in
398 :     (CL.mkVar x, [CL.mkDecl(ty, x, SOME(CL.I_Exp exp))])
399 :     end
400 :     (* end case *))
401 : cchiw 2628 end
402 : jhr 1640
403 :     (* translate a print statement *)
404 :     fun trPrint (env, tys, args) = let
405 :     (* assemble the format string by analysing the types and argument expressions *)
406 :     fun mkFmt (Ty.StringTy, IL.E_Lit(Literal.String s), (stms, fmt, args)) =
407 :     (stms, s::fmt, args)
408 :     | mkFmt (ty, exp, (stms, fmt, args)) = let
409 :     fun mk (f, e) = (stms, f::fmt, e::args)
410 : cchiw 3674
411 : jhr 1640 in
412 :     case ty
413 :     of Ty.BoolTy => mk(
414 :     "%s",
415 :     CL.mkCond(trExp(env, exp), CL.mkStr "true", CL.mkStr "false"))
416 :     | Ty.StringTy => mk("%s", trExp(env, exp))
417 :     | Ty.IntTy => mk(!N.gIntFormat, trExp(env, exp))
418 :     | Ty.TensorTy[] => mk("%f", trExp(env, exp))
419 : cchiw 3700 | Ty.TensorTy _ => let
420 : cchiw 3674
421 : cchiw 3700 val (x, stm) = expToVar (env, tyTransform ty , "vec", exp)
422 :     val (fmt, args) = mkElemFmt (ty, x, (fmt, args))
423 : cchiw 2676 in
424 : cchiw 3700 (stm@stms, fmt, args)
425 : cchiw 2676 end
426 : cchiw 3700 | Ty.SeqTy(elemTy, n) => let
427 :     val (x, stm) = expToVar (env, trType ty, "vec", exp)
428 :     val (fmt, args) = mkElemFmt (ty, x, (fmt, args))
429 : jhr 1640 in
430 :     (stm@stms, fmt, args)
431 :     end
432 :     | _ => raise Fail(concat["TreeToC.trPrint(", Ty.toString ty, ")"])
433 :     (* end case *)
434 :     end
435 :     and mkElemFmt (elemTy, elem, (fmt, args)) = (case elemTy
436 :     of Ty.BoolTy =>
437 :     ("%s"::fmt, CL.mkCond(elem, CL.mkStr "true", CL.mkStr "false")::args)
438 :     | Ty.StringTy => ("%s"::fmt, elem::args)
439 :     | Ty.IntTy => (!N.gIntFormat::fmt, elem::args)
440 :     | Ty.TensorTy[] => ("%f"::fmt, elem::args)
441 :     | Ty.TensorTy[n] => let
442 : cchiw 3674
443 : cchiw 3700 val elems = List.tabulate (n, fn i => prntArr1 (elem, i))
444 : jhr 1640 in
445 :     mkSeqFmt (Ty.TensorTy[], elems, fmt, args)
446 :     end
447 : cchiw 2676 (*called by printResults*)
448 :     | Ty.TensorTy[n, m] => let
449 :     val d=n*m
450 : cchiw 3674
451 : cchiw 3700 val elems = List.tabulate (d, fn i => prntArr1 (elem, i))
452 : cchiw 2676 in
453 :     mkSeqFmt (Ty.TensorTy[], elems, fmt, args)
454 :     end
455 :    
456 : jhr 1640 | Ty.SeqTy(elemTy, n) => let
457 : cchiw 3674
458 : jhr 1640 val elems = List.tabulate (n, fn i => ivecIndex (elem, n, i))
459 :     in
460 :     mkSeqFmt (elemTy, elems, fmt, args)
461 :     end
462 :     | _ => raise Fail(concat["TreeToC.mkElemFmt(", Ty.toString elemTy, ")"])
463 :     (* end case *))
464 :     and mkSeqFmt (elemTy, elems, fmt, args) = let
465 :     fun mk (elem, acc) = mkFmt(elemTy, elem, acc)
466 :     val (seqFmt, args) =
467 :     List.foldr
468 :     (fn (elem, acc) => mkElemFmt(elemTy, elem, acc))
469 :     ([], args) elems
470 :     in
471 :     ("<" :: String.concatWith "," seqFmt :: ">" :: fmt, args)
472 :     end
473 :     val (stms, fmt, args) = ListPair.foldr mkFmt ([], [], []) (tys, args)
474 :     val stm = CL.mkCall("fprintf", CL.mkVar "stderr" :: CL.mkStr(String.concat fmt) :: args)
475 :     in
476 :     List.rev (stm :: stms)
477 :     end
478 : cchiw 2525 (*Removed IADD, ISUB, INED, scale, MULT since they now only work on intergers*)
479 : jhr 1640 fun trAssign (env, lhs, rhs) = (
480 :     (* certain rhs forms, such as those that return a matrix,
481 :     * require a function call instead of an assignment
482 :     *)
483 :     case rhs
484 : cchiw 3192 of(* IL.E_Op(Op.EigenVals2x2, [m]) => let
485 : jhr 1640 val (m, stms) = expToVar (env, CL.T_Named(N.matTy(2,2)), "m", m)
486 :     in
487 :     stms @ [CL.mkCall(N.evals2x2, [
488 :     lhs,
489 :     matIndex (m, CL.mkInt 0, CL.mkInt 0),
490 :     matIndex (m, CL.mkInt 0, CL.mkInt 1),
491 :     matIndex (m, CL.mkInt 1, CL.mkInt 1)
492 :     ])]
493 : cchiw 3192 end*)
494 :     IL.E_Op(Op.EigenVals2x2, [m]) => let
495 :     val (m, stms) = expToVar (env, CL.T_Named(N.matTy(2,2)), "m", m)
496 :     in
497 : cchiw 3700 stms @ [CL.mkCall(N.evals2x2, [lhs,prntArr1(m,0),prntArr1(m,1),prntArr1(m,3)])]
498 : cchiw 3192 end
499 :    
500 : jhr 1640 | IL.E_Op(Op.EigenVals3x3, [m]) => let
501 : cchiw 3190 val (m, stms) = expToVar (env, CL.T_Named(N.matTy(3,3)), "m", m)
502 :     in
503 :     stms @ [CL.mkCall(N.evals3x3, [
504 :     lhs,
505 : cchiw 3700 prntArr1(m,0), prntArr1(m,1),prntArr1(m,2),
506 :     prntArr1(m,4), prntArr1(m,5),prntArr1(m,8)
507 : cchiw 3190 ])]
508 :     end
509 :    
510 :     (*
511 :     | IL.E_Op(Op.EigenVals3x3, [m]) => let
512 : jhr 1640 val (m, stms) = expToVar (env, CL.T_Named(N.matTy(3,3)), "m", m)
513 :     in
514 :     stms @ [CL.mkCall(N.evals3x3, [
515 :     lhs,
516 :     matIndex (m, CL.mkInt 0, CL.mkInt 0),
517 :     matIndex (m, CL.mkInt 0, CL.mkInt 1),
518 :     matIndex (m, CL.mkInt 0, CL.mkInt 2),
519 :     matIndex (m, CL.mkInt 1, CL.mkInt 1),
520 :     matIndex (m, CL.mkInt 1, CL.mkInt 2),
521 :     matIndex (m, CL.mkInt 2, CL.mkInt 2)
522 :     ])]
523 : cchiw 3190 end*)
524 : cchiw 3267 | IL.E_Op(Op.Zero(Ty.TensorTy ty),args)=> [CL.mkCall(N.NameZeroV ty, [lhs])]
525 :     | IL.E_Var x => let
526 :     val _= (String.concat["\n ** Tree-IL","=>",IL.toString rhs])
527 :     fun reg () = [CL.mkAssign(lhs, VarToC.rvalueVar(env, x))]
528 :     fun copy alpha= [CL.mkCall(N.NameCopyTensor alpha, [lhs,VarToC.rvalueVar(env, x),CL.mkInt 0])]
529 :     in (case (IL.Var.ty x, IL.Var.kind x)
530 :     of (Ty.TensorTy [],_) => ("A";reg())
531 :     | (Ty.TensorTy [_],IL.VK_Local) => ("B";reg())
532 : cchiw 3700 (*
533 : cchiw 3267 | (Ty.TensorTy [3],_) =>
534 : cchiw 3700 [CL.mkAssign(lhs,(CL.mkApply(N.NameLdArr(false,4,3), [VarToC.rvalueVar(env, x),CL.mkInt 0])))]*)
535 : cchiw 3267 | (Ty.TensorTy [i,j],_) => ("D"; copy [i,j])
536 :     (*|(Ty.SeqTy(Ty.TensorTy _,j),_) => ("E"; copy [j])*)
537 :     | (_ ,_)=> reg()
538 :     (* end case *))
539 :     end
540 : jhr 3060 | _ => [CL.mkAssign(lhs, trExp(env, rhs))]
541 : jhr 1640 (* end case *))
542 :    
543 :     fun trMultiAssign (env, lhs, IL.E_Op(rator, args)) = (case (lhs, rator, args)
544 : cchiw 3192 of (*([vals, vecs], Op.EigenVecs2x2, [m]) => let
545 : jhr 1640 val (m, stms) = expToVar (env, CL.T_Named(N.matTy(2,2)), "m", m)
546 :     in
547 :     stms @ [CL.mkCall(N.evecs2x2, [
548 :     vals, vecs,
549 :     matIndex (m, CL.mkInt 0, CL.mkInt 0),
550 :     matIndex (m, CL.mkInt 0, CL.mkInt 1),
551 :     matIndex (m, CL.mkInt 1, CL.mkInt 1)
552 :     ])]
553 : cchiw 3192 end*)
554 :     ([vals, vecs], Op.EigenVecs2x2, [m]) => let
555 :     val (m, stms) = expToVar (env, CL.T_Named(N.matTy(2,2)), "m", m)
556 :     in
557 :     stms @ [CL.mkCall(N.evecs2x2, [
558 : cchiw 3700 vals, vecs,prntArr1(m,0),prntArr1(m,1),prntArr1(m,3)])]
559 : jhr 1640 end
560 : cchiw 3192
561 : jhr 1640 | ([vals, vecs], Op.EigenVecs3x3, [m]) => let
562 :     val (m, stms) = expToVar (env, CL.T_Named(N.matTy(3,3)), "m", m)
563 : cchiw 2840 (*vecs is the one with the "wrong" type, what should it be?*)
564 : cchiw 3190
565 : jhr 1640 in
566 :     stms @ [CL.mkCall(N.evecs3x3, [
567 :     vals, vecs,
568 : cchiw 3700 prntArr1(m,0), prntArr1(m,1),prntArr1(m,2),
569 :     prntArr1(m,4), prntArr1(m,5),prntArr1(m,8)
570 : cchiw 3190 ])]
571 :     end
572 :     (* original
573 :     | ([vals, vecs], Op.EigenVecs3x3, [m]) => let
574 :     val (m, stms) = expToVar (env, CL.T_Named(N.matTy(3,3)), "m", m)
575 :     (*vecs is the one with the "wrong" type, what should it be?*)
576 :    
577 :     in
578 :     stms @ [CL.mkCall(N.evecs3x3, [
579 :     vals, vecs,
580 : jhr 1640 matIndex (m, CL.mkInt 0, CL.mkInt 0),
581 :     matIndex (m, CL.mkInt 0, CL.mkInt 1),
582 :     matIndex (m, CL.mkInt 0, CL.mkInt 2),
583 :     matIndex (m, CL.mkInt 1, CL.mkInt 1),
584 :     matIndex (m, CL.mkInt 1, CL.mkInt 2),
585 :     matIndex (m, CL.mkInt 2, CL.mkInt 2)
586 : cchiw 3190 ])]
587 :     end
588 : cchiw 3444 *)
589 : cchiw 3544 | ([], Op.Print tys, args) => trPrint (env, tys, args)
590 : jhr 1640 | _ => raise Fail "bogus multi-assignment"
591 :     (* end case *))
592 :     | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"
593 :    
594 : jhr 3060 fun trLocals (env : env, locals,isVecTy) =
595 :     List.foldl
596 : cchiw 2789 (fn (x, env) => V.Map.insert(env, x, V(localType(V.ty x,isVecTy), V.name x)))
597 : cchiw 2668 (*Here-for local vars*)
598 : jhr 3060 env locals
599 : jhr 1640
600 :     (* generate code to check the status of runtime-system calls *)
601 :     fun checkSts mkDecl = let
602 :     val sts = freshVar "sts"
603 :     in
604 :     mkDecl sts @
605 :     [CL.mkIfThen(
606 :     CL.mkBinOp(CL.mkVar "DIDEROT_OK", CL.#!=, CL.mkVar sts),
607 :     CL.mkCall("exit", [intExp 1]))]
608 :     end
609 :    
610 : jhr 3155 fun registerInput (env, lhs, name, optDesc, hasDflt) = let
611 :     val desc = Option.getOpt (optDesc, "")
612 :     val hasDflt = if hasDflt then "true" else "false"
613 : jhr 3171 val isCArray = (case V.ty lhs
614 :     of Ty.TensorTy(_::_) => true
615 :     | Ty.SeqTy _ => true
616 :     | _ => false
617 :     (* end case *))
618 :     val lhs' = VarToC.lvalueVar(env, lhs)
619 : jhr 3155 in
620 :     CL.mkCall(N.input(V.ty lhs), [
621 :     CL.mkVar "opts", CL.mkStr name, CL.mkStr desc,
622 : jhr 3171 if isCArray then lhs' else CL.mkUnOp(CL.%&, lhs'),
623 :     CL.mkVar hasDflt
624 : jhr 3155 ])
625 :     end
626 :    
627 :     fun trStms (env, stms, isVecTy) = let
628 :     fun getVar v = (case v
629 :     of IL.E_Var x => VarToC.lvalueVar (env, x)
630 :     | IL.E_State x => VarToC.lvalueStateVar x
631 :     | _ => raise Fail "NonVar in exp"
632 :     (* end case *))
633 : cchiw 3444 fun trStmt (env, stm) = (("\nHI****"^(IL.toStringS stm));(case stm
634 : cchiw 2827 of IL.S_Comment text => [CL.mkComment text]
635 : cchiw 3444 | IL.S_Assign([x],IL.E_Mux(A,isFill, oSize,splitTy,[a]))=> (("from S.S_assign MUX");trAssign (env,VarToC.lvalueVar (env, x),a))
636 : cchiw 2688 | IL.S_Assign([x], exp) =>
637 : cchiw 3267 ("from S.S_assign exp";(trAssign (env, VarToC.lvalueVar (env, x) , exp)))
638 : cchiw 2842 | IL.S_Assign(xs, exp) =>(trMultiAssign (env, List.map (fn x => VarToC.lvalueVar (env, x)) xs, exp))
639 : cchiw 2795 | IL.S_IfThen(cond, thenBlk) =>[CL.mkIfThen(trExp(env, cond), trBlk(env, thenBlk,isVecTy))]
640 : jhr 3155 | IL.S_IfThenElse(cond, thenBlk, elseBlk) =>
641 :     [CL.mkIfThenElse(trExp(env, cond),
642 :     trBlk(env, thenBlk, isVecTy),
643 :     trBlk(env, elseBlk, isVecTy))]
644 : jhr 1640 | IL.S_New _ => raise Fail "new not supported yet" (* FIXME *)
645 : cchiw 3267 | IL.S_Copy( IL.E_State x,exp,_,1)=> ("from S.S_assign copy_1";trAssign (env, VarToC.lvalueStateVar x, exp))
646 : cchiw 2827 | IL.S_Copy(x,exp,offset,n)=>
647 :     [CL.S_Exp (CL.mkApply(N.NameCopyTensor [n],[getVar x,trExp(env,exp),CL.mkIntTy(IntInf.fromInt offset, !N.gIntTy)]))]
648 : cchiw 3267 | IL.S_Save([x],exp) => ("from S.save exp";(trAssign (env, VarToC.lvalueStateVar x, exp)))
649 : cchiw 2691 | IL.S_Save(xs, exp) =>
650 : jhr 3060 trMultiAssign (env, List.map VarToC.lvalueStateVar xs, exp)
651 :     | IL.S_LoadNrrd(lhs, Ty.ImageTy info, nrrd) =>
652 : jhr 3155 [GenLoadNrrd.loadImage (VarToC.lvalueVar (env, lhs), info, CL.E_Str nrrd)]
653 :     | IL.S_Input(lhs, name, optDesc, NONE) =>
654 :     [registerInput (env, lhs, name, optDesc, false)]
655 : jhr 3172 (* FIXME: it may be best to just use the Inputs.initializer type in the TreeIL!!! *)
656 :     | IL.S_Input(lhs, name, optDesc, SOME(IL.E_Mux(_, _, _, _, args))) => let
657 :     val args = List.concat(List.map (fn (IL.E_Cons(_, n, es)) => List.take(es, n)) args)
658 :     val lhs' = VarToC.lvalueVar(env, lhs)
659 :     fun mk (_, [], stms) = List.revAppend(stms, [registerInput (env, lhs, name, optDesc, true)])
660 :     | mk (i, e::es, stms) = let
661 :     val stm = CL.mkAssign(CL.mkSubscript(lhs', CL.mkInt i), trExp(env, e))
662 :     in
663 :     mk (i+1, es, stm::stms)
664 :     end
665 :     in
666 :     mk (0, args, [])
667 :     end
668 : jhr 3155 | IL.S_Input(lhs, name, optDesc, SOME dflt) => [
669 :     CL.mkAssign(VarToC.lvalueVar(env, lhs), trExp(env, dflt)),
670 :     registerInput (env, lhs, name, optDesc, true)
671 : jhr 3060 ]
672 :     | IL.S_InputNrrd _ => []
673 : jhr 1640 | IL.S_Exit args => [CL.mkReturn NONE]
674 :     | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar N.kActive))]
675 :     | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar N.kStabilize))]
676 :     | IL.S_Die => [CL.mkReturn(SOME(CL.mkVar N.kDie))]
677 : cchiw 3700 | IL.S_StoreVec(v, offset, A, isFill, oSize, _, [_], [IL.E_Cons(_ , _ , args)]) =>
678 :     let
679 :     val x = getVar v
680 :     fun iter(0, e0::consargs) =
681 :     [CL.mkAssign(prntArr1(x, offset), trExp (env, e0))]
682 :     | iter(n, e0::consargs) =
683 :     CL.mkAssign(prntArr1(x, offset+n), trExp (env, e0))::iter(n-1, consargs)
684 :     in (case oSize
685 :     of 2 => List.rev (iter(oSize-1, List.rev(List.take(args, oSize))))
686 :     | 3 => List.rev (iter(oSize-1, List.rev(List.take(args, oSize))))
687 :     | 4 => List.rev (iter(oSize-1, List.rev(List.take(args, oSize))))
688 :     | _ => raise Fail "Should be more than one piece here"
689 :     (* end case*))
690 :     end
691 :     | IL.S_StoreVec(v, offset, A, true, oSize, _, pieces, args) =>
692 :     let (*isFilled used*)
693 :     val x= getVar v
694 :     fun sort([], _, _) = []
695 :     | sort(nSize::ps, e1::es, offset) =
696 :     CL.mkApply(N.NameStoreVec(A, nSize, oSize), x::trExps(env, [IL.E_Lit(Literal.Int offset), e1]))
697 :     ::sort(ps, es, offset + IntInf.fromInt oSize)
698 :     | sort _ = raise Fail"Not the right number of Arguments"
699 :     val exp = sort(pieces, args, IntInf.fromInt offset)
700 :     in
701 :     List.map (fn e=> CL.S_Exp e ) exp
702 :     end
703 :     | IL.S_StoreVec(v, offset, A, false, oSize, _, pieces, args) =>
704 :     let
705 :     val x= getVar v
706 :     fun sort([], _, _)=[]
707 :     | sort(nSize::ps, e1::es, offset)=
708 :     CL.mkApply(N.NameStoreVec(A, nSize, oSize), x::trExps(env, [IL.E_Lit(Literal.Int offset), e1]))
709 :     ::sort(ps, es, offset + IntInf.fromInt nSize)
710 :     | sort _=raise Fail("Not the right number of Arguments")
711 :     val exp = sort(pieces, args, IntInf.fromInt offset)
712 :     in
713 :     List.map (fn e=> CL.S_Exp e ) exp
714 :     end
715 : cchiw 2795 | IL.S_Cons(x,n,args)=> [CL.S_Exp (CL.mkApply(N.NameConsArray n, [VarToC.lvalueVar (env, x)]@trExps(env, args)))]
716 : cchiw 3444 (* end case *)))
717 : cchiw 2795 in
718 :     List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] stms
719 : jhr 1640 end
720 :    
721 : jhr 3060 and trBlk (env, IL.Block{locals, body}, isVecTy) = let
722 :     val env = trLocals (env, locals, isVecTy)
723 :     val stms = trStms (env, body, isVecTy)
724 : jhr 1640 fun mkDecl (x, stms) = (case V.Map.find (env, x)
725 :     of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
726 :     | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
727 :     (* end case *))
728 :     val stms = List.foldr mkDecl stms locals
729 :     in
730 :     CL.mkBlock stms
731 :     end
732 :    
733 : jhr 3060 fun trFragment (env, IL.Block{locals, body}, isVecTy) = let
734 :     val env = trLocals (env, locals, isVecTy)
735 :     val stms = trStms (env, body, isVecTy)
736 : jhr 1640 fun mkDecl (x, stms) = (case V.Map.find (env, x)
737 :     of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
738 :     | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
739 :     (* end case *))
740 :     val stms = List.foldr mkDecl stms locals
741 :     in
742 :     (env, stms)
743 :     end
744 :    
745 :     val trBlock = trBlk
746 :    
747 :     end

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