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

SCM Repository

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

Annotation of /branches/pure-cfg/src/compiler/high-to-mid/high-to-mid.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 824 - (view) (download)

1 : jhr 280 (* high-to-mid.sml
2 :     *
3 : jhr 435 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 : jhr 280 * All rights reserved.
5 :     *
6 :     * Translation from HighIL to MidIL representations.
7 :     *)
8 :    
9 :     structure HighToMid : sig
10 :    
11 :     val translate : HighIL.program -> MidIL.program
12 :    
13 :     end = struct
14 :    
15 :     structure SrcIL = HighIL
16 : jhr 392 structure SrcTy = HighILTypes
17 : jhr 334 structure SrcOp = HighOps
18 : jhr 364 structure VTbl = SrcIL.Var.Tbl
19 : jhr 280 structure DstIL = MidIL
20 : jhr 391 structure DstTy = MidILTypes
21 : jhr 334 structure DstOp = MidOps
22 : jhr 280
23 : jhr 367 type var_env = DstIL.var VTbl.hash_table
24 : jhr 364
25 : jhr 548 fun getRHS x = (case SrcIL.Var.binding x
26 :     of SrcIL.VB_RHS(SrcIL.OP(rator, args)) => (rator, args)
27 : jhr 794 | SrcIL.VB_RHS(SrcIL.VAR x') => getRHS x'
28 :     | vb => raise Fail(concat[
29 :     "expected rhs operator for ", SrcIL.Var.toString x,
30 :     "but found ", SrcIL.vbToString vb
31 :     ])
32 : jhr 548 (* end case *))
33 :    
34 : jhr 394 fun cvtTy SrcTy.BoolTy = DstTy.BoolTy
35 :     | cvtTy SrcTy.StringTy = DstTy.StringTy
36 :     | cvtTy SrcTy.IntTy = DstTy.intTy
37 : jhr 736 | cvtTy (SrcTy.TensorTy dd) = DstTy.tensorTy dd
38 : jhr 517 (* we replace Kernel and Field operations by 0, so the types are mapped to int *)
39 :     | cvtTy SrcTy.KernelTy = DstTy.intTy
40 :     | cvtTy SrcTy.FieldTy = DstTy.intTy
41 : jhr 397 | cvtTy ty = raise Fail("unexpected type " ^ SrcTy.toString ty)
42 : jhr 394
43 : jhr 364 fun rename (env : var_env, x) = (case VTbl.find env x
44 : jhr 334 of SOME x' => x'
45 : jhr 364 | NONE => let
46 : jhr 548 val dstTy = (case SrcIL.Var.ty x
47 :     of SrcTy.ImageTy _ => (
48 :     (* for variables with image type, we need more detailed information
49 :     * about the image for the MidIL type.
50 :     *)
51 :     case getRHS x
52 :     of (SrcOp.LoadImage v, _) => DstTy.ImageTy v
53 :     | _ => raise Fail "bogus image variable"
54 :     (* end case *))
55 :     | _ => cvtTy(SrcIL.Var.ty x)
56 :     (* end case *))
57 :     val x' = DstIL.Var.new (SrcIL.Var.name x, dstTy)
58 : jhr 364 in
59 :     VTbl.insert env (x, x');
60 :     x'
61 :     end
62 : jhr 334 (* end case *))
63 : jhr 517 handle Fail msg => raise Fail(concat["rename(_, ", SrcIL.Var.toString x, "): ", msg])
64 :    
65 : jhr 367 fun renameList (env, xs) = List.map (fn x => rename(env, x)) xs
66 : jhr 334
67 : jhr 824 (* expand raising a real to an integer power. When we know the exponent, we can inline
68 :     * multiplications.
69 :     *)
70 :     fun expandPower (env, y, [x, n]) = let
71 :     fun getConst x = (case SrcIL.Var.binding x
72 :     of SrcIL.VB_RHS(SrcIL.VAR x') => getConst x'
73 :     | SrcIL.VB_RHS(SrcIL.LIT(Literal.Int n)) => SOME n
74 :     | vb => NONE
75 :     (* end case *))
76 :     val x = rename(env, x)
77 :     fun pow () = let
78 :     val t = DstIL.Var.new("n", DstTy.realTy)
79 :     in [
80 :     (t, DstIL.OP(DstOp.IntToReal, [rename(env, n)])),
81 :     (y, DstIL.APPLY(ILBasis.pow, [x, t]))
82 :     ] end
83 :     in
84 :     case getConst n
85 :     of SOME 0 => [(y, DstIL.LIT(Literal.Float(FloatLit.one)))]
86 :     | SOME 1 => [(y, DstIL.VAR x)]
87 :     | SOME ~1 => let
88 :     val t = DstIL.Var.new("one", DstTy.realTy)
89 :     in [
90 :     (t, DstIL.LIT(Literal.Float(FloatLit.one))),
91 :     (y, DstIL.OP(DstOp.Div DstTy.realTy, [t, x]))
92 :     ] end
93 :     (* FIXME: expand into multiplications
94 :     | SOME n =>
95 :     *) | SOME _ => pow()
96 :     | NONE => pow()
97 :     end
98 :    
99 : jhr 280 (* expand the field Inside operator into a image-space test *)
100 : jhr 517 fun expandInside (env, result, pos, fld) = (case getRHS fld
101 : jhr 548 of (SrcOp.Field d, [img, h]) => (case (getRHS img, getRHS h)
102 :     of ((SrcOp.LoadImage v, _), (SrcOp.Kernel(h, _), [])) => let
103 : jhr 546 val pos = rename (env, pos)
104 :     val img = rename (env, img)
105 : jhr 736 val imgPos = DstIL.Var.new ("x", DstTy.vecTy d)
106 : jhr 546 val s = Kernel.support h
107 :     in [
108 : jhr 548 (imgPos, DstIL.OP(DstOp.PosToImgSpace v, [img, pos])),
109 :     (result, DstIL.OP(DstOp.Inside(v, s), [imgPos, img]))
110 : jhr 546 ] end
111 :     | _ => raise Fail "bogus kernel binding"
112 :     (* end case *))
113 : jhr 517 | _ => raise Fail "bogus field binding"
114 :     (* end case *))
115 : jhr 280
116 : jhr 517 fun expandProbe (env, result, fld, pos) = (case getRHS fld
117 : jhr 548 of (SrcOp.Field _, [img, h]) => (case (getRHS img, getRHS h)
118 : jhr 517 of ((SrcOp.LoadImage v, _), (SrcOp.Kernel(h, k), _)) => Probe.expand {
119 :     result = result,
120 :     img = rename (env, img),
121 :     v = v, h = h, k = k,
122 :     pos = rename (env, pos)
123 :     }
124 :     | _ => raise Fail "bogus image/kernel binding"
125 : jhr 358 (* end case *))
126 : jhr 517 | _ => raise Fail "bogus field binding"
127 :     (* end case *))
128 : jhr 334
129 : jhr 820 (* expand the outer product of vectors v1 and v2, with dimensions d1 and d2 (resp.) *)
130 :     fun expandOuter (env, y, d1, d2, v1, v2) = let
131 :     val rowTy = DstTy.tensorTy[d1]
132 :     val colTy = DstTy.tensorTy[d2]
133 :     fun mkVar (i, j) = DstIL.Var.new (concat["o_", Int.toString i, "_", Int.toString j], DstTy.realTy)
134 :     fun mkRowVar i = DstIL.Var.new ("r_" ^ Int.toString i, DstTy.TensorTy[d2])
135 :     fun rowLp (i, rowVars, code) = if (i < d1)
136 :     then let
137 :     fun colLp (j, colVars, code) = if (j < d2)
138 :     then let
139 :     val a = DstIL.Var.new("a", DstTy.realTy)
140 :     val ix = DstIL.Var.new("i", DstTy.intTy)
141 :     val b = DstIL.Var.new("b", DstTy.realTy)
142 :     val jx = DstIL.Var.new("j", DstTy.intTy)
143 :     val x = mkVar (i, j)
144 :     val code = (x, DstIL.OP(DstOp.Mul DstTy.realTy, [a, b]))
145 : jhr 821 :: (b, DstIL.OP(DstOp.Subscript colTy, [v2, jx]))
146 :     :: (jx, DstIL.LIT(Literal.intLit j))
147 : jhr 820 :: (a, DstIL.OP(DstOp.Subscript rowTy, [v1, ix]))
148 :     :: (ix, DstIL.LIT(Literal.intLit i))
149 :     :: code
150 :     in
151 :     colLp (j+1, x::colVars, code)
152 :     end
153 :     else let
154 :     val r = mkRowVar i
155 :     in
156 : jhr 821 rowLp (i+1, r::rowVars,
157 :     (r, DstIL.CONS(rowTy, List.rev colVars)) :: code)
158 : jhr 820 end
159 :     in
160 :     colLp (0, [], code)
161 :     end
162 :     else List.rev ((y, DstIL.CONS(DstTy.TensorTy[d1,d2], List.rev rowVars)) :: code)
163 :     in
164 :     rowLp (0, [], [])
165 :     end
166 :    
167 : jhr 392 fun arity (SrcTy.TensorTy[]) = 1
168 :     | arity (SrcTy.TensorTy[d]) = d
169 : jhr 365 | arity _ = raise Fail "arity"
170 :    
171 : jhr 364 fun expandOp (env, y, rator, args) = let
172 : jhr 365 fun assign rator' =
173 : jhr 367 [(y, DstIL.OP(rator', renameList(env, args)))]
174 : jhr 565 fun cvtToInt rator' = let
175 :     val t = DstIL.Var.new ("t", DstTy.realTy)
176 :     in [
177 :     (t, DstIL.OP(rator', renameList(env, args))),
178 :     (y, DstIL.OP(DstOp.RealToInt 1, [t]))
179 :     ] end
180 : jhr 517 fun dummy () = [(y, DstIL.LIT(Literal.Int 0))]
181 : jhr 364 in
182 :     case rator
183 : jhr 365 of SrcOp.Add ty => assign (DstOp.Add(cvtTy ty))
184 :     | SrcOp.Sub ty => assign (DstOp.Sub(cvtTy ty))
185 :     | SrcOp.Mul ty => assign (DstOp.Mul(cvtTy ty))
186 :     | SrcOp.Div ty => assign (DstOp.Div(cvtTy ty))
187 :     | SrcOp.Neg ty => assign (DstOp.Neg(cvtTy ty))
188 : jhr 717 | SrcOp.Abs ty => assign (DstOp.Abs(cvtTy ty))
189 : jhr 365 | SrcOp.LT ty => assign (DstOp.LT(cvtTy ty))
190 :     | SrcOp.LTE ty => assign (DstOp.LTE(cvtTy ty))
191 :     | SrcOp.EQ ty => assign (DstOp.EQ(cvtTy ty))
192 :     | SrcOp.NEQ ty => assign (DstOp.NEQ(cvtTy ty))
193 :     | SrcOp.GT ty => assign (DstOp.GT(cvtTy ty))
194 :     | SrcOp.GTE ty => assign (DstOp.GTE(cvtTy ty))
195 : jhr 824 | SrcOp.Power => expandPower(env, y, args)
196 : jhr 754 | SrcOp.Not => assign DstOp.Not
197 :     | SrcOp.Max => assign DstOp.Max
198 :     | SrcOp.Min => assign DstOp.Min
199 :     | SrcOp.Lerp ty => assign (DstOp.Lerp(cvtTy ty))
200 : jhr 365 | SrcOp.Dot ty => assign (DstOp.Dot(arity ty))
201 : jhr 807 | SrcOp.MulVecMat(SrcTy.TensorTy[d1, d2]) => assign (DstOp.MulVecMat(d1, d2))
202 :     | SrcOp.MulMatVec(SrcTy.TensorTy[d1, d2]) => assign (DstOp.MulMatVec(d1, d2))
203 :     | SrcOp.MulMatMat(SrcTy.TensorTy[d1, d2], SrcTy.TensorTy[d2', d3]) =>
204 :     assign (DstOp.MulMatMat(d1, d2, d3))
205 : jhr 365 | SrcOp.Cross => assign DstOp.Cross
206 : jhr 820 | SrcOp.Outer(SrcTy.TensorTy[d1, d2]) => let
207 :     val [v1, v2] = renameList(env, args)
208 :     in
209 :     expandOuter (env, y, d1, d2, v1, v2)
210 :     end
211 : jhr 824 (* FIXME: extend Norm to arbitrary tensor types == sqrt(sum of squares) *)
212 : jhr 365 | SrcOp.Norm ty => assign (DstOp.Norm(arity ty))
213 : jhr 717 | SrcOp.Normalize ty => assign (DstOp.Normalize(arity ty))
214 : jhr 824 (* FIXME: extend scaling to work on any tensor type *)
215 : jhr 365 | SrcOp.Scale ty => assign (DstOp.Scale(arity ty))
216 :     | SrcOp.InvScale ty => assign (DstOp.InvScale(arity ty))
217 :     | SrcOp.CL => assign DstOp.CL
218 :     | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec(cvtTy ty))
219 : jhr 762 | SrcOp.Identity n => assign (DstOp.Identity n)
220 : jhr 822 | SrcOp.Zero ty => assign (DstOp.Zero(cvtTy ty))
221 : jhr 683 | SrcOp.Trace(SrcTy.TensorTy[d, _]) => assign (DstOp.Trace d)
222 : jhr 762 | SrcOp.Slice(ty, mask) => raise Fail "FIXME: Slice"
223 : jhr 365 | SrcOp.Subscript ty => assign (DstOp.Subscript(cvtTy ty))
224 :     | SrcOp.IntToReal => assign DstOp.IntToReal
225 : jhr 762 | SrcOp.TruncToInt => cvtToInt (DstOp.Trunc 1)
226 :     | SrcOp.RoundToInt => cvtToInt (DstOp.Round 1)
227 : jhr 565 | SrcOp.CeilToInt => cvtToInt (DstOp.Ceiling 1)
228 :     | SrcOp.FloorToInt => cvtToInt (DstOp.Floor 1)
229 : jhr 517 | SrcOp.Kernel _ => dummy()
230 : jhr 365 | SrcOp.LoadImage info => assign (DstOp.LoadImage info)
231 : jhr 407 | SrcOp.Inside _ => (case args
232 : jhr 365 of [pos, fld] => expandInside(env, y, pos, fld)
233 :     (* end case *))
234 : jhr 762 | SrcOp.Probe _ => (case args
235 :     of [fld, pos] => expandProbe(env, y, fld, pos)
236 :     (* end case *))
237 : jhr 649 (* fields are used in the Inside and Probe operations, but are otherwise ignored *)
238 : jhr 548 | SrcOp.Field _ => dummy()
239 : jhr 649 | SrcOp.AddField => dummy()
240 :     | SrcOp.ScaleField => dummy()
241 :     | SrcOp.NegField => dummy()
242 :     | SrcOp.DiffField => dummy()
243 : jhr 420 | SrcOp.Input(ty, s) => assign (DstOp.Input(cvtTy ty, s))
244 :     | SrcOp.InputWithDefault(ty, s) => assign (DstOp.InputWithDefault(cvtTy ty, s))
245 : jhr 807 | rator => raise Fail("bogus operator " ^ SrcOp.toString rator)
246 : jhr 365 (* end case *)
247 :     end
248 : jhr 314
249 : jhr 387 (* expand a SrcIL assignment to a list of DstIL assignments *)
250 : jhr 364 fun expand (env, (y, rhs)) = let
251 : jhr 397 fun assign rhs = [(rename (env, y), rhs)]
252 : jhr 364 in
253 :     case rhs
254 :     of SrcIL.VAR x => assign (DstIL.VAR(rename(env, x)))
255 :     | SrcIL.LIT lit => assign (DstIL.LIT lit)
256 : jhr 397 | SrcIL.OP(SrcOp.Field _, args) => []
257 :     | SrcIL.OP(rator, args) => expandOp (env, rename (env, y), rator, args)
258 : jhr 695 | SrcIL.APPLY(f, args) => assign(DstIL.APPLY(f, renameList(env, args)))
259 : jhr 736 | SrcIL.CONS(ty, args) => assign (DstIL.CONS(cvtTy ty, renameList(env, args)))
260 : jhr 364 (* end case *)
261 :     end
262 :    
263 :     structure Trans = TranslateFn (
264 :     struct
265 :     structure SrcIL = SrcIL
266 :     structure DstIL = DstIL
267 :    
268 :     type var_env = var_env
269 :    
270 :     val rename = rename
271 : jhr 613 val renameList = renameList
272 : jhr 500 val expand = DstIL.CFG.mkBlock o expand
273 : jhr 364 end)
274 :    
275 : jhr 613 fun translate prog = let
276 :     val prog = Trans.translate prog
277 : jhr 367 in
278 : jhr 539 MidILCensus.init prog;
279 :     prog
280 : jhr 367 end
281 : jhr 364
282 : jhr 280 end

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