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

SCM Repository

[diderot] Diff of /branches/vis15/src/compiler/cxx-util/tree-to-cxx.sml
ViewVC logotype

Diff of /branches/vis15/src/compiler/cxx-util/tree-to-cxx.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

branches/vis15/src/compiler/c-util/tree-to-c.sml revision 3768, Mon Apr 18 22:20:53 2016 UTC branches/vis15/src/compiler/cxx-util/tree-to-cxx.sml revision 3917, Sat May 28 16:41:39 2016 UTC
# Line 1  Line 1 
1  (* tree-to-c.sml  (* tree-to-cxx.sml
2   *   *
3   * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)   * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4   *   *
5   * COPYRIGHT (c) 2016 The University of Chicago   * COPYRIGHT (c) 2016 The University of Chicago
6   * All rights reserved.   * All rights reserved.
7   *   *
8   * Translate TreeIR to the C version of CLang.   * Translate TreeIR to the C++ version of CLang.
9   *)   *)
10    
 structure PseudoVars =  
   struct  
 (* TreeIR "variables" that are used to get the names needed to access the  
  * global and strand state variables.  These are just used as keys to lookup  
  * the C names in the environment, so their kind and type are irrelevant.  
  *)  
     local  
       fun new name = TreeIL.Var.new (name, TreeIL.Ty.IntTy)  
     in  
     val selfIn = new "$selfIn"  
     val selfOut = new "$selfOut"  
     val global = new "$global"  
     end (* local *)  
   end  
