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 712 - (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 :     | _ => raise Fail("expected rhs operator for " ^ SrcIL.Var.toString x)
28 :     (* end case *))
29 :    
30 : jhr 394 fun cvtTy SrcTy.BoolTy = DstTy.BoolTy
31 :     | cvtTy SrcTy.StringTy = DstTy.StringTy
32 :     | cvtTy SrcTy.IntTy = DstTy.intTy
33 :     | cvtTy (SrcTy.TensorTy[]) = DstTy.realTy
34 :     | cvtTy (SrcTy.TensorTy[d]) = DstTy.VecTy d
35 : jhr 517 (* we replace Kernel and Field operations by 0, so the types are mapped to int *)
36 :     | cvtTy SrcTy.KernelTy = DstTy.intTy
37 :     | cvtTy SrcTy.FieldTy = DstTy.intTy
38 : jhr 397 | cvtTy ty = raise Fail("unexpected type " ^ SrcTy.toString ty)
39 : jhr 394
40 : jhr 364 fun rename (env : var_env, x) = (case VTbl.find env x
41 : jhr 334 of SOME x' => x'
42 : jhr 364 | NONE => let
43 : jhr 548 val dstTy = (case SrcIL.Var.ty x
44 :     of SrcTy.ImageTy _ => (
45 :     (* for variables with image type, we need more detailed information
46 :     * about the image for the MidIL type.
47 :     *)
48 :     case getRHS x
49 :     of (SrcOp.LoadImage v, _) => DstTy.ImageTy v
50 :     | _ => raise Fail "bogus image variable"
51 :     (* end case *))
52 :     | _ => cvtTy(SrcIL.Var.ty x)
53 :     (* end case *))
54 :     val x' = DstIL.Var.new (SrcIL.Var.name x, dstTy)
55 : jhr 364 in
56 :     VTbl.insert env (x, x');
57 :     x'
58 :     end
59 : jhr 334 (* end case *))
60 : jhr 517 handle Fail msg => raise Fail(concat["rename(_, ", SrcIL.Var.toString x, "): ", msg])
61 :    
62 : jhr 367 fun renameList (env, xs) = List.map (fn x => rename(env, x)) xs
63 : jhr 334
64 : jhr 280 (* expand the field Inside operator into a image-space test *)
65 : jhr 517 fun expandInside (env, result, pos, fld) = (case getRHS fld
66 : jhr 548 of (SrcOp.Field d, [img, h]) => (case (getRHS img, getRHS h)
67 :     of ((SrcOp.LoadImage v, _), (SrcOp.Kernel(h, _), [])) => let
68 : jhr 546 val pos = rename (env, pos)
69 :     val img = rename (env, img)
70 : jhr 548 val imgPos = DstIL.Var.new ("x", DstTy.VecTy d)
71 : jhr 546 val s = Kernel.support h
72 :     in [
73 : jhr 548 (imgPos, DstIL.OP(DstOp.PosToImgSpace v, [img, pos])),
74 :     (result, DstIL.OP(DstOp.Inside(v, s), [imgPos, img]))
75 : jhr 546 ] end
76 :     | _ => raise Fail "bogus kernel binding"
77 :     (* end case *))
78 : jhr 517 | _ => raise Fail "bogus field binding"
79 :     (* end case *))
80 : jhr 280
81 : jhr 517 fun expandProbe (env, result, fld, pos) = (case getRHS fld
82 : jhr 548 of (SrcOp.Field _, [img, h]) => (case (getRHS img, getRHS h)
83 : jhr 517 of ((SrcOp.LoadImage v, _), (SrcOp.Kernel(h, k), _)) => Probe.expand {
84 :     result = result,
85 :     img = rename (env, img),
86 :     v = v, h = h, k = k,
87 :     pos = rename (env, pos)
88 :     }
89 :     | _ => raise Fail "bogus image/kernel binding"
90 : jhr 358 (* end case *))
91 : jhr 517 | _ => raise Fail "bogus field binding"
92 :     (* end case *))
93 : jhr 334
94 : jhr 392 fun arity (SrcTy.TensorTy[]) = 1
95 :     | arity (SrcTy.TensorTy[d]) = d
96 : jhr 365 | arity _ = raise Fail "arity"
97 :    
98 : jhr 364 fun expandOp (env, y, rator, args) = let
99 : jhr 365 fun assign rator' =
100 : jhr 367 [(y, DstIL.OP(rator', renameList(env, args)))]
101 : jhr 565 fun cvtToInt rator' = let
102 :     val t = DstIL.Var.new ("t", DstTy.realTy)
103 :     in [
104 :     (t, DstIL.OP(rator', renameList(env, args))),
105 :     (y, DstIL.OP(DstOp.RealToInt 1, [t]))
106 :     ] end
107 : jhr 517 fun dummy () = [(y, DstIL.LIT(Literal.Int 0))]
108 : jhr 364 in
109 :     case rator
110 : jhr 365 of SrcOp.Add ty => assign (DstOp.Add(cvtTy ty))
111 :     | SrcOp.Sub ty => assign (DstOp.Sub(cvtTy ty))
112 :     | SrcOp.Mul ty => assign (DstOp.Mul(cvtTy ty))
113 :     | SrcOp.Div ty => assign (DstOp.Div(cvtTy ty))
114 :     | SrcOp.Neg ty => assign (DstOp.Neg(cvtTy ty))
115 :     | SrcOp.LT ty => assign (DstOp.LT(cvtTy ty))
116 :     | SrcOp.LTE ty => assign (DstOp.LTE(cvtTy ty))
117 :     | SrcOp.EQ ty => assign (DstOp.EQ(cvtTy ty))
118 :     | SrcOp.NEQ ty => assign (DstOp.NEQ(cvtTy ty))
119 :     | SrcOp.GT ty => assign (DstOp.GT(cvtTy ty))
120 :     | SrcOp.GTE ty => assign (DstOp.GTE(cvtTy ty))
121 :     | SrcOp.Dot ty => assign (DstOp.Dot(arity ty))
122 :     | SrcOp.Cross => assign DstOp.Cross
123 :     | SrcOp.Norm ty => assign (DstOp.Norm(arity ty))
124 :     | SrcOp.Scale ty => assign (DstOp.Scale(arity ty))
125 :     | SrcOp.InvScale ty => assign (DstOp.InvScale(arity ty))
126 :     | SrcOp.CL => assign DstOp.CL
127 :     | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec(cvtTy ty))
128 : jhr 683 | SrcOp.Trace(SrcTy.TensorTy[d, _]) => assign (DstOp.Trace d)
129 : jhr 712 (* FIXME: tensors get flattened into slow-to-fast order *)
130 : jhr 365 | SrcOp.Subscript ty => assign (DstOp.Subscript(cvtTy ty))
131 : jhr 712 | SrcOp.Slice(ty, mask) => raise Fail "FIXME: Slice"
132 : jhr 365 | SrcOp.Max => assign DstOp.Max
133 :     | SrcOp.Min => assign DstOp.Min
134 :     | SrcOp.Sin => assign DstOp.Sin
135 :     | SrcOp.Cos => assign DstOp.Cos
136 :     | SrcOp.Pow => assign DstOp.Pow
137 :     | SrcOp.Not => assign DstOp.Not
138 :     | SrcOp.IntToReal => assign DstOp.IntToReal
139 : jhr 565 | SrcOp.CeilToInt => cvtToInt (DstOp.Ceiling 1)
140 :     | SrcOp.FloorToInt => cvtToInt (DstOp.Floor 1)
141 :     | SrcOp.RoundToInt => cvtToInt (DstOp.Round 1)
142 :     | SrcOp.TruncToInt => cvtToInt (DstOp.Trunc 1)
143 : jhr 517 | SrcOp.Kernel _ => dummy()
144 : jhr 365 | SrcOp.LoadImage info => assign (DstOp.LoadImage info)
145 : jhr 407 | SrcOp.Inside _ => (case args
146 : jhr 365 of [pos, fld] => expandInside(env, y, pos, fld)
147 :     (* end case *))
148 : jhr 649 (* fields are used in the Inside and Probe operations, but are otherwise ignored *)
149 : jhr 548 | SrcOp.Field _ => dummy()
150 : jhr 649 | SrcOp.AddField => dummy()
151 :     | SrcOp.ScaleField => dummy()
152 :     | SrcOp.NegField => dummy()
153 :     | SrcOp.DiffField => dummy()
154 : jhr 407 | SrcOp.Probe _ => (case args
155 : jhr 365 of [fld, pos] => expandProbe(env, y, fld, pos)
156 :     (* end case *))
157 : jhr 420 | SrcOp.Input(ty, s) => assign (DstOp.Input(cvtTy ty, s))
158 :     | SrcOp.InputWithDefault(ty, s) => assign (DstOp.InputWithDefault(cvtTy ty, s))
159 : jhr 365 | _ => raise Fail("unexpected " ^ SrcOp.toString rator)
160 :     (* end case *)
161 :     end
162 : jhr 314
163 : jhr 387 (* expand a SrcIL assignment to a list of DstIL assignments *)
164 : jhr 364 fun expand (env, (y, rhs)) = let
165 : jhr 397 fun assign rhs = [(rename (env, y), rhs)]
166 : jhr 364 in
167 :     case rhs
168 :     of SrcIL.VAR x => assign (DstIL.VAR(rename(env, x)))
169 :     | SrcIL.LIT lit => assign (DstIL.LIT lit)
170 : jhr 397 | SrcIL.OP(SrcOp.Field _, args) => []
171 :     | SrcIL.OP(rator, args) => expandOp (env, rename (env, y), rator, args)
172 : jhr 695 | SrcIL.APPLY(f, args) => assign(DstIL.APPLY(f, renameList(env, args)))
173 : jhr 712 (* FIXME: flatten cons into slow-to-fast index order *)
174 : jhr 367 | SrcIL.CONS args => assign (DstIL.CONS(renameList(env, args)))
175 : jhr 364 (* end case *)
176 :     end
177 :    
178 :     structure Trans = TranslateFn (
179 :     struct
180 :     structure SrcIL = SrcIL
181 :     structure DstIL = DstIL
182 :    
183 :     type var_env = var_env
184 :    
185 :     val rename = rename
186 : jhr 613 val renameList = renameList
187 : jhr 500 val expand = DstIL.CFG.mkBlock o expand
188 : jhr 364 end)
189 :    
190 : jhr 613 fun translate prog = let
191 :     val prog = Trans.translate prog
192 : jhr 367 in
193 : jhr 539 MidILCensus.init prog;
194 :     prog
195 : jhr 367 end
196 : jhr 364
197 : jhr 280 end

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