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

SCM Repository

[diderot] Annotation of /trunk/src/compiler/high-to-mid/high-to-mid.sml
ViewVC logotype

Annotation of /trunk/src/compiler/high-to-mid/high-to-mid.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3349 - (view) (download)

1 : jhr 280 (* high-to-mid.sml
2 :     *
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 280 * All rights reserved.
7 :     *
8 :     * Translation from HighIL to MidIL representations.
9 :     *)
10 :    
11 :     structure HighToMid : sig
12 :    
13 :     val translate : HighIL.program -> MidIL.program
14 :    
15 :     end = struct
16 :    
17 :     structure SrcIL = HighIL
18 : jhr 392 structure SrcTy = HighILTypes
19 : jhr 334 structure SrcOp = HighOps
20 : jhr 1640 structure SrcSV = SrcIL.StateVar
21 : jhr 364 structure VTbl = SrcIL.Var.Tbl
22 : jhr 280 structure DstIL = MidIL
23 : jhr 391 structure DstTy = MidILTypes
24 : jhr 334 structure DstOp = MidOps
25 : jhr 2636 structure InP = Inputs
26 : jhr 280
27 : jhr 1116 fun getRHS x = (case SrcIL.Var.binding x
28 : jhr 2356 of SrcIL.VB_RHS(SrcIL.OP(rator, args)) => (rator, args)
29 :     | SrcIL.VB_RHS(SrcIL.VAR x') => getRHS x'
30 :     | vb => raise Fail(concat[
31 :     "expected rhs operator for ", SrcIL.Var.toString x,
32 :     "but found ", SrcIL.vbToString vb
33 :     ])
34 :     (* end case *))
35 : jhr 1116
36 : jhr 2636 fun getRHSImage x = (case getRHS x
37 :     of (SrcOp.LoadImage(_, _, v), _) => v
38 :     | (SrcOp.Input(InP.INP{init=SOME(InP.Proxy(_, v)), ...}), _) => v
39 :     | (SrcOp.Input(InP.INP{init=SOME(InP.Image v), ...}), _) => v
40 :     | _ => raise Fail "bogus image variable"
41 :     (* end case *))
42 :    
43 : jhr 394 fun cvtTy SrcTy.BoolTy = DstTy.BoolTy
44 :     | cvtTy SrcTy.StringTy = DstTy.StringTy
45 :     | cvtTy SrcTy.IntTy = DstTy.intTy
46 : jhr 1116 | cvtTy (SrcTy.TensorTy dd) = DstTy.tensorTy dd
47 : jhr 1640 | cvtTy (SrcTy.TupleTy tys) = DstTy.TupleTy(List.map cvtTy tys)
48 :     | cvtTy (SrcTy.SeqTy(ty, n)) = DstTy.SeqTy(cvtTy ty, n)
49 : jhr 1116 (* we replace Kernel and Field operations by 0, so the types are mapped to int *)
50 :     | cvtTy SrcTy.KernelTy = DstTy.intTy
51 :     | cvtTy SrcTy.FieldTy = DstTy.intTy
52 : jhr 397 | cvtTy ty = raise Fail("unexpected type " ^ SrcTy.toString ty)
53 : jhr 394
54 : jhr 1640 (* instantiate the translation environment *)
55 :     local
56 :     type var_env = DstIL.var VTbl.hash_table
57 :     type state_var_env = DstIL.state_var SrcSV.Tbl.hash_table
58 :    
59 :     fun rename (env : var_env, x) = (case VTbl.find env x
60 :     of SOME x' => x'
61 :     | NONE => let
62 :     val dstTy = (case SrcIL.Var.ty x
63 : jhr 2636 of SrcTy.ImageTy _ =>
64 : jhr 1640 (* for variables with image type, we need more detailed information
65 :     * about the image for the MidIL type.
66 :     *)
67 : jhr 2636 DstTy.ImageTy(getRHSImage x)
68 : jhr 1640 | _ => cvtTy(SrcIL.Var.ty x)
69 :     (* end case *))
70 :     val x' = DstIL.Var.new (SrcIL.Var.name x, dstTy)
71 :     in
72 :     VTbl.insert env (x, x');
73 :     x'
74 :     end
75 :     (* end case *))
76 : jhr 1116 handle Fail msg => raise Fail(concat["rename(_, ", SrcIL.Var.toString x, "): ", msg])
77 :    
78 : jhr 2356 fun renameSV (env : state_var_env, x) = (case SrcSV.Tbl.find env x
79 :     of SOME x' => x'
80 :     | NONE => let
81 :     val dstTy = cvtTy (SrcSV.ty x)
82 :     val x' = DstIL.StateVar.new (SrcSV.isOutput x, SrcSV.name x, dstTy)
83 :     in
84 :     SrcSV.Tbl.insert env (x, x');
85 :     x'
86 :     end
87 :     (* end case *))
88 : jhr 1640 in
89 :     structure Env = TranslateEnvFn (
90 :     struct
91 :     structure SrcIL = SrcIL
92 :     structure DstIL = DstIL
93 :     type var_env = var_env
94 :     type state_var_env = state_var_env
95 :     val rename = rename
96 :     val renameSV = renameSV
97 :     end)
98 :     end
99 : jhr 334
100 : jhr 1116 (* expand raising a real to an integer power. When we know the exponent, we can inline
101 :     * multiplications.
102 :     *)
103 :     fun expandPower (env, y, [x, n]) = let
104 : jhr 2356 fun getConst x = (case SrcIL.Var.binding x
105 :     of SrcIL.VB_RHS(SrcIL.VAR x') => getConst x'
106 :     | SrcIL.VB_RHS(SrcIL.LIT(Literal.Int n)) => SOME n
107 :     | vb => NONE
108 :     (* end case *))
109 :     val x = Env.rename(env, x)
110 :     fun pow () = let
111 :     val t = DstIL.Var.new("n", DstTy.realTy)
112 :     in [
113 :     (t, DstIL.OP(DstOp.IntToReal, [Env.rename(env, n)])),
114 :     (y, DstIL.APPLY(MathFuns.pow, [x, t]))
115 :     ] end
116 :     in
117 :     case getConst n
118 :     of SOME 0 => [(y, DstIL.LIT(Literal.Float(FloatLit.one)))]
119 :     | SOME 1 => [(y, DstIL.VAR x)]
120 :     | SOME ~1 => let
121 :     val t = DstIL.Var.new("one", DstTy.realTy)
122 :     in [
123 :     (t, DstIL.LIT(Literal.Float(FloatLit.one))),
124 :     (y, DstIL.OP(DstOp.Div DstTy.realTy, [t, x]))
125 :     ] end
126 : jhr 1640 | SOME 2 => [(y, DstIL.OP(DstOp.Mul DstTy.realTy, [x, x]))]
127 : jhr 3082 (* FIXME: expand into multiplications
128 : jhr 2356 | SOME n =>
129 : jhr 1116 *) | SOME _ => pow()
130 : jhr 2356 | NONE => pow()
131 : jhr 3082 (* end case *)
132 : jhr 2356 end
133 : jhr 280
134 : jhr 1116 (* expand the field Inside operator into a image-space test *)
135 :     fun expandInside (env, result, pos, fld) = (case getRHS fld
136 : jhr 2636 of (SrcOp.Field d, [img, h]) => (case (getRHSImage img, getRHS h)
137 :     of (v, (SrcOp.Kernel(h, _), [])) => let
138 : jhr 2356 val pos = Env.rename (env, pos)
139 :     val img = Env.rename (env, img)
140 :     val imgPos = DstIL.Var.new ("x", DstTy.vecTy d)
141 :     val s = Kernel.support h
142 :     in [
143 :     (imgPos, DstIL.OP(DstOp.PosToImgSpace v, [img, pos])),
144 :     (result, DstIL.OP(DstOp.Inside(v, s), [imgPos, img]))
145 :     ] end
146 :     | _ => raise Fail "bogus kernel binding"
147 :     (* end case *))
148 :     | _ => raise Fail "bogus field binding"
149 :     (* end case *))
150 : jhr 1116
151 :     fun expandProbe (env, result, fld, pos) = (case getRHS fld
152 : jhr 2636 of (SrcOp.Field _, [img, h]) => (case (getRHSImage img, getRHS h)
153 :     of (v, (SrcOp.Kernel(h, k), _)) => Probe.expand {
154 : jhr 2356 result = result,
155 :     img = Env.rename (env, img),
156 :     v = v, h = h, k = k,
157 :     pos = Env.rename (env, pos)
158 :     }
159 :     | _ => raise Fail "bogus image/kernel binding"
160 :     (* end case *))
161 :     | _ => raise Fail "bogus field binding"
162 :     (* end case *))
163 : jhr 1116
164 :     (* expand the outer product of vectors v1 and v2, with dimensions d1 and d2 (resp.) *)
165 :     fun expandOuter (env, y, d1, d2, v1, v2) = let
166 : jhr 2356 val rowTy = DstTy.tensorTy[d1]
167 :     val colTy = DstTy.tensorTy[d2]
168 :     fun mkVar (i, j) = DstIL.Var.new (concat["o_", Int.toString i, "_", Int.toString j], DstTy.realTy)
169 :     fun mkRowVar i = DstIL.Var.new ("r_" ^ Int.toString i, DstTy.TensorTy[d2])
170 :     fun rowLp (i, rowVars, code) = if (i < d1)
171 :     then let
172 :     fun colLp (j, colVars, code) = if (j < d2)
173 :     then let
174 :     val a = DstIL.Var.new("a", DstTy.realTy)
175 :     val b = DstIL.Var.new("b", DstTy.realTy)
176 :     val x = mkVar (i, j)
177 :     val code = (x, DstIL.OP(DstOp.Mul DstTy.realTy, [a, b]))
178 :     :: (b, DstIL.OP(DstOp.Index(colTy, j), [v2]))
179 :     :: (a, DstIL.OP(DstOp.Index(rowTy, i), [v1]))
180 :     :: code
181 :     in
182 :     colLp (j+1, x::colVars, code)
183 :     end
184 :     else let
185 :     val r = mkRowVar i
186 :     in
187 :     rowLp (i+1, r::rowVars,
188 :     (r, DstIL.CONS(rowTy, List.rev colVars)) :: code)
189 :     end
190 :     in
191 :     colLp (0, [], code)
192 :     end
193 :     else List.rev ((y, DstIL.CONS(DstTy.TensorTy[d1,d2], List.rev rowVars)) :: code)
194 :     in
195 :     rowLp (0, [], [])
196 :     end
197 : jhr 334
198 : jhr 392 fun arity (SrcTy.TensorTy[]) = 1
199 :     | arity (SrcTy.TensorTy[d]) = d
200 : jhr 365 | arity _ = raise Fail "arity"
201 :    
202 : jhr 364 fun expandOp (env, y, rator, args) = let
203 : jhr 2356 fun assign rator' =
204 :     [(y, DstIL.OP(rator', Env.renameList(env, args)))]
205 :     fun cvtToInt rator' = let
206 :     val t = DstIL.Var.new ("t", DstTy.realTy)
207 :     in [
208 :     (t, DstIL.OP(rator', Env.renameList(env, args))),
209 :     (y, DstIL.OP(DstOp.RealToInt 1, [t]))
210 :     ] end
211 :     fun dummy () = [(y, DstIL.LIT(Literal.Int 0))]
212 :     in
213 :     case rator
214 :     of SrcOp.Add ty => assign (DstOp.Add(cvtTy ty))
215 :     | SrcOp.Sub ty => assign (DstOp.Sub(cvtTy ty))
216 :     | SrcOp.Mul ty => assign (DstOp.Mul(cvtTy ty))
217 :     | SrcOp.Div ty => assign (DstOp.Div(cvtTy ty))
218 :     | SrcOp.Neg ty => assign (DstOp.Neg(cvtTy ty))
219 :     | SrcOp.Abs ty => assign (DstOp.Abs(cvtTy ty))
220 :     | SrcOp.LT ty => assign (DstOp.LT(cvtTy ty))
221 :     | SrcOp.LTE ty => assign (DstOp.LTE(cvtTy ty))
222 :     | SrcOp.EQ ty => assign (DstOp.EQ(cvtTy ty))
223 :     | SrcOp.NEQ ty => assign (DstOp.NEQ(cvtTy ty))
224 :     | SrcOp.GT ty => assign (DstOp.GT(cvtTy ty))
225 :     | SrcOp.GTE ty => assign (DstOp.GTE(cvtTy ty))
226 :     | SrcOp.Power => expandPower(env, y, args)
227 :     | SrcOp.Not => assign DstOp.Not
228 :     | SrcOp.Max => assign DstOp.Max
229 :     | SrcOp.Min => assign DstOp.Min
230 :     | SrcOp.Clamp ty => assign (DstOp.Clamp(cvtTy ty))
231 :     | SrcOp.Lerp ty => assign (DstOp.Lerp(cvtTy ty))
232 :     | SrcOp.Dot ty => assign (DstOp.Dot(arity ty))
233 :     | SrcOp.MulVecMat(SrcTy.TensorTy[d1, d2]) => assign (DstOp.MulVecMat(d1, d2))
234 :     | SrcOp.MulMatVec(SrcTy.TensorTy[d1, d2]) => assign (DstOp.MulMatVec(d1, d2))
235 :     | SrcOp.MulMatMat(SrcTy.TensorTy[d1, d2], SrcTy.TensorTy[d2', d3]) =>
236 :     assign (DstOp.MulMatMat(d1, d2, d3))
237 :     | SrcOp.MulVecTen3(SrcTy.TensorTy[d1, d2, d3]) => assign(DstOp.MulVecTen3(d1, d2, d3))
238 :     | SrcOp.MulTen3Vec(SrcTy.TensorTy[d1, d2, d3]) => assign(DstOp.MulTen3Vec(d1, d2, d3))
239 :     | SrcOp.ColonMul(ty1, ty2) => assign(DstOp.ColonMul(cvtTy ty1, cvtTy ty2))
240 :     | SrcOp.Cross => assign DstOp.Cross
241 :     | SrcOp.Outer(SrcTy.TensorTy[d1, d2]) => let
242 :     val [v1, v2] = Env.renameList(env, args)
243 :     in
244 :     expandOuter (env, y, d1, d2, v1, v2)
245 :     end
246 :     | SrcOp.Norm ty => assign (DstOp.Norm(cvtTy ty))
247 :     | SrcOp.Normalize ty => assign (DstOp.Normalize(arity ty))
248 :     | SrcOp.Scale ty => assign (DstOp.Scale(cvtTy ty))
249 :     | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec(cvtTy ty))
250 :     | SrcOp.Identity n => assign (DstOp.Identity n)
251 :     | SrcOp.Zero ty => assign (DstOp.Zero(cvtTy ty))
252 :     | SrcOp.Trace(SrcTy.TensorTy[d, _]) => assign (DstOp.Trace d)
253 : jhr 3082 | SrcOp.Transpose(d1, d2) => assign (DstOp.Transpose(d1, d2))
254 : jhr 2356 | SrcOp.Slice(ty, mask) => raise Fail "FIXME: Slice"
255 : jhr 1640 | SrcOp.TensorSub(ty as SrcTy.TensorTy _) => assign (DstOp.Subscript(cvtTy ty))
256 :     | SrcOp.Select(ty as SrcTy.TupleTy _, i) => assign (DstOp.Select(cvtTy ty, i))
257 :     | SrcOp.Select(ty as SrcTy.SeqTy _, i) => assign (DstOp.Index(cvtTy ty, i))
258 : jhr 2356 | SrcOp.SeqSub(ty as SrcTy.SeqTy _) => assign (DstOp.Subscript(cvtTy ty))
259 :     | SrcOp.IntToReal => assign DstOp.IntToReal
260 :     | SrcOp.TruncToInt => cvtToInt (DstOp.Trunc 1)
261 :     | SrcOp.RoundToInt => cvtToInt (DstOp.Round 1)
262 :     | SrcOp.CeilToInt => cvtToInt (DstOp.Ceiling 1)
263 :     | SrcOp.FloorToInt => cvtToInt (DstOp.Floor 1)
264 :     | SrcOp.Kernel _ => dummy()
265 :     | SrcOp.Inside _ => (case args
266 :     of [pos, fld] => expandInside(env, y, pos, fld)
267 :     (* end case *))
268 :     | SrcOp.Probe _ => (case args
269 :     of [fld, pos] => expandProbe(env, y, fld, pos)
270 :     (* end case *))
271 :     (* fields are used in the Inside and Probe operations, but are otherwise ignored *)
272 :     | SrcOp.Field _ => dummy()
273 :     | SrcOp.AddField => dummy()
274 :     | SrcOp.SubField => dummy()
275 :     | SrcOp.ScaleField => dummy()
276 :     | SrcOp.NegField => dummy()
277 :     | SrcOp.DiffField => dummy()
278 : jhr 2636 | SrcOp.LoadImage(ty, nrrd, info) =>
279 :     assign (DstOp.LoadImage(DstTy.ImageTy info, nrrd, info))
280 :     | SrcOp.Input inp => (case Inputs.imageInfo inp
281 :     of SOME info => let
282 :     val Inputs.INP{name, desc, init, ...} = inp
283 :     in
284 :     assign (DstOp.Input(Inputs.INP{
285 :     ty = DstTy.ImageTy info,
286 :     name = name, desc = desc,
287 :     init = init
288 :     }))
289 :     end
290 :     | _ => assign (DstOp.Input(Inputs.map cvtTy inp))
291 :     (* end case *))
292 : jhr 2356 | rator => raise Fail("bogus operator " ^ SrcOp.toString rator)
293 :     (* end case *)
294 :     end
295 :     handle ex => (print(concat["error converting ", SrcOp.toString rator, "\n"]); raise ex)
296 : jhr 314
297 : jhr 387 (* expand a SrcIL assignment to a list of DstIL assignments *)
298 : jhr 364 fun expand (env, (y, rhs)) = let
299 : jhr 2356 fun assign rhs = [DstIL.ASSGN(Env.rename (env, y), rhs)]
300 :     in
301 :     case rhs
302 :     of SrcIL.STATE x => assign (DstIL.STATE(Env.renameSV(env, x)))
303 : jhr 1640 | SrcIL.VAR x => assign (DstIL.VAR(Env.rename(env, x)))
304 : jhr 2356 | SrcIL.LIT lit => assign (DstIL.LIT lit)
305 :     | SrcIL.OP(rator, args) =>
306 : jhr 1640 List.map DstIL.ASSGN (expandOp (env, Env.rename (env, y), rator, args))
307 : jhr 2356 | SrcIL.APPLY(f, args) => assign(DstIL.APPLY(f, Env.renameList(env, args)))
308 :     | SrcIL.CONS(ty, args) => assign (DstIL.CONS(cvtTy ty, Env.renameList(env, args)))
309 :     (* end case *)
310 :     end
311 : jhr 364
312 : jhr 1640 (* expand a SrcIL multi-assignment to a DstIL CFG *)
313 :     fun mexpand (env, (ys, rator, xs)) = let
314 :     val ys' = Env.renameList(env, ys)
315 :     val rator' = (case rator
316 :     of SrcOp.Eigen2x2 => DstOp.EigenVecs2x2
317 :     | SrcOp.Eigen3x3 => DstOp.EigenVecs3x3
318 :     | SrcOp.Print tys => DstOp.Print(List.map cvtTy tys)
319 :     | _ => raise Fail("bogus operator " ^ SrcOp.toString rator)
320 :     (* end case *))
321 :     val xs' = Env.renameList(env, xs)
322 :     val nd = DstIL.Node.mkMASSIGN(ys', rator', xs')
323 :     in
324 :     DstIL.CFG{entry=nd, exit=nd}
325 :     end
326 :    
327 : jhr 364 structure Trans = TranslateFn (
328 :     struct
329 : jhr 2356 open Env
330 :     val expand = DstIL.CFG.mkBlock o expand
331 : jhr 1640 val mexpand = mexpand
332 : jhr 364 end)
333 :    
334 : jhr 1116 fun translate prog = let
335 : jhr 2356 val prog = Trans.translate prog
336 :     in
337 :     MidILCensus.init prog;
338 :     prog
339 :     end
340 : jhr 364
341 : jhr 280 end

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