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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2502 - (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 1640 structure SrcSV = SrcIL.StateVar
19 : jhr 364 structure VTbl = SrcIL.Var.Tbl
20 : jhr 280 structure DstIL = MidIL
21 : jhr 391 structure DstTy = MidILTypes
22 : jhr 334 structure DstOp = MidOps
23 : cchiw 2496 structure Expand=Expand
24 : jhr 280
25 : jhr 1116 fun getRHS x = (case SrcIL.Var.binding x
26 : jhr 2356 of SrcIL.VB_RHS(SrcIL.OP(rator, args)) => (rator, args)
27 :     | SrcIL.VB_RHS(SrcIL.VAR x') => getRHS x'
28 : cchiw 2496 (* | SrcIL.VB_RHS(SrcIL.EINAPP(rator, args)) => SrcIL.Var.binding x*)
29 : jhr 2356 | vb => raise Fail(concat[
30 :     "expected rhs operator for ", SrcIL.Var.toString x,
31 :     "but found ", SrcIL.vbToString vb
32 :     ])
33 :     (* end case *))
34 : jhr 1116
35 : jhr 394 fun cvtTy SrcTy.BoolTy = DstTy.BoolTy
36 :     | cvtTy SrcTy.StringTy = DstTy.StringTy
37 :     | cvtTy SrcTy.IntTy = DstTy.intTy
38 : jhr 1116 | cvtTy (SrcTy.TensorTy dd) = DstTy.tensorTy dd
39 : jhr 1640 | cvtTy (SrcTy.TupleTy tys) = DstTy.TupleTy(List.map cvtTy tys)
40 :     | cvtTy (SrcTy.SeqTy(ty, n)) = DstTy.SeqTy(cvtTy ty, n)
41 : jhr 1116 (* we replace Kernel and Field operations by 0, so the types are mapped to int *)
42 :     | cvtTy SrcTy.KernelTy = DstTy.intTy
43 : cchiw 2496
44 : jhr 397 | cvtTy ty = raise Fail("unexpected type " ^ SrcTy.toString ty)
45 : jhr 394
46 : jhr 1640 (* instantiate the translation environment *)
47 :     local
48 :     type var_env = DstIL.var VTbl.hash_table
49 :     type state_var_env = DstIL.state_var SrcSV.Tbl.hash_table
50 :    
51 :     fun rename (env : var_env, x) = (case VTbl.find env x
52 :     of SOME x' => x'
53 :     | NONE => let
54 :     val dstTy = (case SrcIL.Var.ty x
55 :     of SrcTy.ImageTy _ => (
56 :     (* for variables with image type, we need more detailed information
57 :     * about the image for the MidIL type.
58 :     *)
59 :     case getRHS x
60 :     of (SrcOp.LoadImage v, _) => DstTy.ImageTy v
61 :     | _ => raise Fail "bogus image variable"
62 :     (* end case *))
63 :     | _ => cvtTy(SrcIL.Var.ty x)
64 :     (* end case *))
65 :     val x' = DstIL.Var.new (SrcIL.Var.name x, dstTy)
66 :     in
67 :     VTbl.insert env (x, x');
68 :     x'
69 :     end
70 :     (* end case *))
71 : jhr 1116 handle Fail msg => raise Fail(concat["rename(_, ", SrcIL.Var.toString x, "): ", msg])
72 :    
73 : jhr 2356 fun renameSV (env : state_var_env, x) = (case SrcSV.Tbl.find env x
74 :     of SOME x' => x'
75 :     | NONE => let
76 :     val dstTy = cvtTy (SrcSV.ty x)
77 :     val x' = DstIL.StateVar.new (SrcSV.isOutput x, SrcSV.name x, dstTy)
78 :     in
79 :     SrcSV.Tbl.insert env (x, x');
80 :     x'
81 :     end
82 :     (* end case *))
83 : jhr 1640 in
84 :     structure Env = TranslateEnvFn (
85 :     struct
86 :     structure SrcIL = SrcIL
87 :     structure DstIL = DstIL
88 :     type var_env = var_env
89 :     type state_var_env = state_var_env
90 :     val rename = rename
91 :     val renameSV = renameSV
92 :     end)
93 :     end
94 : jhr 334
95 : jhr 1116 (* expand raising a real to an integer power. When we know the exponent, we can inline
96 :     * multiplications.
97 :     *)
98 :     fun expandPower (env, y, [x, n]) = let
99 : jhr 2356 fun getConst x = (case SrcIL.Var.binding x
100 :     of SrcIL.VB_RHS(SrcIL.VAR x') => getConst x'
101 :     | SrcIL.VB_RHS(SrcIL.LIT(Literal.Int n)) => SOME n
102 :     | vb => NONE
103 :     (* end case *))
104 :     val x = Env.rename(env, x)
105 :     fun pow () = let
106 :     val t = DstIL.Var.new("n", DstTy.realTy)
107 :     in [
108 :     (t, DstIL.OP(DstOp.IntToReal, [Env.rename(env, n)])),
109 :     (y, DstIL.APPLY(MathFuns.pow, [x, t]))
110 :     ] end
111 :     in
112 :     case getConst n
113 :     of SOME 0 => [(y, DstIL.LIT(Literal.Float(FloatLit.one)))]
114 :     | SOME 1 => [(y, DstIL.VAR x)]
115 :     | SOME ~1 => let
116 :     val t = DstIL.Var.new("one", DstTy.realTy)
117 :     in [
118 :     (t, DstIL.LIT(Literal.Float(FloatLit.one))),
119 : cchiw 2496 (y, DstIL.OP(DstOp.IDiv , [t, x]))
120 : jhr 2356 ] end
121 : cchiw 2496 | SOME 2 => [(y, DstIL.OP(DstOp.IMul , [x, x]))]
122 : jhr 1640 (* FIXME: expand into multiplications; ~2 ==> sqrt
123 : jhr 2356 | SOME n =>
124 : jhr 1116 *) | SOME _ => pow()
125 : jhr 2356 | NONE => pow()
126 :     end
127 : jhr 280
128 : jhr 1116 (* expand the field Inside operator into a image-space test *)
129 : cchiw 2496
130 :     (*
131 : jhr 1116 fun expandInside (env, result, pos, fld) = (case getRHS fld
132 : jhr 2356 of (SrcOp.Field d, [img, h]) => (case (getRHS img, getRHS h)
133 :     of ((SrcOp.LoadImage v, _), (SrcOp.Kernel(h, _), [])) => let
134 :     val pos = Env.rename (env, pos)
135 :     val img = Env.rename (env, img)
136 : cchiw 2496
137 :     (**********FIXME**)
138 : jhr 2356 val imgPos = DstIL.Var.new ("x", DstTy.vecTy d)
139 :     val s = Kernel.support h
140 : cchiw 2397 (*PostoImageSpace*)
141 : jhr 2356 in [
142 :     (imgPos, DstIL.OP(DstOp.PosToImgSpace v, [img, pos])),
143 :     (result, DstIL.OP(DstOp.Inside(v, s), [imgPos, img]))
144 :     ] end
145 :     | _ => raise Fail "bogus kernel binding"
146 :     (* end case *))
147 :     | _ => raise Fail "bogus field binding"
148 : cchiw 2397 (* end case *))
149 : cchiw 2496 *)
150 :    
151 : cchiw 2396
152 : jhr 392 fun arity (SrcTy.TensorTy[]) = 1
153 :     | arity (SrcTy.TensorTy[d]) = d
154 : jhr 365 | arity _ = raise Fail "arity"
155 :    
156 : jhr 364 fun expandOp (env, y, rator, args) = let
157 : jhr 2356 fun assign rator' =
158 :     [(y, DstIL.OP(rator', Env.renameList(env, args)))]
159 :     fun cvtToInt rator' = let
160 :     val t = DstIL.Var.new ("t", DstTy.realTy)
161 :     in [
162 :     (t, DstIL.OP(rator', Env.renameList(env, args))),
163 :     (y, DstIL.OP(DstOp.RealToInt 1, [t]))
164 :     ] end
165 :     fun dummy () = [(y, DstIL.LIT(Literal.Int 0))]
166 :     in
167 :     case rator
168 : cchiw 2396 of SrcOp.IAdd => assign (DstOp.IAdd)
169 :     | SrcOp.ISub => assign (DstOp.ISub)
170 :     | SrcOp.IMul => assign (DstOp.IMul)
171 :     | SrcOp.IDiv => assign (DstOp.IDiv)
172 :     | SrcOp.INeg => assign (DstOp.INeg)
173 : jhr 2356 | SrcOp.Abs ty => assign (DstOp.Abs(cvtTy ty))
174 :     | SrcOp.LT ty => assign (DstOp.LT(cvtTy ty))
175 :     | SrcOp.LTE ty => assign (DstOp.LTE(cvtTy ty))
176 :     | SrcOp.EQ ty => assign (DstOp.EQ(cvtTy ty))
177 :     | SrcOp.NEQ ty => assign (DstOp.NEQ(cvtTy ty))
178 :     | SrcOp.GT ty => assign (DstOp.GT(cvtTy ty))
179 :     | SrcOp.GTE ty => assign (DstOp.GTE(cvtTy ty))
180 :     | SrcOp.Power => expandPower(env, y, args)
181 :     | SrcOp.Not => assign DstOp.Not
182 :     | SrcOp.Max => assign DstOp.Max
183 :     | SrcOp.Min => assign DstOp.Min
184 :     | SrcOp.Clamp ty => assign (DstOp.Clamp(cvtTy ty))
185 :     | SrcOp.Lerp ty => assign (DstOp.Lerp(cvtTy ty))
186 :     | SrcOp.Norm ty => assign (DstOp.Norm(cvtTy ty))
187 :     | SrcOp.Normalize ty => assign (DstOp.Normalize(arity ty))
188 : cchiw 2496
189 : jhr 2356 | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec(cvtTy ty))
190 : cchiw 2496
191 :     (*| SrcOp.Zero ty => assign (DstOp.Zero(cvtTy ty))*)
192 : jhr 2356 | SrcOp.Slice(ty, mask) => raise Fail "FIXME: Slice"
193 : jhr 1640 | SrcOp.TensorSub(ty as SrcTy.TensorTy _) => assign (DstOp.Subscript(cvtTy ty))
194 :     | SrcOp.Select(ty as SrcTy.TupleTy _, i) => assign (DstOp.Select(cvtTy ty, i))
195 :     | SrcOp.Select(ty as SrcTy.SeqTy _, i) => assign (DstOp.Index(cvtTy ty, i))
196 : jhr 2356 | SrcOp.SeqSub(ty as SrcTy.SeqTy _) => assign (DstOp.Subscript(cvtTy ty))
197 :     | SrcOp.IntToReal => assign DstOp.IntToReal
198 :     | SrcOp.TruncToInt => cvtToInt (DstOp.Trunc 1)
199 :     | SrcOp.RoundToInt => cvtToInt (DstOp.Round 1)
200 :     | SrcOp.CeilToInt => cvtToInt (DstOp.Ceiling 1)
201 :     | SrcOp.FloorToInt => cvtToInt (DstOp.Floor 1)
202 :     | SrcOp.Kernel _ => dummy()
203 :     | SrcOp.LoadImage info => assign (DstOp.LoadImage info)
204 : cchiw 2496 (*| SrcOp.Inside _ =>
205 :     (case args
206 : jhr 2356 of [pos, fld] => expandInside(env, y, pos, fld)
207 : cchiw 2496 (* end case *))*)
208 : jhr 2356 (* fields are used in the Inside and Probe operations, but are otherwise ignored *)
209 :     | SrcOp.Input(ty, s, desc) => assign (DstOp.Input(cvtTy ty, s, desc))
210 :     | SrcOp.InputWithDefault(ty, s, desc) =>
211 :     assign (DstOp.InputWithDefault(cvtTy ty, s, desc))
212 :     | rator => raise Fail("bogus operator " ^ SrcOp.toString rator)
213 :     (* end case *)
214 :     end
215 :     handle ex => (print(concat["error converting ", SrcOp.toString rator, "\n"]); raise ex)
216 : cchiw 2396
217 :    
218 : cchiw 2496 fun expandEinOp (env, y, rator, args) = let
219 :     fun assign rator' =
220 :     [(y, DstIL.EINAPP(rator', Env.renameList(env, args)))]
221 :     val (expanded,args')=Expand.expandEinOp(rator,args)
222 :     in (print "sss";assign(expanded)) end
223 : cchiw 2397
224 : cchiw 2496 (*
225 :    
226 :     of Probe(E.Conv(f, d), x) => (case args
227 : cchiw 2466 of [fld, pos] =>expandEinProbe(env, y, f,d,index,fld, pos)
228 :     (*returns more than just body, also adds index*)
229 :     |_ => dummy()
230 : cchiw 2496 (* end case *))
231 :    
232 :    
233 : cchiw 2396 (* end case *)
234 : cchiw 2496
235 : cchiw 2396 end
236 : cchiw 2496
237 : cchiw 2396
238 : cchiw 2496 *)
239 : jhr 314
240 : jhr 387 (* expand a SrcIL assignment to a list of DstIL assignments *)
241 : jhr 364 fun expand (env, (y, rhs)) = let
242 : jhr 2356 fun assign rhs = [DstIL.ASSGN(Env.rename (env, y), rhs)]
243 :     in
244 :     case rhs
245 :     of SrcIL.STATE x => assign (DstIL.STATE(Env.renameSV(env, x)))
246 : jhr 1640 | SrcIL.VAR x => assign (DstIL.VAR(Env.rename(env, x)))
247 : jhr 2356 | SrcIL.LIT lit => assign (DstIL.LIT lit)
248 :     | SrcIL.OP(rator, args) =>
249 : jhr 1640 List.map DstIL.ASSGN (expandOp (env, Env.rename (env, y), rator, args))
250 : jhr 2356 | SrcIL.APPLY(f, args) => assign(DstIL.APPLY(f, Env.renameList(env, args)))
251 :     | SrcIL.CONS(ty, args) => assign (DstIL.CONS(cvtTy ty, Env.renameList(env, args)))
252 : cchiw 2502 | SrcIL.EINAPP(rator, args) =>(print"find einapp";
253 :     List.map DstIL.ASSGN (expandEinOp (env, Env.rename (env, y), rator, args)))
254 : cchiw 2396
255 : jhr 2356 (* end case *)
256 :     end
257 : jhr 364
258 : jhr 1640 (* expand a SrcIL multi-assignment to a DstIL CFG *)
259 :     fun mexpand (env, (ys, rator, xs)) = let
260 :     val ys' = Env.renameList(env, ys)
261 :     val rator' = (case rator
262 :     of SrcOp.Eigen2x2 => DstOp.EigenVecs2x2
263 :     | SrcOp.Eigen3x3 => DstOp.EigenVecs3x3
264 :     | SrcOp.Print tys => DstOp.Print(List.map cvtTy tys)
265 :     | _ => raise Fail("bogus operator " ^ SrcOp.toString rator)
266 :     (* end case *))
267 :     val xs' = Env.renameList(env, xs)
268 :     val nd = DstIL.Node.mkMASSIGN(ys', rator', xs')
269 :     in
270 :     DstIL.CFG{entry=nd, exit=nd}
271 :     end
272 :    
273 : jhr 364 structure Trans = TranslateFn (
274 :     struct
275 : jhr 2356 open Env
276 :     val expand = DstIL.CFG.mkBlock o expand
277 : jhr 1640 val mexpand = mexpand
278 : jhr 364 end)
279 :    
280 : jhr 1116 fun translate prog = let
281 : jhr 2356 val prog = Trans.translate prog
282 :     in
283 :     MidILCensus.init prog;
284 :     prog
285 :     end
286 : jhr 364
287 : jhr 280 end

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