11    
12  structure TreeToC : sig  structure TreeToCxx : sig
13    
14      type env = CLang.typed_var TreeIL.Var.Map.map      val trType : CodeGenEnv.t * TreeTypes.t -> CLang.ty
15    
16      val empty : env      val trBlock : CodeGenEnv.t * TreeIR.block -> CLang.stm
17    
18      val trType : TreeIL.Ty.ty -> CLang.ty      val trExp : CodeGenEnv.t * TreeIR.exp -> CLang.exp
19    
20      val trBlock : env * TreeIL.block -> CLang.stm    (* translate an expression to a variable form; return the variable (as an expression)
   
     val trFragment : env * TreeIL.block -> env * CLang.stm list  
   
     val trExp : env * TreeIL.exp -> CLang.exp  
   
   (* translate an expression to a variable form; return the variable (as an expresison)  
21     * and the (optional) declaration.     * and the (optional) declaration.
22     *)     *)
23      val expToVar : env * CLang.ty * string * TreeIL.exp -> CLang.exp * CLang.stm list      val trExpToVar : CodeGenEnv.t * CLang.ty * string * TreeIR.exp -> CLang.exp * CLang.stm list
24    
25        val trAssign : CodeGenEnv.t * CLang.exp * TreeIR.exp -> CLang.stm list
26    
27      val trAssign : env * CLang.exp * TreeIL.exp -> CLang.stm list    (* generate code to register an error message (require that a world pointer "wrld" is in scope) *)
28        val errorMsgAdd : CLang.exp -> CLang.stm
29    
30        val trParam : CodeGenEnv.t -> TreeIR.var -> CLang.param
31    
32    end = struct    end = struct
33    
# Line 50  Line 35 
35      structure IR = TreeIR      structure IR = TreeIR
36      structure Op = TreeOps      structure Op = TreeOps
37      structure Ty = TreeTypes      structure Ty = TreeTypes
38      structure V = IR.Var      structure V = TreeVar
39        structure Env = CodeGenEnv
40    
41      datatype var = datatype CL.typed_var      fun trType (env, ty) = (case ty
42      type env = CL.typed_var TreeIL.Var.Map.map             of Ty.BoolTy => CL.boolTy
43                | Ty.StringTy => CL.T_Named "std::string"
44                | Ty.IntTy => Env.intTy env
45                | (Ty.VecTy(1, 1)) => Env.realTy env
46                | (Ty.VecTy(d, _)) => CL.T_Named("vec" ^ Int.toString d)
47                | (Ty.TupleTy tys) => raise Fail "FIXME: TupleTy"
48                | (Ty.TensorTy dd) => CL.T_Array(Env.realTy env, SOME(List.foldl Int.* 1 dd))
49                | (Ty.SeqTy(t, NONE)) => CL.T_Template("diderot::dynseq", [trType(env, t)])
50                | (Ty.SeqTy(t, SOME n)) => CL.T_Array(trType(env, t), SOME n)
51                | (Ty.ImageTy info) =>
52                    CL.T_Template(
53                      concat["diderot::image", Int.toString(ImageInfo.dim info), "d"],
54                      [Env.realTy env])
55                | (Ty.StrandTy name) => CL.T_Named("strand_" ^ Atom.toString name)
56              (* end case *))
57    
58      val empty = V.Map.empty    (* translate a local variable that occurs in an l-value context *)
59        fun lvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))
60      (* translate a variable that occurs in an r-value context *)
61        fun rvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))
62    
63      (* translate a global variable that occurs in an l-value context *)
64        fun lvalueGlobalVar (env, x) = CL.mkIndirect(CL.mkVar(Env.global env), TreeGlobalVar.name x)
65      (* translate a global variable that occurs in an r-value context *)
66        val rvalueGlobalVar = lvalueGlobalVar
67    
68      (* translate a strand state variable that occurs in an l-value context *)
69        fun lvalueStateVar (env, x) = CL.mkIndirect(CL.mkVar(Env.selfOut env), TreeStateVar.name x)
70      (* translate a strand state variable that occurs in an r-value context *)
71        fun rvalueStateVar (env, x) = CL.mkIndirect(CL.mkVar(Env.selfIn env), TreeStateVar.name x)
72    
73      fun lookup (env, x) = (case V.Map.find (env, x)    (* generate new variables *)
74             of SOME(V(_, x')) => x'      local
75              | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])        val count = ref 0
76            (* end case *))        fun freshName prefix = let
77                val n = !count
78                in
79                  count := n+1;
80                  concat[prefix, "_", Int.toString n]
81                end
82        in
83        fun tmpVar () = freshName "tmp"
84        fun freshVar prefix = freshName prefix
85        end (* local *)
86    
87      (* integer literal expression *)
88        fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)
89    
90        val zero = CL.mkInt 0
91    
92    (* Translate a TreeIL operator application to a CLang expression *)      fun addrOf e = CL.mkUnOp(CL.%&, e)
93      fun trOp (rator, args) = (case (rator, args)  
94              | (Op.IAdd, [a, b]) => CL.mkBinOp(a, CL.#+, b)    (* make an application of a function from the "std" namespace *)
95        fun mkStdApply (f, args) = CL.mkApply("std::" ^ f, args)
96    
97      (* make an application of a function from the "diderot" namespace *)
98        fun mkDiderotApply (f, args) = CL.mkApply("diderot::" ^ f, args)
99        fun mkDiderotCall (f, args) = CL.mkCall("diderot::" ^ f, args)
100    
101      (* Translate a TreeIR operator application to a CLang expression *)
102        fun trOp (env, rator, args) = (case (rator, args)
103               of (Op.IAdd, [a, b]) => CL.mkBinOp(a, CL.#+, b)
104              | (Op.ISub, [a, b]) => CL.mkBinOp(a, CL.#-, b)              | (Op.ISub, [a, b]) => CL.mkBinOp(a, CL.#-, b)
105              | (Op.IMul, [a, b]) => CL.mkBinOp(a, CL.#*, b)              | (Op.IMul, [a, b]) => CL.mkBinOp(a, CL.#*, b)
106              | (Op.IDiv, [a, b]) => CL.mkBinOp(a, CL.#/, b)              | (Op.IDiv, [a, b]) => CL.mkBinOp(a, CL.#/, b)
# Line 76  Line 111 
111              | (Op.RMul, [a, b]) => CL.mkBinOp(a, CL.#*, b)              | (Op.RMul, [a, b]) => CL.mkBinOp(a, CL.#*, b)
112              | (Op.RDiv, [a, b]) => CL.mkBinOp(a, CL.#/, b)              | (Op.RDiv, [a, b]) => CL.mkBinOp(a, CL.#/, b)
113              | (Op.RNeg, [a]) => CL.mkUnOp(CL.%-, a)              | (Op.RNeg, [a]) => CL.mkUnOp(CL.%-, a)
114                | (Op.RClamp, [a, b, c]) => CL.mkApply("clamp", [a, b, c])
115                | (Op.RLerp, [a, b, c]) => CL.mkApply("lerp", [a, b, c])
116                | (Op.RCeiling, [a]) => mkStdApply("ceil", [a])
117                | (Op.RFloor, [a]) => mkStdApply("floor", [a])
118                | (Op.RRound, [a]) => mkStdApply("round", [a])
119                | (Op.RTrunc, [a]) => mkStdApply("trunc", [a])
120                | (Op.RealToInt, [a]) => mkStdApply("lround", [a])
121              | (Op.LT ty, [a, b]) => CL.mkBinOp(a, CL.#<, b)              | (Op.LT ty, [a, b]) => CL.mkBinOp(a, CL.#<, b)
122              | (Op.LTE ty, [a, b]) => CL.mkBinOp(a, CL.#<=, b)              | (Op.LTE ty, [a, b]) => CL.mkBinOp(a, CL.#<=, b)
123              | (Op.EQ ty, [a, b]) => CL.mkBinOp(a, CL.#==, b)              | (Op.EQ ty, [a, b]) => CL.mkBinOp(a, CL.#==, b)
# Line 83  Line 125 
125              | (Op.GTE ty, [a, b]) => CL.mkBinOp(a, CL.#>=, b)              | (Op.GTE ty, [a, b]) => CL.mkBinOp(a, CL.#>=, b)
126              | (Op.GT ty, [a, b]) => CL.mkBinOp(a, CL.#>, b)              | (Op.GT ty, [a, b]) => CL.mkBinOp(a, CL.#>, b)
127              | (Op.Not, [a]) => CL.mkUnOp(CL.%!, a)              | (Op.Not, [a]) => CL.mkUnOp(CL.%!, a)
128              | (Op.Abs ty, []) =>              | (Op.Abs ty, args) => mkStdApply("abs", args)
129              | (Op.Max ty, []) =>              | (Op.Max ty, args) => mkStdApply("min", args)
130              | (Op.Min ty, []) =>              | (Op.Min ty, args) => mkStdApply("max", args)
131              | (Op.Clamp ty, []) =>              | (Op.VAdd d, [a, b]) => CL.mkBinOp(a, CL.#+, b)
132              | (Op.Lerp ty, []) =>              | (Op.VSub d, [a, b]) => CL.mkBinOp(a, CL.#-, b)
133              | (Op.VAdd d, [a, b]) =>              | (Op.VScale d, [a, b]) => CL.mkApply("vscale", [a, b])
134              | (Op.VSub d, [a, b]) =>              | (Op.VMul d, [a, b]) => CL.mkBinOp(a, CL.#*, b)
135              | (Op.VScale d, [a, b]) =>              | (Op.VNeg d, [a]) => CL.mkUnOp(CL.%-, a)
136              | (Op.VMul d, [a, b]) =>              | (Op.VSum d, [a]) => CL.mkApply("vsum", [a])
137              | (Op.VNeg d, [a]) =>              | (Op.VIndex(w, p, i), [a]) => CL.mkSubscript(a, intExp i)
138              | (Op.VSum d, [a]) =>              | (Op.VClamp d, [a, b, c]) => CL.mkApply("vclamp", [a, b, c])
139              | (Op.TensorIndex(ty * shape), []) =>              | (Op.VMapClamp d, [a, b, c]) => CL.mkApply("vclamp", [a, b, c])
140              | (Op.EigenVecs2x2, []) =>              | (Op.VLerp d, [a, b, c]) => CL.mkApply("vlerp", [a, b, c])
141              | (Op.EigenVecs3x3, []) =>              | (Op.VCeiling d, [a]) => CL.mkApply("vceiling", [a])
142              | (Op.EigenVals2x2, []) =>              | (Op.VFloor d, [a]) => CL.mkApply("vfloor", [a])
143              | (Op.EigenVals3x3, []) =>              | (Op.VRound d, [a]) => CL.mkApply("vround", [a])
144              | (Op.Zero ty, []) =>              | (Op.VTrunc d, [a]) => CL.mkApply("vtrunc", [a])
145              | (Op.Select(ty * int), []) =>              | (Op.VToInt d, [a]) => CL.mkApply("vtoi", [a])
146              | (Op.Subscript ty, []) =>              | (Op.TensorIndex(Ty.TensorTy(_::dd), idxs), [a]) => let
147              | (Op.MkDynamic(ty * int), []) =>                (* dimensions/indices are slowest to fastest *)
148              | (Op.Append ty, []) =>                  fun index ([], [i], acc) = acc + i
149              | (Op.Prepend ty, []) =>                    | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))
150              | (Op.Concat ty, []) =>                  in
151              | (Op.Range, []) =>                    CL.mkSubscript(a, intExp(index (dd, idxs, 0)))
152              | (Op.Length ty, []) =>                  end
153              | (Op.SphereQuery(ty * ty), []) =>              | (Op.ProjectLast(Ty.TensorTy(_::dd), idxs), [a]) => let
154              | (Op.Sqrt, []) =>                (* dimensions/indices are slowest to fastest *)
155              | (Op.Cos, []) =>                  fun index ([], [], acc) = acc
156              | (Op.ArcCos, []) =>                    | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))
157              | (Op.Sine, []) =>                  in
158              | (Op.ArcSin, []) =>                    CL.mkAddrOf(CL.mkSubscript(a, intExp(index (dd, idxs, 0))))
159              | (Op.Tan, []) =>                  end
160              | (Op.ArcTan, []) =>              | (Op.EigenVals2x2, [a]) => raise Fail "FIXME: EigenVals2x2"
161              | (Op.Exp, []) =>              | (Op.EigenVals3x3, [a]) => raise Fail "FIXME: EigenVals3x3"
162              | (Op.Ceiling d, []) =>              | (Op.Select(ty, i), [a]) => raise Fail "FIXME: Select"
163              | (Op.Floor d, []) =>              | (Op.Subscript ty, [a, b]) => CL.mkSubscript(a, b)
164              | (Op.Round d, []) =>              | (Op.MkDynamic(ty, i), [a]) => raise Fail "FIXME: MkDynamic"
165              | (Op.Trunc d, []) =>              | (Op.Append ty, [a, b]) => raise Fail "FIXME: Append"
166              | (Op.IntToReal, []) =>              | (Op.Prepend ty, [a, b]) => raise Fail "FIXME: Prepend"
167              | (Op.RealToInt d, []) =>              | (Op.Concat ty, [a, b]) => raise Fail "FIXME: Concat"
168                | (Op.Range, [a, b]) => raise Fail "FIXME: Range"
169                | (Op.Length ty, [a]) => raise Fail "FIXME: Length"
170                | (Op.SphereQuery(ty1, ty2), []) => raise Fail "FIXME: SphereQuery"
171                | (Op.Sqrt, [a]) => mkStdApply("sqrt", [a])
172                | (Op.Cos, [a]) => mkStdApply("cos", [a])
173                | (Op.ArcCos, [a]) => mkStdApply("acos", [a])
174                | (Op.Sin, [a]) => mkStdApply("sin", [a])
175                | (Op.ArcSin, [a]) => mkStdApply("asin", [a])
176                | (Op.Tan, [a]) => mkStdApply("tan", [a])
177                | (Op.ArcTan, [a]) => mkStdApply("atan", [a])
178                | (Op.Exp, [a]) => mkStdApply("exp", [a])
179                | (Op.IntToReal, [a]) => CL.mkStaticCast(Env.realTy env, a)
180  (*  (*
181              | R_All of ty              | R_All of ty
182              | R_Exists of ty              | R_Exists of ty
# Line 133  Line 187 
187              | R_Mean of ty              | R_Mean of ty
188              | R_Variance of ty              | R_Variance of ty
189  *)  *)
190              | (Op.Transform(ImageInfo.info * int), []) =>              | (Op.Transform info, [img]) => CL.mkDispatch(img, "world2image", [])
191              | (Op.Translate(ImageInfo.info), []) =>              | (Op.Translate info, [img]) => CL.mkDispatch(img, "translate", [])
192              | (Op.BaseAddress(ImageInfo.info), []) =>              | (Op.BaseAddress info, [img]) => CL.mkDispatch(img, "base_addr", [])
193              | (Op.ControlIndex(ImageInfo.info * idxctl * int), []) =>              | (Op.ControlIndex(info, ctl, d), [img, idx]) =>
194              | (Op.Inside(ImageInfo.info * int), []) =>                  CL.mkDispatch(img, IndexCtl.toString ctl, [intExp d, idx])
195              | (Op.ImageDim(ImageInfo.info * int), []) =>              | (Op.Inside(info, s), [pos, img]) => CL.mkDispatch(img, "inside", [pos, intExp s])
196              | (Op.LoadSeq(ty * string), []) =>              | (Op.ImageDim(info, i), [img]) => CL.mkDispatch(img, "size", [intExp i])
197              | (Op.LoadImage(ty * string), []) =>              | (Op.MathFn f, args) => mkStdApply(MathFns.toString f, args)
198              | (Op.Print(tys), []) =>              | _ => raise Fail(concat[
199              | (Op.MathFn f, args) => CL.mkApply(??, args)                     "unknown or incorrect operator ", Op.toString rator
200                     ])
201              (* end case *))
202    
203        fun trExp (env, e) = (case e
204               of IR.E_Global x => rvalueGlobalVar (env, x)
205                | IR.E_State(NONE, x) => rvalueStateVar (env, x)
206                | IR.E_State(SOME e, x) => CL.mkIndirect(trExp(env, e), TreeStateVar.name x)
207                | IR.E_Var x => rvalueVar (env, x)
208                | IR.E_Lit(Literal.Int n) => CL.mkIntTy(n, Env.intTy env)
209                | IR.E_Lit(Literal.Bool b) => CL.mkBool b
210                | IR.E_Lit(Literal.Real f) => CL.mkFlt(f, Env.realTy env)
211                | IR.E_Lit(Literal.String s) => CL.mkStr s
212                | IR.E_Op(rator, args) => trOp (env, rator, trExps(env, args))
213                | IR.E_Vec(w, pw, args) => let
214                    val args = trExps (env, args)
215                    val args = if (w < pw) then args @ List.tabulate(pw-w, fn _ => zero) else args
216                    in
217                      CL.mkVec(CL.T_Named("vec" ^ Int.toString pw), args)
218                    end
219                | IR.E_Cons(args, Ty.TensorTy shape) => raise Fail "unexpected E_Cons"
220                | IR.E_Seq(args, ty) => raise Fail "unexpected E_Seq"
221                | IR.E_Pack(layout, args) => raise Fail "unexpected E_Pack"
222    (* FIXME: check if e is aligned and use "vload_aligned" in that case *)
223                | IR.E_VLoad(layout, e, i) =>
224                    CL.mkTemplateApply("vload",
225                      [trType(env, Ty.nthVec(layout, i))],
226                      [CL.mkBinOp(trExp(env, e), CL.#+, intExp(Ty.offsetOf(layout, i)))])
227                | _ => raise Fail "trExp"
228              (* end case *))
229    
230        and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps
231    
232    (* QUESTION: not sure that we need this function? *)
233        fun trExpToVar (env, ty, name, exp) = (case trExp (env, exp)
234               of e as CL.E_Var _ => (e, [])
235                | e => let
236                    val x = freshVar name
237                    in
238                      (CL.mkVar x, [CL.mkDeclInit(ty, x, e)])
239                    end
240              (* end case *))
241    
242        fun trAssign (env, lhs, rhs) = let
243              fun trArg (i, arg) = CL.mkAssign(CL.mkSubscript(lhs, intExp i), trExp (env, arg))
244              in
245                case rhs
246                 of IR.E_Pack(_, args) => [CL.mkCall ("vpack", List.map (fn e => trExp(env, e)) args)]
247                  | IR.E_Cons(args, _) => List.mapi trArg args
248                  | IR.E_Seq(args, _) => List.mapi trArg args
249                  | _ => [CL.mkAssign(lhs, trExp (env, rhs))]
250                (* end case *)
251              end
252    
253        fun trDecl (env, ty, lhs, rhs) = let
254              fun trArgs args = CL.mkDecl(
255                    ty, lhs, SOME(CL.I_Exps(List.map (fn arg => CL.I_Exp(trExp (env, arg))) args)))
256              in
257                case rhs
258                 of IR.E_Cons(args, _) => trArgs args
259                  | IR.E_Seq(args, _) => trArgs args
260                  | _ => CL.mkDeclInit(ty, lhs, trExp (env, rhs))
261                (* end case *)
262              end
263    
264        fun trMultiAssign (env, lhs, IR.E_Op(rator, args)) = (case (lhs, rator, args)
265               of ([vals, vecs], Op.EigenVecs2x2, [exp]) =>
266                    mkDiderotCall("eigenvecs", [trExp (env, exp), vals, vecs])
267                | ([vals, vecs], Op.EigenVecs3x3, [exp]) =>
268                    mkDiderotCall("eigenvecs", [trExp (env, exp), vals, vecs])
269                | _ => raise Fail "bogus multi-assignment"
270            (* end case *))            (* end case *))
271          | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"
272    
273        fun trStms (env, stms : TreeIR.stm list) = let
274              fun trStm (stm, (env, stms : CL.stm list)) = (case stm
275                     of IR.S_Comment text => (env, CL.mkComment text :: stms)
276                      | IR.S_Assign(true, x, exp) => let
277                          val ty = trType (env, V.ty x)
278                          val x' = V.name x
279                          val env = Env.insert (env, x, x')
280                          in
281                            (env, trDecl (env, ty, x', exp) :: stms)
282                          end
283                      | IR.S_Assign(false, x, exp) => let
284                          val stms' = trAssign (env, lvalueVar (env, x), exp)
285                          in
286                            (env, stms' @ stms)
287                          end
288                      | IR.S_MAssign(xs, exp) =>
289                          (env, trMultiAssign (env, List.map (fn x => lvalueVar (env, x)) xs, exp) :: stms)
290                      | IR.S_GAssign(x, exp) =>
291                          (env, trAssign (env, lvalueGlobalVar (env, x), exp) @ stms)
292                      | IR.S_IfThen(cond, thenBlk) =>
293                          (env, CL.mkIfThen(trExp(env, cond), trBlock(env, thenBlk)) :: stms)
294                      | IR.S_IfThenElse(cond, thenBlk, elseBlk) => let
295                          val stm = CL.mkIfThenElse(trExp(env, cond),
296                                trBlock(env, thenBlk),
297                                trBlock(env, elseBlk))
298                          in
299                            (env, stm :: stms)
300                          end
301                      | IR.S_Foreach(x, IR.E_Op(Op.Range, [lo, hi]), blk) => let
302                          val x' = V.name x
303                          val env' = Env.insert (env, x, x')
304                          val (hi', hiInit) = if CodeGenUtil.isSimple hi
305                                then (trExp(env, hi), [])
306                                else let
307                                  val hi' = freshVar "hi"
308                                  in
309                                    (CL.mkVar hi', [CL.mkDeclInit(CL.int32, hi', trExp(env, hi))])
310                                  end
311                          val loop = CL.mkFor(
312                                [(CL.int32, x', trExp(env, lo))],
313                                CL.mkBinOp(CL.mkVar x', CL.#<=, hi'),
314                                [CL.mkUnOp(CL.%++, CL.mkVar x')],
315                                trBlock (env', blk))
316                          in
317                            (env, hiInit @ loop :: stms)
318                          end
319                      | IR.S_Foreach(x, e, blk) => raise Fail "Foreach"
320                      | IR.S_New(strand, args) => raise Fail "New"
321                      | IR.S_Save(x, exp) => (env, trAssign (env, lvalueStateVar(env, x), exp))
322                      | IR.S_LoadNrrd(lhs, ty, nrrd) => let
323                          val stm = (case ty
324                                 of APITypes.SeqTy(ty, NONE) =>
325                                      GenLoadNrrd.loadSeqFromFile (lvalueVar (env, lhs), ty, CL.mkStr nrrd)
326                                  | APITypes.ImageTy _ =>
327                                      GenLoadNrrd.loadImage (lvalueVar (env, lhs), CL.mkStr nrrd)
328                                  | _ => raise Fail(concat[
329                                        "bogus type ", APITypes.toString ty, " for LoadNrrd"
330                                      ])
331                                (* end case *))
332                          in
333                            (env, stm :: stms)
334                          end
335                      | IR.S_Input(_, _, _, NONE) => (env, stms)
336                      | IR.S_Input(gv, name, _, SOME dflt) =>
337                          (env, CL.mkAssign(lvalueGlobalVar (env, gv), trExp(env, dflt)) :: stms)
338                      | IR.S_InputNrrd _ => (env, stms)
339                      | IR.S_Exit => (env, stms)
340                      | IR.S_Print(tys, args) => let
341                          val args = List.map (fn e => trExp(env, e)) args
342                          val stm = GenPrint.genPrintStm (
343                                CL.mkIndirect(CL.mkVar "wrld", "_output"),
344                                tys, args)
345                          in
346                            (env, stm::stms)
347                          end
348                      | IR.S_Active => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kActive")) :: stms)
349                      | IR.S_Stabilize => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kStabilize")) :: stms)
350                      | IR.S_Die => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kDie")) :: stms)
351                    (* end case *))
352              in
353                List.rev (#2 (List.foldl trStm (env, []) stms))
354              end
355    
356        and trBlock (env, IR.Block{locals, body}) = let
357              fun trLocal (x, (env, dcls)) = let
358                    val x' = V.name x
359                    val dcl = CL.mkDecl(trType(env, V.ty x), x', NONE)
360                    in
361                      (Env.insert(env, x, x'), dcl :: dcls)
362                    end
363              val (env, dcls) = List.foldl trLocal (env, []) (!locals)
364              in
365                CL.mkBlock (dcls @ trStms (env, body))
366              end
367    
368        fun errorMsgAdd msg =
369              CL.mkCall("biffMsgAdd", [CL.mkIndirect(CL.mkVar "wrld", "_errors"), msg])
370    
371        fun trParam env x = let
372              val x' = V.name x
373              in
374                Env.insert (env, x, x');
375                CL.PARAM([], trType(env, V.ty x), x')
376              end
377    
378    end    end

Legend:
Removed from v.3768  
changed lines
  Added in v.3917

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