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

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