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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3873 - (view) (download)
Original Path: branches/vis15/src/compiler/c-util/tree-to-cxx.sml

1 : jhr 3866 (* tree-to-cxx.sml
2 : jhr 3768 *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2016 The University of Chicago
6 :     * All rights reserved.
7 :     *
8 : jhr 3866 * Translate TreeIR to the C++ version of CLang.
9 : jhr 3768 *)
10 :    
11 :    
12 : jhr 3866 structure TreeToCxx : sig
13 : jhr 3768
14 : jhr 3810 val trType : TreeTypes.t -> CLang.ty
15 : jhr 3768
16 : jhr 3873 val trBlock : CodeGenEnv.t * TreeIR.block -> CLang.stm
17 : jhr 3768
18 : jhr 3873 val trExp : CodeGenEnv.t * TreeIR.exp -> CLang.exp
19 : jhr 3768
20 : jhr 3866 (* translate an expression to a variable form; return the variable (as an expression)
21 : jhr 3768 * and the (optional) declaration.
22 :     *)
23 : jhr 3873 val expToVar : CodeGenEnv.t * CLang.ty * string * TreeIR.exp -> CLang.exp * CLang.stm list
24 : jhr 3768
25 : jhr 3873 val trAssign : CodeGenEnv.t * CLang.exp * TreeIR.exp -> CLang.stm list
26 : jhr 3768
27 :     end = struct
28 :    
29 :     structure CL = CLang
30 :     structure IR = TreeIR
31 :     structure Op = TreeOps
32 :     structure Ty = TreeTypes
33 : jhr 3866 structure V = TreeVar
34 : jhr 3873 structure Env = CodeGenEnv
35 : jhr 3768
36 :     datatype var = datatype CL.typed_var
37 :    
38 : jhr 3866 (* translate a local variable that occurs in an l-value context *)
39 : jhr 3873 fun lvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))
40 : jhr 3866 (* translate a variable that occurs in an r-value context *)
41 : jhr 3873 fun rvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))
42 : jhr 3768
43 : jhr 3866 (* translate a global variable that occurs in an l-value context *)
44 : jhr 3873 fun lvalueGlobalVar (env, x) = CL.mkIndirect(Env.global env, TreeGlobalVar.name x)
45 : jhr 3866 (* translate a global variable that occurs in an r-value context *)
46 :     val rvalueGlobalVar = lvalueGlobalVar
47 :    
48 :     (* translate a strand state variable that occurs in an l-value context *)
49 : jhr 3873 fun lvalueStateVar (env, x) = CL.mkIndirect(Env.selfOut env, TreeStateVar.name x)
50 : jhr 3866 (* translate a strand state variable that occurs in an r-value context *)
51 : jhr 3873 fun rvalueStateVar (env, x) = CL.mkIndirect(Env.selfIn env, TreeStateVar.name x)
52 : jhr 3866
53 :     (* generate new variables *)
54 :     local
55 :     val count = ref 0
56 :     fun freshName prefix = let
57 :     val n = !count
58 :     in
59 :     count := n+1;
60 :     concat[prefix, "_", Int.toString n]
61 :     end
62 :     in
63 :     fun tmpVar () = freshName "tmp"
64 :     fun freshVar prefix = freshName prefix
65 :     end (* local *)
66 :    
67 :     (* integer literal expression *)
68 :     fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)
69 :    
70 :     fun addrOf e = CL.mkUnOp(CL.%&, e)
71 :    
72 :     (* make an application of a function from the "std" namespace *)
73 :     fun mkStdApply (f, args) = CL.mkApply("std::" ^ f, args)
74 :    
75 :     (* make an application of a function from the "diderot" namespace *)
76 :     fun mkDiderotApply (f, args) = CL.mkApply("diderot::" ^ f, args)
77 : jhr 3872 fun mkDiderotCall (f, args) = CL.mkCall("diderot::" ^ f, args)
78 : jhr 3866
79 : jhr 3810 (* Translate a TreeIR operator application to a CLang expression *)
80 : jhr 3768 fun trOp (rator, args) = (case (rator, args)
81 : jhr 3870 of (Op.IAdd, [a, b]) => CL.mkBinOp(a, CL.#+, b)
82 : jhr 3768 | (Op.ISub, [a, b]) => CL.mkBinOp(a, CL.#-, b)
83 :     | (Op.IMul, [a, b]) => CL.mkBinOp(a, CL.#*, b)
84 :     | (Op.IDiv, [a, b]) => CL.mkBinOp(a, CL.#/, b)
85 :     | (Op.IMod, [a, b]) => CL.mkBinOp(a, CL.#%, b)
86 :     | (Op.INeg, [a]) => CL.mkUnOp(CL.%-, a)
87 :     | (Op.RAdd, [a, b]) => CL.mkBinOp(a, CL.#+, b)
88 :     | (Op.RSub, [a, b]) => CL.mkBinOp(a, CL.#-, b)
89 :     | (Op.RMul, [a, b]) => CL.mkBinOp(a, CL.#*, b)
90 :     | (Op.RDiv, [a, b]) => CL.mkBinOp(a, CL.#/, b)
91 :     | (Op.RNeg, [a]) => CL.mkUnOp(CL.%-, a)
92 : jhr 3870 | (Op.RClamp, [a, b, c]) => CL.mkApply("clamp", [a, b, c])
93 :     | (Op.RLerp, [a, b, c]) => CL.mkApply("lerp", [a, b, c])
94 : jhr 3768 | (Op.LT ty, [a, b]) => CL.mkBinOp(a, CL.#<, b)
95 :     | (Op.LTE ty, [a, b]) => CL.mkBinOp(a, CL.#<=, b)
96 :     | (Op.EQ ty, [a, b]) => CL.mkBinOp(a, CL.#==, b)
97 :     | (Op.NEQ ty, [a, b]) => CL.mkBinOp(a, CL.#!=, b)
98 :     | (Op.GTE ty, [a, b]) => CL.mkBinOp(a, CL.#>=, b)
99 :     | (Op.GT ty, [a, b]) => CL.mkBinOp(a, CL.#>, b)
100 :     | (Op.Not, [a]) => CL.mkUnOp(CL.%!, a)
101 : jhr 3866 | (Op.Abs ty, args) => mkStdApply("abs", args)
102 :     | (Op.Max ty, args) => mkStdApply("min", args)
103 :     | (Op.Min ty, args) => mkStdApply("max", args)
104 :     | (Op.VAdd d, [a, b]) => CL.mkBinOp(a, CL.#+, b)
105 :     | (Op.VSub d, [a, b]) => CL.mkBinOp(a, CL.#-, b)
106 : jhr 3870 | (Op.VScale d, [a, b]) => CL.mkApply("vscale", [a, b])
107 : jhr 3866 | (Op.VMul d, [a, b]) => CL.mkBinOp(a, CL.#*, b)
108 :     | (Op.VNeg d, [a]) => CL.mkUnOp(CL.%-, a)
109 : jhr 3872 | (Op.VSum d, [a]) => CL.mkApply("vsum", [a])
110 : jhr 3870 | (Op.VIndex(d, i), [a]) => CL.mkSubscript(a, intExp i)
111 :     | (Op.VClamp d, [a, b, c]) => CL.mkApply("clamp", [a, b, c])
112 :     | (Op.VMapClamp d, [a, b, c]) => CL.mkApply("clamp", [a, b, c])
113 :     | (Op.VLerp d, [a, b, c]) => CL.mkApply("lerp", [a, b, c])
114 :     | (Op.TensorIndex(ty, idxs), [a]) => ??
115 :     | (Op.ProjectLast(ty, idxs), [a]) => ??
116 :     | (Op.EigenVals2x2, [a]) => ??
117 :     | (Op.EigenVals3x3, [a]) => ??
118 :     | (Op.Zero ty, []) => ??
119 :     | (Op.Select(ty, i), [a]) => ??
120 :     | (Op.Subscript ty, [a, b]) => ??
121 :     | (Op.MkDynamic(ty, i), [a]) => ??
122 :     | (Op.Append ty, [a, b]) => ??
123 :     | (Op.Prepend ty, [a, b]) => ??
124 :     | (Op.Concat ty, [a, b]) => ??
125 :     | (Op.Range, [a, b]) => ??
126 :     | (Op.Length ty, [a]) => ??
127 :     | (Op.SphereQuery(ty1, ty2), []) => ??
128 :     | (Op.Sqrt, [a]) => mkStdApply("sqrt", [a])
129 :     | (Op.Cos, [a]) => mkStdApply("cos", [a])
130 :     | (Op.ArcCos, [a]) => mkStdApply("acos", [a])
131 :     | (Op.Sin, [a]) => mkStdApply("sin", [a])
132 :     | (Op.ArcSin, [a]) => mkStdApply("asin", [a])
133 :     | (Op.Tan, [a]) => mkStdApply("tan", [a])
134 :     | (Op.ArcTan, [a]) => mkStdApply("atan", [a])
135 :     | (Op.Exp, [a]) => mkStdApply("exp", [a])
136 :     | (Op.Ceiling 1, [a]) => mkStdApply("ceil", [a])
137 :     | (Op.Ceiling d, [a]) => ??
138 :     | (Op.Floor 1, [a]) => mkStdApply("floor", [a])
139 :     | (Op.Floor d, [a]) => ??
140 :     | (Op.Round 1, [a]) => mkStdApply("round", [a])
141 :     | (Op.Round d, [a]) => ??
142 : jhr 3872 | (Op.Trunc 1, [a]) => mkStdApply("trunc", [a])
143 : jhr 3870 | (Op.Trunc d, [a]) => ??
144 :     | (Op.IntToReal, [a]) => ??
145 :     | (Op.RealToInt 1, [a]) => ??
146 :     | (Op.RealToInt d, [a]) => ??
147 : jhr 3768 (*
148 :     | R_All of ty
149 :     | R_Exists of ty
150 :     | R_Max of ty
151 :     | R_Min of ty
152 :     | R_Sum of ty
153 :     | R_Product of ty
154 :     | R_Mean of ty
155 :     | R_Variance of ty
156 :     *)
157 : jhr 3870 | (Op.Transform info, [img]) => ??
158 :     | (Op.Translate info, [img]) => ??
159 :     | (Op.BaseAddress info, [img]) => ??
160 :     | (Op.ControlIndex(info, ctl, i), [a]) => ??
161 :     | (Op.Inside(info, i), [pos, img]) => ??
162 :     | (Op.ImageDim(info, i), [img]) => ??
163 :     | (Op.LoadSeq(ty, file), []) => ??
164 :     | (Op.LoadImage(ty, file), []) => ??
165 :     | (Op.MathFn f, args) => mkStdApply(MathFns.toString f, args)
166 : jhr 3866 | _ => raise Fail(concat[
167 :     "unknown or incorrect operator ", Op.toString rator
168 :     ])
169 : jhr 3768 (* end case *))
170 :    
171 : jhr 3866 fun trExp (env, e) = (case e
172 :     of IR.E_Global x => rvalueGlobalVar (env, x)
173 : jhr 3872 | IR.E_State(NONE, x) => rvalueStateVar (env, x)
174 :     | IR.E_State(SOME e, x) => CL.mkIndirect(trExp(env, e), TreeStateVar.name x)
175 : jhr 3866 | IR.E_Var x => rvalueVar (env, x)
176 :     | IR.E_Lit(Literal.Int n) => CL.mkIntTy(n, !CTyN.gIntTy)
177 :     | IR.E_Lit(Literal.Bool b) => CL.mkBool b
178 : jhr 3870 | IR.E_Lit(Literal.Real f) => CL.mkFlt(f, !CTyN.gRealTy)
179 : jhr 3866 | IR.E_Lit(Literal.String s) => CL.mkStr s
180 :     | IR.E_Op(rator, args) => trOp (rator, trExps(env, args))
181 : jhr 3870 | IR.E_Vec(d, args) => ??
182 :     | IR.E_Cons(args, Ty.TensorTy shape) => ??
183 :     | IR.E_Seq(args, ty) => ??
184 :     | IR.E_Pack(layout, args) => ??
185 :     | IR.E_VLoad(layout, e, i) => ??
186 : jhr 3866 (* end case *))
187 :    
188 :     and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps
189 :    
190 : jhr 3873 (* QUESTION: not sure that we need this function? *)
191 : jhr 3872 fun trExpToVar (env, ty, name, exp) = (case trExp (env, exp)
192 :     of e as CL.E_Var _ => (e, [])
193 :     | e => let
194 :     val x = freshName name
195 :     in
196 :     (CL.mkVar x, pCL.mkDeclInit(ty, x, e))
197 :     end
198 : jhr 3873 (* end case *))
199 : jhr 3872
200 :     fun trRHS mkStm (env, rhs) = (case rhs
201 :     of IR.E_Op(??, args) => ???
202 :     | IR.E_Cons(args, Ty.TensorTy shape) => ??
203 :     | IR.E_Seq(args, ty) => ??
204 :     | _ => mkStm (trExp (env, rhs)) (* generic case *)
205 :     (* end case *))
206 :    
207 :     fun trAssign (env, lhs, rhs) =
208 :     trRHS (fn rhs => CL.mkAssign(lhs, rhs)) (env, rhs)
209 :    
210 :     fun trDecl (env, ty, lhs, rhs) =
211 :     trRHS (fn rhs => CL.mkDeclInit(ty, lhs, rhs)) (env, rhs)
212 :    
213 : jhr 3870 fun trMultiAssign (env, lhs, IR.E_Op(rator, args)) = (case (lhs, rator, args)
214 : jhr 3872 of ([vals, vecs], Op.EigenVecs2x2, [m]) =>
215 :     mkDiderotCall("eigenvecs", [trExp (env, exp), vals, vecs])
216 : jhr 3873 | ([vals, vecs], Op.EigenVecs3x3, [m]) =>
217 : jhr 3872 mkDiderotCall("eigenvecs", [trExp (env, exp), vals, vecs])
218 : jhr 3870 | _ => raise Fail "bogus multi-assignment"
219 :     (* end case *))
220 :     | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"
221 : jhr 3866
222 : jhr 3872 fun trStms (env, stms : TreeIR.stm list) = let
223 : jhr 3870 fun trStm (stm, (env, stms : CL.stm list)) = (case stm
224 :     of IR.S_Comment text => (env, CL.mkComment text :: stms)
225 : jhr 3872 | IR.S_Assign(true, x, exp) => let
226 : jhr 3873 val (env, stm) = trDecl (env, ??, Env.lookup (env, x), exp)
227 : jhr 3872 in
228 :     (env, stm::stms)
229 :     end
230 :     | IR.S_Assign(false, x, exp) => let
231 : jhr 3866 val (env, stm) = trAssign (env, lvalueVar (env, x), exp)
232 :     in
233 :     (env, stm::stms)
234 :     end
235 :     | IR.S_MAssign(xs, exp) =>
236 : jhr 3870 (env, trMultiAssign (env, List.map (fn x => lvalueVar (env, x)) xs, exp) @ stms)
237 : jhr 3866 | IR.S_GAssign(x, exp) =>
238 :     (env, trAssign (env, lvalueGlobalVar (env, x), exp) :: stms)
239 :     | IR.S_IfThen(cond, thenBlk) =>
240 : jhr 3870 (env, CL.mkIfThen(trExp(env, cond), trBlock(env, thenBlk)) :: stms)
241 : jhr 3866 | IR.S_IfThenElse(cond, thenBlk, elseBlk) => let
242 :     val stm = CL.mkIfThenElse(trExp(env, cond),
243 : jhr 3870 trBlock(env, thenBlk),
244 :     trBlock(env, elseBlk))
245 : jhr 3866 in
246 :     (env, stm :: stms)
247 :     end
248 :     | IR.S_Foreach(x, IR.E_Op(Op.Range, [lo, hi]), blk) => ??
249 :     | IR.S_Foreach(x, e, blk) => ??
250 :     | IR.S_New(strand, args) => ??
251 :     | IR.S_Save(x, exp) => trAssign (env, lvalueStateVar(env, x), exp)
252 : jhr 3870 | IR.S_LoadNrrd(lhs, Ty.SeqTy(ty, NONE), nrrd) =>
253 :     (env, GenLoadNrrd.loadSeqFromFile (lvalueVar (env, lhs), ty, CL.mkStr nrrd) :: stms)
254 : jhr 3866 | IR.S_LoadNrrd(lhs, Ty.ImageTy info, nrrd) =>
255 : jhr 3870 (env, GenLoadNrrd.loadImage (lvalueVar (env, lhs), info, CL.mkStr nrrd) :: stms)
256 :     | IR.S_Input(_, _, _, NONE) => (env, stms)
257 :     | IR.S_Input(gv, name, _, SOME dflt) =>
258 :     (env, CL.mkAssign(lvalueGlobalVar (env, gv), trExp(env, dflt)) :: stms)
259 : jhr 3866 | IR.S_InputNrrd _ => (env, stms)
260 : jhr 3870 | IR.S_Exit => (env, stms)
261 :     | IR.S_Print(tys, args) => let
262 :     val args = List.map (fn e => trExp(env, e)) args
263 :     val stm = GenPrint.genPrintStm (
264 :     CL.mkIndirect(CL.mkVar "wrld", "_output"),
265 :     tys, args)
266 :     in
267 :     (env, stm::stms)
268 :     end
269 : jhr 3866 | IR.S_Active => (env, CL.mkReturn(SOME(CL.mkVar RN.kActive)) :: stms)
270 :     | IR.S_Stabilize => (env, CL.mkReturn(SOME(CL.mkVar RN.kStabilize)) :: stms)
271 :     | IR.S_Die => (env, CL.mkReturn(SOME(CL.mkVar RN.kDie)) :: stms)
272 :     (* end case *))
273 :     in
274 :     List.rev (#2 (List.foldl trStm (env, []) stms))
275 :     end
276 :    
277 :     and trBlock (env, IR.Block{locals, body}) = let
278 : jhr 3873 fun trLocal (x, (env, dcls)) = let
279 :     val x' = V.name x
280 :     in
281 :     (Env.insert(env, x, x'), CL.mkDecl(ty, x', NONE) :: dcls)
282 :     end
283 :     val (env, dcls) = List.foldl trLocal (env, []) (!locals)
284 : jhr 3866 in
285 : jhr 3873 CL.mkBlock (dcls @ trStms (env, body))
286 : jhr 3866 end
287 :    
288 : jhr 3768 end

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