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 3955 - (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 3859 (* FIXME: the cehcking function should be parameterized over the vector layout of the target *)
12 : jhr 3757
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 : jhr 3861 structure Ty = TreeTypes
22 : jhr 3832 structure GVar = TreeGlobalVar
23 :     structure SVar = TreeStateVar
24 :     structure Var = TreeVar
25 : jhr 3754 structure VSet = Var.Set
26 :    
27 :     datatype token
28 : jhr 3889 = NL | S of string | I of int | 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 : jhr 3889 | tok2str (I i) = Int.toString i
35 : jhr 3754 | tok2str (A s) = Atom.toString s
36 :     | tok2str (V x) = Var.toString x
37 :     | tok2str (TY ty) = Ty.toString ty
38 :     | tok2str (TYS []) = "()"
39 :     | tok2str (TYS[ty]) = Ty.toString ty
40 :     | tok2str (TYS tys) = String.concat[
41 :     "(", String.concatWith " * " (List.map Ty.toString tys), ")"
42 :     ]
43 :     in
44 :     errBuf := concat ("**** Error: " :: List.map tok2str toks)
45 :     :: !errBuf
46 :     end
47 :    
48 : jhr 3757 (* utility function for synthesizing eigenvector/eigenvalue signature *)
49 :     fun eigenSig dim = let
50 :     val tplTy = Ty.TupleTy[
51 :     Ty.SeqTy(Ty.realTy, SOME dim),
52 : jhr 3861 Ty.SeqTy(Ty.TensorTy[dim], SOME dim)
53 : jhr 3757 ]
54 :     in
55 : jhr 3767 (* FIXME: what about pieces? *)
56 : jhr 3955 (tplTy, [Ty.TensorRefTy[dim, dim]])
57 : jhr 3757 end
58 :    
59 : jhr 3861 exception BadVecType of int
60 :    
61 : jhr 3757 (* Return the signature of a TreeIR operator. *)
62 : jhr 3861 fun sigOfOp (vecTy, rator) = (case rator
63 : jhr 3757 of Op.IAdd => (Ty.IntTy, [Ty.IntTy, Ty.IntTy])
64 :     | Op.ISub => (Ty.IntTy, [Ty.IntTy, Ty.IntTy])
65 :     | Op.IMul => (Ty.IntTy, [Ty.IntTy, Ty.IntTy])
66 :     | Op.IDiv => (Ty.IntTy, [Ty.IntTy, Ty.IntTy])
67 :     | Op.IMod => (Ty.IntTy, [Ty.IntTy, Ty.IntTy])
68 :     | Op.INeg => (Ty.IntTy, [Ty.IntTy])
69 : jhr 3870 | Op.RAdd => (Ty.realTy, [Ty.realTy, Ty.realTy])
70 :     | Op.RSub => (Ty.realTy, [Ty.realTy, Ty.realTy])
71 :     | Op.RMul => (Ty.realTy, [Ty.realTy, Ty.realTy])
72 :     | Op.RDiv => (Ty.realTy, [Ty.realTy, Ty.realTy])
73 :     | Op.RNeg => (Ty.realTy, [Ty.realTy])
74 :     | Op.RClamp => (Ty.realTy, [Ty.realTy, Ty.realTy, Ty.realTy])
75 :     | Op.RLerp => (Ty.realTy, [Ty.realTy, Ty.realTy, Ty.realTy])
76 : jhr 3880 | Op.RCeiling => (Ty.realTy, [Ty.realTy])
77 :     | Op.RFloor => (Ty.realTy, [Ty.realTy])
78 :     | Op.RRound => (Ty.realTy, [Ty.realTy])
79 :     | Op.RTrunc => (Ty.realTy, [Ty.realTy])
80 :     | Op.RealToInt => (Ty.IntTy, [Ty.realTy])
81 : jhr 3757 | Op.LT ty => (Ty.BoolTy, [ty, ty])
82 :     | Op.LTE ty => (Ty.BoolTy, [ty, ty])
83 :     | Op.EQ ty => (Ty.BoolTy, [ty, ty])
84 :     | Op.NEQ ty => (Ty.BoolTy, [ty, ty])
85 :     | Op.GT ty => (Ty.BoolTy, [ty, ty])
86 :     | Op.GTE ty => (Ty.BoolTy, [ty, ty])
87 :     | Op.Not => (Ty.BoolTy, [Ty.BoolTy])
88 :     | Op.Abs ty => (ty, [ty])
89 :     | Op.Max ty => (ty, [ty, ty])
90 :     | Op.Min ty => (ty, [ty, ty])
91 : jhr 3870 | Op.VAdd d => (vecTy d, [vecTy d, vecTy d])
92 :     | Op.VSub d => (vecTy d, [vecTy d, vecTy d])
93 :     | Op.VScale d => (vecTy d, [Ty.realTy, vecTy d])
94 :     | Op.VMul d => (vecTy d, [vecTy d, vecTy d])
95 :     | Op.VNeg d => (vecTy d, [vecTy d])
96 :     | Op.VSum d => (Ty.realTy, [vecTy d])
97 : jhr 3880 | Op.VIndex(d, pw, _) => (Ty.realTy, [vecTy(d, pw)])
98 : jhr 3861 | Op.VClamp d => (vecTy d, [vecTy d, Ty.realTy, Ty.realTy])
99 :     | Op.VMapClamp d => (vecTy d, [vecTy d, vecTy d, vecTy d])
100 :     | Op.VLerp d => (vecTy d, [vecTy d, vecTy d, Ty.realTy])
101 : jhr 3880 | Op.VCeiling d => (vecTy d, [vecTy d])
102 :     | Op.VFloor d => (vecTy d, [vecTy d])
103 :     | Op.VRound d => (vecTy d, [vecTy d])
104 :     | Op.VTrunc d => (vecTy d, [vecTy d])
105 :     | Op.VToInt(d, pw) => (Ty.SeqTy(Ty.IntTy, SOME d), [vecTy(d, pw)])
106 : jhr 3870 | Op.TensorIndex(ty, _) => (Ty.realTy, [ty])
107 : jhr 3955 | Op.ProjectLast(ty as Ty.TensorTy dd, _) => (Ty.TensorRefTy[List.last dd], [ty])
108 :     | Op.ProjectLast(ty as Ty.TensorRefTy dd, _) => (Ty.TensorRefTy[List.last dd], [ty])
109 :     | Op.TensorCopy shp => (Ty.TensorTy shp, [Ty.TensorRefTy shp])
110 : jhr 3757 | Op.EigenVecs2x2 => eigenSig 2
111 :     | Op.EigenVecs3x3 => eigenSig 3
112 : jhr 3767 (* FIXME: what about pieces? *)
113 : jhr 3955 | Op.EigenVals2x2 => (Ty.SeqTy(Ty.realTy, SOME 2), [Ty.TensorRefTy[2, 2]])
114 :     | Op.EigenVals3x3 => (Ty.SeqTy(Ty.realTy, SOME 3), [Ty.TensorRefTy[3, 3]])
115 : jhr 3757 | Op.Select(ty as Ty.TupleTy tys, i) => (List.nth(tys, i-1), [ty])
116 :     | Op.Subscript(ty as Ty.SeqTy(elemTy, _)) => (elemTy, [ty, Ty.intTy])
117 :     | Op.MkDynamic(ty, n) => (Ty.SeqTy(ty, NONE), [Ty.SeqTy(ty, SOME n)])
118 :     | Op.Prepend ty => (Ty.SeqTy(ty, NONE), [ty, Ty.SeqTy(ty, NONE)])
119 :     | Op.Append ty => (Ty.SeqTy(ty, NONE), [Ty.SeqTy(ty, NONE), ty])
120 :     | Op.Concat ty => (Ty.SeqTy(ty, NONE), [Ty.SeqTy(ty, NONE), Ty.SeqTy(ty, NONE)])
121 : jhr 3870 | Op.Range => (Ty.SeqTy(Ty.intTy, NONE), [Ty.IntTy, Ty.IntTy])
122 : jhr 3757 | Op.Length ty => (Ty.intTy, [Ty.SeqTy(ty, NONE)])
123 : jhr 3870 | Op.SphereQuery(ptTy, strandTy) => (Ty.SeqTy(strandTy, NONE), [ptTy, Ty.realTy])
124 :     | Op.Sqrt => (Ty.realTy, [Ty.realTy])
125 :     | Op.Cos => (Ty.realTy, [Ty.realTy])
126 :     | Op.ArcCos => (Ty.realTy, [Ty.realTy])
127 :     | Op.Sin => (Ty.realTy, [Ty.realTy])
128 :     | Op.ArcSin => (Ty.realTy, [Ty.realTy])
129 :     | Op.Tan => (Ty.realTy, [Ty.realTy])
130 :     | Op.ArcTan => (Ty.realTy, [Ty.realTy])
131 :     | Op.Exp => (Ty.realTy, [Ty.realTy])
132 : jhr 3757 | Op.IntToReal => (Ty.realTy, [Ty.intTy])
133 :     (* not sure if we will need these
134 :     | R_All of ty
135 :     | R_Exists of ty
136 :     | R_Max of ty
137 :     | R_Min of ty
138 :     | R_Sum of ty
139 :     | R_Product of ty
140 :     | R_Mean of ty
141 :     | R_Variance of ty
142 :     *)
143 : jhr 3870 | Op.Transform info => let
144 : jhr 3757 val dim = ImageInfo.dim info
145 :     in
146 : jhr 3870 if (dim = 1)
147 : jhr 3886 then (Ty.realTy, [Ty.ImageTy info])
148 : jhr 3955 else (Ty.TensorRefTy[dim, dim], [Ty.ImageTy info])
149 : jhr 3757 end
150 : jhr 3870 | Op.Translate info => let
151 : jhr 3757 val dim = ImageInfo.dim info
152 :     in
153 : jhr 3870 if (dim = 1)
154 : jhr 3886 then (Ty.realTy, [Ty.ImageTy info])
155 : jhr 3955 else (Ty.TensorRefTy[dim], [Ty.ImageTy info])
156 : jhr 3757 end
157 : jhr 3870 | Op.ControlIndex(info, _, _) => (Ty.IntTy, [Ty.ImageTy info, Ty.IntTy])
158 : jhr 3882 | Op.LoadVoxel info => (Ty.realTy, [Ty.ImageTy info, Ty.IntTy])
159 :     | Op.Inside(info, _) =>
160 :     (Ty.BoolTy, [Ty.SeqTy(Ty.IntTy, SOME(ImageInfo.dim info)), Ty.ImageTy info])
161 : jhr 3757 | Op.ImageDim(info, _) => (Ty.IntTy, [Ty.ImageTy info])
162 : jhr 3870 | Op.MathFn f => MathFns.sigOf (Ty.realTy, f)
163 : jhr 3757 | _ => raise Fail("sigOf: invalid operator " ^ Op.toString rator)
164 :     (* end case *))
165 :    
166 : jhr 3754 fun check (phase, prog) = let
167 : jhr 3870 val IR.Program{
168 :     props, target={layout, ...}, consts, inputs, constInit,
169 :     globals, globalInit, strand, create, update
170 :     } = prog
171 : jhr 3754 val errBuf = ref []
172 :     val errFn = error errBuf
173 :     fun final () = (case !errBuf
174 :     of [] => false
175 :     | errs => (
176 :     Log.msg ["********** IR Errors detected after ", phase, " **********\n"];
177 :     List.app (fn msg => Log.msg [msg, "\n"]) (List.rev errs);
178 :     true)
179 :     (* end case *))
180 : jhr 3870 fun sigOf rator = let
181 : jhr 3880 fun vecTy (d, pw) = let
182 :     fun invalid () = (
183 :     errFn [
184 : jhr 3889 S "invalid width ", I d, S " for ", S(Op.toString rator)
185 : jhr 3870 ];
186 : jhr 3880 Ty.VecTy(d, pw))
187 :     in
188 :     case layout d
189 :     of {padded, pieces=[w], ...} =>
190 :     if (w <> pw) then invalid() else Ty.VecTy(d, w)
191 :     | _ => invalid ()
192 :     (* end case *)
193 :     end
194 : jhr 3870 in
195 :     sigOfOp (vecTy, rator)
196 :     end
197 : jhr 3955 (* reference to the contents of a variable *)
198 :     fun refer (Ty.TensorTy shp) = Ty.TensorRefTy shp
199 :     | refer ty = ty
200 : jhr 3754 (* check a variable use *)
201 :     fun checkVar (bvs, x) = if VSet.member(bvs, x)
202 :     then ()
203 :     else errFn [S "variable ", V x, S " is not bound"]
204 : jhr 3870 fun chkBlock (bvs : VSet.set, IR.Block{locals, body}) = let
205 :     fun chkExp (cxt, bvs : VSet.set, e) = let
206 :     fun chk e = (case e
207 : jhr 3955 of IR.E_Global gv => refer(GVar.ty gv)
208 :     | IR.E_State(NONE, sv) => refer(SVar.ty sv)
209 : jhr 3870 | IR.E_State(SOME e, sv) => (
210 : jhr 3861 (* FIXME: check type of e *)
211 : jhr 3955 refer(SVar.ty sv))
212 :     | IR.E_Var x => (checkVar(bvs, x); refer(Var.ty x))
213 : jhr 3870 | IR.E_Lit(Literal.Int _) => Ty.IntTy
214 :     | IR.E_Lit(Literal.Real _) => Ty.realTy
215 :     | IR.E_Lit(Literal.String _) => Ty.StringTy
216 :     | IR.E_Lit(Literal.Bool _) => Ty.BoolTy
217 :     | IR.E_Op(rator, args) => let
218 :     val (resTy, paramTys) = sigOf rator
219 :     val argTys = List.map chk args
220 : jhr 3955 fun chkParam (pTy, aTy) = Ty.match{src=aTy, dst=pTy}
221 : jhr 3870 in
222 : jhr 3955 if ListPair.allEq chkParam (paramTys, argTys)
223 : jhr 3870 then ()
224 :     else errFn [
225 :     S "argument type mismatch in application of ",
226 :     S(Op.toString rator), S(cxt()),
227 :     NL, S "expected: ", TYS paramTys,
228 :     NL, S "found: ", TYS argTys
229 :     ];
230 :     resTy
231 :     end
232 : jhr 3889 | IR.E_Vec(w, pw, es) => let
233 : jhr 3870 fun chkArg (i, e) = (case chk e
234 :     of Ty.VecTy(1, 1) => () (* ok *)
235 :     | ty => errFn [
236 : jhr 3889 S "component ", I i,
237 : jhr 3870 S " of vector does has type ", TY ty, S(cxt())
238 :     ])
239 : jhr 3889 val ty = Ty.VecTy(w, pw)
240 : jhr 3870 in
241 :     List.appi chkArg es;
242 : jhr 3889 if (length es <> w)
243 :     then errFn [
244 :     S "expected ", I w,
245 :     S " arguments to E_Vec, but found ", I(length es)
246 :     ]
247 :     else ();
248 : jhr 3870 ty
249 :     end
250 :     | IR.E_Cons([], ty) => (
251 :     errFn [S "empty cons", S(cxt())];
252 :     ty)
253 :     | IR.E_Cons(es, consTy as Ty.TensorTy dd) => let
254 :     val nelems = List.foldl Int.* 1 dd
255 :     in
256 :     if (length es <> nelems)
257 :     then errFn [
258 :     S "cons has incorrect number of elements", S(cxt()),
259 : jhr 3889 NL, S " expected: ", I nelems,
260 :     NL, S " found: ", I(length es)
261 : jhr 3870 ]
262 :     else ();
263 :     chkElems ("cons", Ty.realTy, es);
264 :     consTy
265 :     end
266 :     | IR.E_Cons(es, ty) => (
267 :     errFn [S "unexpected type for cons", S(cxt()), S ": ", TY ty];
268 :     ty)
269 :     | IR.E_Seq([], ty as Ty.SeqTy(_, SOME 0)) => ty
270 :     | IR.E_Seq([], ty as Ty.SeqTy(_, SOME n)) => (
271 :     errFn [S "empty sequence, but expected ", TY ty, S(cxt())];
272 :     ty)
273 :     | IR.E_Seq(es, seqTy as Ty.SeqTy(ty, NONE)) => (
274 :     chkElems ("sequence", ty, es);
275 :     seqTy)
276 :     | IR.E_Seq(es, seqTy as Ty.SeqTy(ty, SOME n)) => (
277 :     if (length es <> n)
278 :     then errFn [
279 :     S "sequence has incorrect number of elements", S(cxt()),
280 : jhr 3889 NL, S " expected: ", I n,
281 :     NL, S " found: ", I(length es)
282 : jhr 3870 ]
283 :     else ();
284 :     chkElems ("sequence", ty, es);
285 :     seqTy)
286 :     | IR.E_Seq(es, ty) => (
287 :     errFn [S "unexpected type for sequence", S(cxt()), S ": ", TY ty];
288 :     ty)
289 :     | IR.E_Pack(layout, es) => let
290 :     fun chkOne (i, ty, ty') = if Ty.same(ty, ty')
291 :     then ()
292 :     else errFn[
293 : jhr 3889 S "mismatch in component ", I i,
294 : jhr 3870 S " of PACK", S(cxt()),
295 :     NL, S " expected: ", TY ty',
296 :     NL, S " found: ", TY ty
297 :     ]
298 :     in
299 :     ListPair.appi chkOne (List.map chk es, Ty.piecesOf layout);
300 :     Ty.TensorTy[#wid layout]
301 :     end
302 :     | IR.E_VLoad(layout, e, i) => let
303 :     val ty = chk e
304 :     val expectedTy = Ty.TensorTy[#wid layout]
305 :     in
306 :     if Ty.same(ty, expectedTy)
307 :     then ()
308 :     else errFn [
309 :     S "type mismatch in E_VLoad, S(cxt())",
310 :     NL, S " expected: ", TY expectedTy,
311 :     NL, S " found: ", TY ty
312 :     ];
313 :     Ty.nthVec(layout, i)
314 :     end
315 :     (* end case *))
316 :     and chkElems (cxt', ty, []) = ()
317 :     | chkElems (cxt', ty, e::es) = let
318 :     val ty' = chk e
319 :     in
320 :     if Ty.same(ty, ty')
321 :     then ()
322 :     else errFn [
323 :     S "element of ", S cxt', S " has incorrect type", S(cxt()),
324 :     NL, S "expected: ", TY ty,
325 :     NL, S "found: ", TY ty'
326 :     ];
327 :     chkElems (cxt', ty, es)
328 :     end
329 :     in
330 :     chk e
331 :     end
332 :     fun chkStm (stm, bvs : VSet.set) = (case stm
333 :     of IR.S_Comment _ => bvs
334 :     | IR.S_Assign(isDef, x, e) => let
335 :     val ty = chkExp (
336 :     fn () => concat[" in assignment to local ", Var.name x],
337 :     bvs, e)
338 :     in
339 :     if Ty.same(Var.ty x, ty)
340 :     then ()
341 :     else errFn[
342 :     S "type mismatch in assignment to local ", S(Var.name x),
343 :     NL, S "lhs: ", TY(Var.ty x),
344 :     NL, S "rhs: ", TY ty
345 :     ];
346 :     if isDef
347 :     then VSet.add(bvs, x)
348 :     else (checkVar(bvs, x); bvs)
349 :     end
350 :     | IR.S_MAssign(xs, e) => raise Fail "FIXME"
351 :     | IR.S_GAssign(gv, e) => let
352 :     val ty = chkExp (
353 :     fn () => concat[" assignment to global ", GVar.name gv],
354 :     bvs, e)
355 :     in
356 :     if Ty.same(GVar.ty gv, ty)
357 :     then ()
358 :     else errFn[
359 :     S "type mismatch in assignment to global ", S(GVar.name gv),
360 :     NL, S "lhs: ", TY(GVar.ty gv),
361 :     NL, S "rhs: ", TY ty
362 :     ];
363 :     bvs
364 :     end
365 :     | IR.S_IfThen(e, b) => let
366 :     val ty = chkExp (fn () => " in if-then", bvs, e)
367 :     in
368 :     if Ty.same(ty, Ty.BoolTy)
369 :     then ()
370 :     else errFn[
371 :     S "expected bool for if-then, but found ", TY ty
372 :     ];
373 :     chkBlock (bvs, b);
374 :     bvs
375 :     end
376 :     | IR.S_IfThenElse(e, b1, b2) => let
377 :     val ty = chkExp (fn () => " in if-then-else", bvs, e)
378 :     in
379 :     if Ty.same(ty, Ty.BoolTy)
380 :     then ()
381 :     else errFn[
382 :     S "expected bool for if-then-else, but found ", TY ty
383 :     ];
384 :     chkBlock (bvs, b1);
385 :     chkBlock (bvs, b2);
386 :     bvs
387 :     end
388 : jhr 3924 | IR.S_For(x, e1, e2, b) => let
389 :     fun chkE e = (case chkExp (fn () => " in for", bvs, e)
390 :     of Ty.IntTy => ()
391 :     | ty => errFn [
392 :     S "bound of for is not int type; found ", TY ty
393 :     ]
394 :     (* end case *))
395 :     in
396 :     if (Ty.same(Ty.IntTy, Var.ty x))
397 :     then ()
398 :     else errFn [
399 :     S "iteration variable ", V x,
400 :     S " in for loop has type ", TY(Var.ty x)
401 :     ];
402 :     chkE e1; chkE e2;
403 :     ignore (chkBlock (VSet.add(bvs, x), b));
404 :     bvs
405 : jhr 3955 end
406 : jhr 3870 | IR.S_Foreach(x, e, b) => (
407 :     case chkExp (fn () => " in foreach", bvs, e)
408 :     of Ty.SeqTy(ty, _) =>
409 :     if Ty.same(ty, Var.ty x)
410 :     then ()
411 :     else errFn [
412 :     S "type mismatch in foreach ", V x,
413 :     NL, S "variable type: ", TY(Var.ty x),
414 :     NL, S "domain type: ", TY ty
415 :     ]
416 :     | ty => errFn [
417 :     S "domain of foreach is not sequence type; found ", TY ty
418 :     ]
419 :     (* end case *);
420 :     ignore (chkBlock (VSet.add(bvs, x), b));
421 :     bvs)
422 : jhr 3894 | IR.S_LoadNrrd(x, ty, name) => bvs (* FIXME: check type of x *)
423 : jhr 3870 | IR.S_Input(gv, _, _, NONE) => bvs
424 :     | IR.S_Input(gv, _, _, SOME e) => let
425 :     val ty = chkExp (fn () => concat[" in input ", GVar.name gv], bvs, e)
426 :     in
427 :     if Ty.same(GVar.ty gv, ty)
428 :     then ()
429 :     else errFn[
430 :     S "type mismatch in default for input ", S(GVar.name gv),
431 :     NL, S "expected: ", TY(GVar.ty gv),
432 :     NL, S "found: ", TY ty
433 :     ];
434 :     bvs
435 :     end
436 :     | IR.S_InputNrrd(gv, _, _, _) => (
437 :     case GVar.ty gv
438 :     of Ty.SeqTy(_, NONE) => ()
439 :     | Ty.ImageTy _ => ()
440 :     | ty => errFn [
441 :     S "input variable ", S(GVar.name gv), S " has bogus type ",
442 :     TY ty, S " for lhs for InputNrrd"
443 :     ]
444 :     (* end case *);
445 :     bvs)
446 :     | IR.S_New(_, es) => (
447 :     List.app (fn e => ignore (chkExp(fn () => concat[" in new"], bvs, e))) es;
448 :     bvs)
449 :     | IR.S_Save(sv, e) => let
450 :     val ty = chkExp (fn () => concat[" in save ", SVar.name sv], bvs, e)
451 :     in
452 :     if Ty.same(SVar.ty sv, ty)
453 :     then ()
454 :     else errFn[
455 :     S "type mismatch in assignment to state variable ",
456 :     S(SVar.name sv),
457 :     NL, S "lhs: ", TY(SVar.ty sv),
458 :     NL, S "rhs: ", TY ty
459 :     ];
460 :     bvs
461 :     end
462 :     | IR.S_Exit => bvs
463 :     | IR.S_Print(tys, es) => (
464 :     if (length tys <> length es)
465 :     then errFn [
466 :     ]
467 :     else ();
468 :     ListPair.appi
469 :     (fn (i, ty, e) => let
470 :     val ty' = chkExp(fn () => concat[" in print"], bvs, e)
471 :     in
472 :     if Ty.same(ty, ty')
473 :     then ()
474 :     else errFn[
475 : jhr 3889 S "type mismatch in argument ", I i,
476 : jhr 3870 S " of print",
477 :     NL, S "expected: ", TY ty,
478 :     NL, S "but found: ", TY ty'
479 :     ]
480 :     end)
481 :     (tys, es);
482 :     bvs)
483 :     | IR.S_Active => bvs
484 :     | IR.S_Stabilize => bvs
485 :     | IR.S_Die => bvs
486 :     (* end case *))
487 :     val bvs = VSet.addList(bvs, !locals)
488 :     in
489 :     ignore (List.foldl chkStm bvs body)
490 :     end
491 :     fun chkOptBlock (_, NONE) = ()
492 :     | chkOptBlock (bvs, SOME blk) = ignore (chkBlock (bvs, blk))
493 : jhr 3952 fun chkMethod (bvs, IR.Method{body, ...}) = ignore (chkBlock (bvs, body))
494 :     fun chkOptMethod (_, NONE) = ()
495 :     | chkOptMethod (bvs, SOME meth) = chkMethod (bvs, meth)
496 : jhr 3870 fun chkStrand (IR.Strand{name, params, state, stateInit, initM, updateM, stabilizeM}) = (
497 : jhr 3952 ignore (chkMethod (VSet.fromList params, stateInit));
498 :     chkOptMethod (VSet.empty, initM);
499 :     ignore (chkMethod (VSet.empty, updateM));
500 :     chkOptMethod (VSet.empty, stabilizeM))
501 : jhr 3870 in
502 :     ignore (chkBlock (VSet.empty, constInit));
503 :     ignore (chkBlock (VSet.empty, globalInit));
504 :     chkStrand strand;
505 :     case create of IR.Create{code, ...} => ignore (chkBlock (VSet.empty, code));
506 :     chkOptBlock (VSet.empty, update);
507 :     final ()
508 :     end
509 : jhr 3754
510 :     end

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