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

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/tree-ir/check-tree.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/tree-ir/check-tree.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3810 - (view) (download)

1 : jhr 3754 (* check-tree.sml
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2016 The University of Chicago
6 :     * All rights reserved.
7 :     *
8 :     * TODO: check global and state variable consistency
9 :     *)
10 :    
11 : jhr 3757 (* FIXME: this module needs to be parameterized over the vector layout of the target *)
12 :    
13 : jhr 3754 structure CheckTree : sig
14 :    
15 :     val check : string * TreeIR.program -> bool
16 :    
17 :     end = struct
18 :    
19 :     structure IR = TreeIR
20 :     structure Op = TreeOps
21 :     structure GVar = IR.GlobalVar
22 :     structure SVar = IR.StateVar
23 :     structure Var = IR.Var
24 :     structure VSet = Var.Set
25 :     structure Ty = IR.Ty
26 :    
27 :     datatype token
28 :     = NL | S of string | A of Atom.atom | V of IR.var
29 : jhr 3810 | TY of Ty.t | TYS of Ty.t list
30 : jhr 3754
31 :     fun error errBuf toks = let
32 :     fun tok2str NL = "\n ** "
33 :     | tok2str (S s) = s
34 :     | tok2str (A s) = Atom.toString s
35 :     | tok2str (V x) = Var.toString x
36 :     | tok2str (TY ty) = Ty.toString ty
37 :     | tok2str (TYS []) = "()"
38 :     | tok2str (TYS[ty]) = Ty.toString ty
39 :     | tok2str (TYS tys) = String.concat[
40 :     "(", String.concatWith " * " (List.map Ty.toString tys), ")"
41 :     ]
42 :     in
43 :     errBuf := concat ("**** Error: " :: List.map tok2str toks)
44 :     :: !errBuf
45 :     end
46 :    
47 : jhr 3757 (* utility function for synthesizing eigenvector/eigenvalue signature *)
48 :     fun eigenSig dim = let
49 :     val tplTy = Ty.TupleTy[
50 :     Ty.SeqTy(Ty.realTy, SOME dim),
51 : jhr 3767 Ty.SeqTy(Ty.vecTy dim, SOME dim)
52 : jhr 3757 ]
53 :     in
54 : jhr 3767 (* FIXME: what about pieces? *)
55 :     (tplTy, [Ty.TensorTy(dim, Ty.vecTy dim)])
56 : jhr 3757 end
57 :    
58 :     (* Return the signature of a TreeIR operator. *)
59 :     fun sigOf rator = (case rator
60 :     of Op.IAdd => (Ty.IntTy, [Ty.IntTy, Ty.IntTy])
61 :     | Op.ISub => (Ty.IntTy, [Ty.IntTy, Ty.IntTy])
62 :     | Op.IMul => (Ty.IntTy, [Ty.IntTy, Ty.IntTy])
63 :     | Op.IDiv => (Ty.IntTy, [Ty.IntTy, Ty.IntTy])
64 :     | Op.IMod => (Ty.IntTy, [Ty.IntTy, Ty.IntTy])
65 :     | Op.INeg => (Ty.IntTy, [Ty.IntTy])
66 :     | Op.RAdd => (Ty.realTy, [Ty.realTy, Ty.realTy])
67 :     | Op.RSub => (Ty.realTy, [Ty.realTy, Ty.realTy])
68 :     | Op.RMul => (Ty.realTy, [Ty.realTy, Ty.realTy])
69 :     | Op.RDiv => (Ty.realTy, [Ty.realTy, Ty.realTy])
70 :     | Op.RNeg => (Ty.realTy, [Ty.realTy])
71 :     | Op.LT ty => (Ty.BoolTy, [ty, ty])
72 :     | Op.LTE ty => (Ty.BoolTy, [ty, ty])
73 :     | Op.EQ ty => (Ty.BoolTy, [ty, ty])
74 :     | Op.NEQ ty => (Ty.BoolTy, [ty, ty])
75 :     | Op.GT ty => (Ty.BoolTy, [ty, ty])
76 :     | Op.GTE ty => (Ty.BoolTy, [ty, ty])
77 :     | Op.Not => (Ty.BoolTy, [Ty.BoolTy])
78 :     | Op.Abs ty => (ty, [ty])
79 :     | Op.Max ty => (ty, [ty, ty])
80 :     | Op.Min ty => (ty, [ty, ty])
81 : jhr 3766 | Op.Clamp ty => (ty, [Ty.realTy, Ty.realTy, ty])
82 :     | Op.Lerp ty => (ty, [ty, ty, Ty.realTy])
83 : jhr 3767 | Op.VAdd d => (Ty.vecTy d, [Ty.vecTy d, Ty.vecTy d])
84 :     | Op.VSub d => (Ty.vecTy d, [Ty.vecTy d, Ty.vecTy d])
85 :     | Op.VScale d => (Ty.vecTy d, [Ty.realTy, Ty.vecTy d])
86 :     | Op.VMul d => (Ty.vecTy d, [Ty.vecTy d, Ty.vecTy d])
87 :     | Op.VNeg d => (Ty.vecTy d, [Ty.vecTy d])
88 :     | Op.VSum d => (Ty.realTy, [Ty.vecTy d])
89 : jhr 3766 (*
90 :     TensorIndex
91 :     *)
92 : jhr 3757 | Op.EigenVecs2x2 => eigenSig 2
93 :     | Op.EigenVecs3x3 => eigenSig 3
94 : jhr 3767 (* FIXME: what about pieces? *)
95 :     | Op.EigenVals2x2 => (Ty.SeqTy(Ty.realTy, SOME 2), [Ty.TensorTy(2, Ty.vecTy 2)])
96 :     | Op.EigenVals3x3 => (Ty.SeqTy(Ty.realTy, SOME 3), [Ty.TensorTy(3, Ty.vecTy 3)])
97 : jhr 3757 | Op.Zero ty => (ty, [])
98 :     | Op.Select(ty as Ty.TupleTy tys, i) => (List.nth(tys, i-1), [ty])
99 :     | Op.Subscript(ty as Ty.SeqTy(elemTy, _)) => (elemTy, [ty, Ty.intTy])
100 :     | Op.MkDynamic(ty, n) => (Ty.SeqTy(ty, NONE), [Ty.SeqTy(ty, SOME n)])
101 :     | Op.Prepend ty => (Ty.SeqTy(ty, NONE), [ty, Ty.SeqTy(ty, NONE)])
102 :     | Op.Append ty => (Ty.SeqTy(ty, NONE), [Ty.SeqTy(ty, NONE), ty])
103 :     | Op.Concat ty => (Ty.SeqTy(ty, NONE), [Ty.SeqTy(ty, NONE), Ty.SeqTy(ty, NONE)])
104 :     | Op.Range => (Ty.SeqTy(Ty.intTy, NONE), [Ty.IntTy, Ty.IntTy])
105 :     | Op.Length ty => (Ty.intTy, [Ty.SeqTy(ty, NONE)])
106 :     | Op.SphereQuery(ptTy, strandTy) => (Ty.SeqTy(strandTy, NONE), [ptTy, Ty.realTy])
107 :     | Op.Sqrt => (Ty.realTy, [Ty.realTy])
108 :     | Op.Cos => (Ty.realTy, [Ty.realTy])
109 :     | Op.ArcCos => (Ty.realTy, [Ty.realTy])
110 :     | Op.Sine => (Ty.realTy, [Ty.realTy])
111 :     | Op.ArcSin => (Ty.realTy, [Ty.realTy])
112 :     | Op.Tan => (Ty.realTy, [Ty.realTy])
113 :     | Op.ArcTan => (Ty.realTy, [Ty.realTy])
114 :     | Op.Exp => (Ty.realTy, [Ty.realTy])
115 :     | Op.Ceiling d => (Ty.vecTy d, [Ty.vecTy d])
116 :     | Op.Floor d => (Ty.vecTy d, [Ty.vecTy d])
117 :     | Op.Round d => (Ty.vecTy d, [Ty.vecTy d])
118 :     | Op.Trunc d => (Ty.vecTy d, [Ty.vecTy d])
119 :     | Op.IntToReal => (Ty.realTy, [Ty.intTy])
120 :     | Op.RealToInt 1 => (Ty.IntTy, [Ty.realTy])
121 : jhr 3767 | Op.RealToInt d => (Ty.SeqTy(Ty.IntTy, SOME d), [Ty.vecTy d])
122 : jhr 3757 (* not sure if we will need these
123 :     | R_All of ty
124 :     | R_Exists of ty
125 :     | R_Max of ty
126 :     | R_Min of ty
127 :     | R_Sum of ty
128 :     | R_Product of ty
129 :     | R_Mean of ty
130 :     | R_Variance of ty
131 :     *)
132 : jhr 3766 (* FIXME: these should probably be compiled down to lower-level operartions at this point!
133 : jhr 3757 | Op.Transform info => let
134 :     val dim = ImageInfo.dim info
135 :     in
136 :     if (dim = 1)
137 : jhr 3766 then (Ty.realTy, [Ty.ImageTy info])
138 :     else (Ty.matrixTy(dim, dim), [Ty.ImageTy info])
139 : jhr 3757 end
140 :     | Op.Translate info => let
141 :     val dim = ImageInfo.dim info
142 :     in
143 :     if (dim = 1)
144 : jhr 3766 then (Ty.realTy, [Ty.ImageTy info])
145 :     else (Ty.matrixTy(dim, dim), [Ty.ImageTy info])
146 : jhr 3757 end
147 :     *)
148 : jhr 3766 | Op.ControlIndex(info, _, _) => (Ty.IntTy, [Ty.ImageTy info, Ty.IntTy])
149 : jhr 3757 | Op.Inside(info, _) => (Ty.BoolTy, [Ty.vecTy(ImageInfo.dim info), Ty.ImageTy info])
150 :     | Op.ImageDim(info, _) => (Ty.IntTy, [Ty.ImageTy info])
151 :     | Op.LoadSeq(ty, _) => (ty, [])
152 :     | Op.LoadImage(ty, _) => (ty, [])
153 :     | Op.MathFn f => MathFns.sigOf (Ty.RealTy, f)
154 :     | _ => raise Fail("sigOf: invalid operator " ^ Op.toString rator)
155 :     (* end case *))
156 :    
157 : jhr 3754 fun check (phase, prog) = let
158 :     val IR.Program{
159 :     props, consts, inputs, constInit, globals, globalInit,
160 :     strand, create, update
161 :     } = prog
162 :     val errBuf = ref []
163 :     val errFn = error errBuf
164 :     fun final () = (case !errBuf
165 :     of [] => false
166 :     | errs => (
167 :     Log.msg ["********** IR Errors detected after ", phase, " **********\n"];
168 :     List.app (fn msg => Log.msg [msg, "\n"]) (List.rev errs);
169 :     true)
170 :     (* end case *))
171 :     (* check a variable use *)
172 :     fun checkVar (bvs, x) = if VSet.member(bvs, x)
173 :     then ()
174 :     else errFn [S "variable ", V x, S " is not bound"]
175 :     fun chkBlock (bvs, IR.Block{locals, body}) = let
176 :     fun chkExp (bvs, e) = let
177 :     fun chk e = (case e
178 :     of IR.E_Global gv => GVar.ty gv
179 :     | IR.E_State sv => SVar.ty sv
180 :     | IR.E_Var x => Var.ty x
181 :     | IR.E_Lit(Literal.Int _) => Ty.IntTy
182 :     | IR.E_Lit(Literal.Real _) => Ty.realTy
183 :     | IR.E_Lit(Literal.String _) => Ty.StringTy
184 :     | IR.E_Lit(Literal.Bool _) => Ty.BoolTy
185 :     | IR.E_Op(rator, args) => let
186 : jhr 3757 val (resTy, paramTys) = sigOf rator
187 : jhr 3754 val argTys = List.map chk args
188 :     in
189 :     if ListPair.allEq Ty.same (paramTys, argTys)
190 :     then ()
191 :     else errFn [
192 :     S "argument type mismatch in application of ",
193 :     S(Op.toString rator),
194 :     NL, S "expected: ", TYS paramTys,
195 :     NL, S "found: ", TYS argTys
196 :     ];
197 :     resTy
198 :     end
199 :     | IR.E_Cons([], ty) => (
200 :     errFn [S "empty cons"];
201 :     ty)
202 :     | IR.E_Cons(es, consTy as Ty.TensorTy(d, ty)) => (
203 :     if (length es <> d)
204 :     then errFn [
205 :     S "cons has incorrect number of elements",
206 :     NL, S " expected: ", S(Int.toString d),
207 :     NL, S " found: ", S(Int.toString(length es))
208 :     ]
209 :     else ();
210 :     chkElems ("cons", ty, es);
211 :     consTy)
212 : jhr 3768 | IR.E_Cons(es, ty) => (
213 :     errFn [S "unexpected type for cons: ", TY ty];
214 :     ty)
215 : jhr 3754 | IR.E_Seq([], ty as Ty.SeqTy(_, SOME 0)) => ty
216 :     | IR.E_Seq([], ty as Ty.SeqTy(_, SOME n)) => (
217 :     errFn [S "empty sequence, but expected ", TY ty];
218 :     ty)
219 :     | IR.E_Seq(es, seqTy as Ty.SeqTy(ty, NONE)) => (
220 :     chkElems ("sequence", ty, es);
221 :     seqTy)
222 :     | IR.E_Seq(es, seqTy as Ty.SeqTy(ty, SOME n)) => (
223 :     if (length es <> n)
224 :     then errFn [
225 :     S "sequence has incorrect number of elements",
226 :     NL, S " expected: ", S(Int.toString n),
227 :     NL, S " found: ", S(Int.toString(length es))
228 :     ]
229 :     else ();
230 :     chkElems ("sequence", ty, es);
231 :     seqTy)
232 :     | IR.E_Seq(es, ty) => (
233 :     errFn [S "unexpected type for sequence: ", TY ty];
234 :     ty)
235 : jhr 3768 | IR.E_Pack es => raise Fail "FIXME"
236 : jhr 3754 (* end case *))
237 :     and chkElems (cxt, ty, []) = ()
238 :     | chkElems (cxt, ty, e::es) = let
239 :     val ty' = chk e
240 :     in
241 :     if Ty.same(ty, ty')
242 :     then ()
243 :     else errFn [
244 :     S "element of ", S cxt, S " has incorrect type",
245 :     NL, S "expected: ", TY ty,
246 :     NL, S "found: ", TY ty'
247 :     ];
248 :     chkElems (cxt, ty, es)
249 :     end
250 :     in
251 :     chk e
252 :     end
253 :     fun chkStm (stm, bvs) = (case stm
254 :     of IR.S_Comment _ => bvs
255 : jhr 3767 | IR.S_Unpack(xs, e) => let
256 : jhr 3754 fun chkVar (x, ty) = if Ty.same(Var.ty x, ty)
257 :     then ()
258 :     else errFn[
259 :     S "type mismatch in assignment to ", S(Var.name x),
260 :     NL, S "lhs: ", TY(Var.ty x),
261 :     NL, S "rhs: ", TY ty
262 :     ]
263 :     in
264 :     case (xs, chkExp (bvs, e))
265 : jhr 3767 of (_, Ty.VecTy(w, _, dd)) => (
266 : jhr 3754 if (List.length xs <> List.length dd)
267 :     then errFn [
268 :     S "arity mismatch in assigning composite vector",
269 :     NL, S" lhs arity: ", S(Int.toString(List.length xs)),
270 :     NL, S" rhs arity: ", S(Int.toString(List.length dd))
271 :     ]
272 :     else ();
273 : jhr 3767 ListPair.app (fn (x, d) => chkVar(x, Ty.vecTy d)) (xs, dd))
274 :     | ([x], ty) => chkVar (x, ty)
275 : jhr 3754 | (_::_, ty) => errFn [
276 :     S "assignment of non-composite value to (",
277 :     S(String.concatWithMap "," Var.name xs), S ")"
278 :     ]
279 :     (* end case *);
280 :     bvs
281 :     end
282 : jhr 3767 | IR.S_Assign(x, e) => let
283 :     val ty = chkExp (bvs, e)
284 :     in
285 :     if Ty.same(Var.ty x, ty)
286 :     then ()
287 :     else errFn[
288 :     S "type mismatch in assignment to local ", S(Var.name x),
289 :     NL, S "lhs: ", TY(Var.ty x),
290 :     NL, S "rhs: ", TY ty
291 :     ];
292 :     bvs
293 :     end
294 : jhr 3754 | IR.S_GAssign(gv, e) => let
295 :     val ty = chkExp (bvs, e)
296 :     in
297 :     if Ty.same(GVar.ty gv, ty)
298 :     then ()
299 :     else errFn[
300 :     S "type mismatch in assignment to global ", S(GVar.name gv),
301 :     NL, S "lhs: ", TY(GVar.ty gv),
302 :     NL, S "rhs: ", TY ty
303 :     ];
304 :     bvs
305 :     end
306 :     | IR.S_IfThen(e, b) => let
307 :     val ty = chkExp (bvs, e)
308 :     in
309 :     if Ty.same(ty, Ty.BoolTy)
310 :     then ()
311 :     else errFn[
312 :     S "expected bool for if-then, but found ", TY ty
313 :     ];
314 :     chkBlock (bvs, b);
315 :     bvs
316 :     end
317 :     | IR.S_IfThenElse(e, b1, b2) => let
318 :     val ty = chkExp (bvs, e)
319 :     in
320 :     if Ty.same(ty, Ty.BoolTy)
321 :     then ()
322 :     else errFn[
323 :     S "expected bool for if-then-else, but found ", TY ty
324 :     ];
325 :     chkBlock (bvs, b1);
326 :     chkBlock (bvs, b2);
327 :     bvs
328 :     end
329 :     | IR.S_Foreach(x, e, b) => (
330 :     case chkExp (bvs, e)
331 :     of Ty.SeqTy(ty, _) =>
332 :     if Ty.same(ty, Var.ty x)
333 :     then ()
334 :     else errFn [
335 :     S "type mismatch in foreach ", V x,
336 :     NL, S "variable type: ", TY(Var.ty x),
337 :     NL, S "domain type: ", TY ty
338 :     ]
339 :     | ty => errFn [
340 :     S "domain of foreach is not sequence type; found ", TY ty
341 :     ]
342 :     (* end case *);
343 :     ignore (chkBlock (VSet.add(bvs, x), b));
344 :     bvs)
345 :     | IR.S_LoadNrrd(x, name) => bvs (* FIXME: check type if x *)
346 :     | IR.S_Input(gv, _, _, NONE) => bvs
347 :     | IR.S_Input(gv, _, _, SOME e) => let
348 :     val ty = chkExp (bvs, e)
349 :     in
350 :     if Ty.same(GVar.ty gv, ty)
351 :     then ()
352 :     else errFn[
353 :     S "type mismatch in default for input ", S(GVar.name gv),
354 :     NL, S "expected: ", TY(GVar.ty gv),
355 :     NL, S "found: ", TY ty
356 :     ];
357 :     bvs
358 :     end
359 :     | IR.S_InputNrrd(gv, _, _, _) => (
360 :     case GVar.ty gv
361 :     of Ty.SeqTy(_, NONE) => ()
362 :     | Ty.ImageTy _ => ()
363 :     | ty => errFn [
364 :     S "input variable ", S(GVar.name gv), S " has bogus type ",
365 :     TY ty, S " for lhs for InputNrrd"
366 :     ]
367 :     (* end case *);
368 :     bvs)
369 :     | IR.S_New(_, es) => (
370 :     List.app (fn e => ignore (chkExp(bvs, e))) es;
371 :     bvs)
372 : jhr 3767 | IR.S_Save(sv, e) => let
373 :     val ty = chkExp (bvs, e)
374 : jhr 3754 in
375 : jhr 3767 if Ty.same(SVar.ty sv, ty)
376 :     then ()
377 :     else errFn[
378 :     S "type mismatch in assignment to state variable ",
379 :     S(SVar.name sv),
380 :     NL, S "lhs: ", TY(SVar.ty sv),
381 :     NL, S "rhs: ", TY ty
382 :     ];
383 : jhr 3754 bvs
384 :     end
385 :     | IR.S_Exit es => (
386 :     List.app (fn e => ignore (chkExp(bvs, e))) es;
387 :     bvs)
388 : jhr 3768 | IR.S_Print(tys, es) => (
389 :     if (length tys <> length es)
390 :     then errFn [
391 :     ]
392 :     else ();
393 :     ListPair.appi
394 :     (fn (i, ty, e) => let val ty' = chkExp(bvs, e)
395 :     in
396 :     if Ty.same(ty, ty')
397 :     then ()
398 :     else errFn[
399 :     S "type mismatch in argument ", S(Int.toString i),
400 :     S " of print",
401 :     NL, S "expected: ", TY ty,
402 :     NL, S "but found: ", TY ty'
403 :     ]
404 :     end)
405 :     (tys, es);
406 :     bvs)
407 : jhr 3754 | IR.S_Active => bvs
408 :     | IR.S_Stabilize => bvs
409 :     | IR.S_Die => bvs
410 :     (* end case *))
411 :     val bvs = List.foldl VSet.add' bvs locals
412 :     in
413 :     ignore (List.foldl chkStm bvs body)
414 :     end
415 :     fun chkOptBlock (_, NONE) = ()
416 :     | chkOptBlock (bvs, SOME blk) = ignore (chkBlock (bvs, blk))
417 :     fun chkStrand (IR.Strand{name, params, state, stateInit, initM, updateM, stabilizeM}) = (
418 :     ignore (chkBlock (VSet.fromList params, stateInit));
419 :     chkOptBlock (VSet.empty, initM);
420 :     ignore (chkBlock (VSet.empty, updateM));
421 :     chkOptBlock (VSet.empty, stabilizeM))
422 :     in
423 :     ignore (chkBlock (VSet.empty, constInit));
424 :     ignore (chkBlock (VSet.empty, globalInit));
425 :     chkStrand strand;
426 :     case create of IR.Create{code, ...} => ignore (chkBlock (VSet.empty, code));
427 :     chkOptBlock (VSet.empty, update);
428 :     final ()
429 :     end
430 :    
431 :     end

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