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 511 - (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 394 fun cvtTy SrcTy.BoolTy = DstTy.BoolTy
26 :     | cvtTy SrcTy.StringTy = DstTy.StringTy
27 :     | cvtTy SrcTy.IntTy = DstTy.intTy
28 :     | cvtTy (SrcTy.TensorTy[]) = DstTy.realTy
29 :     | cvtTy (SrcTy.TensorTy[d]) = DstTy.VecTy d
30 : jhr 397 | cvtTy SrcTy.ImageTy = DstTy.ImageTy
31 :     | cvtTy ty = raise Fail("unexpected type " ^ SrcTy.toString ty)
32 : jhr 394
33 : jhr 364 fun rename (env : var_env, x) = (case VTbl.find env x
34 : jhr 334 of SOME x' => x'
35 : jhr 364 | NONE => let
36 : jhr 394 val x' = DstIL.Var.new (SrcIL.Var.name x, cvtTy(SrcIL.Var.ty x))
37 : jhr 364 in
38 :     VTbl.insert env (x, x');
39 :     x'
40 :     end
41 : jhr 334 (* end case *))
42 : jhr 367 fun renameList (env, xs) = List.map (fn x => rename(env, x)) xs
43 : jhr 334
44 : jhr 280 (* expand the field Inside operator into a image-space test *)
45 :     fun expandInside (env, result, pos, fld) = let
46 : jhr 365 val pos = rename (env, pos)
47 :     val fld = (case SrcIL.Var.binding fld
48 :     of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Field fld, [])) => fld
49 : jhr 280 | _ => raise Fail "bogus field binding"
50 :     (* end case *))
51 : jhr 328 fun expand (FieldDef.CONV(_, img, _)) = let
52 : jhr 394 val imgPos = DstIL.Var.new ("x", DstTy.VecTy(ImageInfo.dim img))
53 : jhr 280 in [
54 : jhr 450 (imgPos, DstIL.OP(DstOp.PosToImgSpace img, [pos])),
55 : jhr 280 (result, DstIL.OP(DstOp.Inside img, [imgPos]))
56 :     ] end
57 : jhr 328 | expand (FieldDef.NEG fld) = expand fld
58 :     | expand (FieldDef.SUM(fld1, dlf2)) = raise Fail "expandInside: SUM"
59 : jhr 280 in
60 :     expand fld
61 :     end
62 :    
63 : jhr 358 fun expandProbe (env, result, fld, pos) = let
64 : jhr 365 val pos = rename (env, pos)
65 :     val fld = (case SrcIL.Var.binding fld
66 :     of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Field fld, [])) => fld
67 : jhr 358 | _ => raise Fail "bogus field binding"
68 :     (* end case *))
69 :     in
70 : jhr 364 Probe.expand (result, fld, pos)
71 : jhr 358 end
72 : jhr 334
73 : jhr 392 fun arity (SrcTy.TensorTy[]) = 1
74 :     | arity (SrcTy.TensorTy[d]) = d
75 : jhr 365 | arity _ = raise Fail "arity"
76 :    
77 : jhr 364 fun expandOp (env, y, rator, args) = let
78 : jhr 365 fun assign rator' =
79 : jhr 367 [(y, DstIL.OP(rator', renameList(env, args)))]
80 : jhr 364 in
81 :     case rator
82 : jhr 365 of SrcOp.Add ty => assign (DstOp.Add(cvtTy ty))
83 :     | SrcOp.Sub ty => assign (DstOp.Sub(cvtTy ty))
84 :     | SrcOp.Mul ty => assign (DstOp.Mul(cvtTy ty))
85 :     | SrcOp.Div ty => assign (DstOp.Div(cvtTy ty))
86 :     | SrcOp.Neg ty => assign (DstOp.Neg(cvtTy ty))
87 :     | SrcOp.LT ty => assign (DstOp.LT(cvtTy ty))
88 :     | SrcOp.LTE ty => assign (DstOp.LTE(cvtTy ty))
89 :     | SrcOp.EQ ty => assign (DstOp.EQ(cvtTy ty))
90 :     | SrcOp.NEQ ty => assign (DstOp.NEQ(cvtTy ty))
91 :     | SrcOp.GT ty => assign (DstOp.GT(cvtTy ty))
92 :     | SrcOp.GTE ty => assign (DstOp.GTE(cvtTy ty))
93 :     | SrcOp.Dot ty => assign (DstOp.Dot(arity ty))
94 :     | SrcOp.Cross => assign DstOp.Cross
95 :     | SrcOp.Norm ty => assign (DstOp.Norm(arity ty))
96 :     | SrcOp.Scale ty => assign (DstOp.Scale(arity ty))
97 :     | SrcOp.InvScale ty => assign (DstOp.InvScale(arity ty))
98 :     | SrcOp.CL => assign DstOp.CL
99 :     | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec(cvtTy ty))
100 :     | SrcOp.Subscript ty => assign (DstOp.Subscript(cvtTy ty))
101 :     | SrcOp.Max => assign DstOp.Max
102 :     | SrcOp.Min => assign DstOp.Min
103 :     | SrcOp.Sin => assign DstOp.Sin
104 :     | SrcOp.Cos => assign DstOp.Cos
105 :     | SrcOp.Pow => assign DstOp.Pow
106 :     | SrcOp.Not => assign DstOp.Not
107 :     | SrcOp.IntToReal => assign DstOp.IntToReal
108 :     | SrcOp.TruncToInt => assign (DstOp.TruncToInt 1)
109 :     | SrcOp.RoundToInt => assign (DstOp.RoundToInt 1)
110 :     | SrcOp.CeilToInt => assign (DstOp.CeilToInt 1)
111 :     | SrcOp.FloorToInt => assign (DstOp.FloorToInt 1)
112 :     | SrcOp.LoadImage info => assign (DstOp.LoadImage info)
113 : jhr 407 | SrcOp.Inside _ => (case args
114 : jhr 365 of [pos, fld] => expandInside(env, y, pos, fld)
115 :     (* end case *))
116 : jhr 397 | SrcOp.Field fld => raise Fail "impossible"
117 : jhr 407 | SrcOp.Probe _ => (case args
118 : jhr 365 of [fld, pos] => expandProbe(env, y, fld, pos)
119 :     (* end case *))
120 : jhr 420 | SrcOp.Input(ty, s) => assign (DstOp.Input(cvtTy ty, s))
121 :     | SrcOp.InputWithDefault(ty, s) => assign (DstOp.InputWithDefault(cvtTy ty, s))
122 : jhr 365 | _ => raise Fail("unexpected " ^ SrcOp.toString rator)
123 :     (* end case *)
124 :     end
125 : jhr 314
126 : jhr 387 (* expand a SrcIL assignment to a list of DstIL assignments *)
127 : jhr 364 fun expand (env, (y, rhs)) = let
128 : jhr 397 fun assign rhs = [(rename (env, y), rhs)]
129 : jhr 364 in
130 :     case rhs
131 :     of SrcIL.VAR x => assign (DstIL.VAR(rename(env, x)))
132 :     | SrcIL.LIT lit => assign (DstIL.LIT lit)
133 : jhr 397 | SrcIL.OP(SrcOp.Field _, args) => []
134 :     | SrcIL.OP(rator, args) => expandOp (env, rename (env, y), rator, args)
135 : jhr 367 | SrcIL.CONS args => assign (DstIL.CONS(renameList(env, args)))
136 : jhr 364 (* end case *)
137 :     end
138 :    
139 :     structure Trans = TranslateFn (
140 :     struct
141 :     structure SrcIL = SrcIL
142 :     structure DstIL = DstIL
143 :    
144 :     type var_env = var_env
145 :    
146 :     val rename = rename
147 :     val expand = expand
148 :     end)
149 :    
150 : jhr 511 fun translate (SrcIL.Program{globals, globalInit, strands}) = let
151 : jhr 367 val env = VTbl.mkTable (256, Fail "env")
152 :     fun transMethod (SrcIL.Method{name, stateIn, stateOut, body}) =
153 :     DstIL.Method{
154 :     name = name,
155 :     stateIn = renameList (env, stateIn),
156 :     stateOut = renameList (env, stateOut),
157 :     body = Trans.translate (env, body)
158 :     }
159 : jhr 511 fun transStrand (SrcIL.Strand{name, params, state, stateInit, methods}) =
160 :     DstIL.Strand{
161 : jhr 367 name = name,
162 :     params = renameList (env, params),
163 :     state = renameList (env, state),
164 :     stateInit = Trans.translate (env, stateInit),
165 :     methods = List.map transMethod methods
166 :     }
167 : jhr 397 (* filter out field variables, since they will be made explicit in
168 :     * the MidIL.
169 :     *)
170 :     val globals = let
171 :     fun filter x = (case SrcIL.Var.ty x
172 :     of SrcTy.FieldTy => NONE
173 :     | _ => SOME x
174 :     (* end case *))
175 :     in
176 :     List.mapPartial filter globals
177 :     end
178 : jhr 367 in
179 :     DstIL.Program{
180 :     globals = renameList (env, globals),
181 :     globalInit = Trans.translate (env, globalInit),
182 : jhr 511 strands = List.map transStrand strands
183 : jhr 367 }
184 :     end
185 : jhr 364
186 : jhr 280 end

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