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

SCM Repository

[diderot] Diff of /branches/vis15/src/compiler/typechecker/check-stmt.sml
ViewVC logotype

Diff of /branches/vis15/src/compiler/typechecker/check-stmt.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3402, Wed Nov 11 02:54:23 2015 UTC revision 3407, Wed Nov 11 18:53:18 2015 UTC
# Line 8  Line 8 
8    
9  structure CheckStmt : sig  structure CheckStmt : sig
10    
11      val check : Env.env * Env.context * ParseTree.stmt -> AST.stmt      val check : Env.t * Env.context * ParseTree.stmt -> AST.stmt
12    
13    end = struct    end = struct
14    
15      structure PT = ParseTree      structure PT = ParseTree
16        structure L = Literal
17      structure E = Env      structure E = Env
18      structure Ty = Types      structure Ty = Types
19      structure BV = BasisVars      structure BV = BasisVars
# Line 20  Line 21 
21      val chkE = CheckExpr.check      val chkE = CheckExpr.check
22    
23    (* a statement to return when there is a type error *)    (* a statement to return when there is a type error *)
24      val bogusStm = (AST.E_Lit(L.Int 0), Ty.T_Error)      val bogusStm = AST.S_Block[]
25    
26      fun err arg = (TypeError.error arg; bogusExp)      fun err arg = (TypeError.error arg; bogusStm)
27      val warn = TypeError.warning      val warn = TypeError.warning
28    
29      datatype token = datatype TypeError.token      datatype token = datatype TypeError.token
# Line 30  Line 31 
31    (* typecheck a variable declaration *)    (* typecheck a variable declaration *)
32      fun checkVarDecl (env, cxt, kind, d) = (case d      fun checkVarDecl (env, cxt, kind, d) = (case d
33             of PT.VD_Mark m => checkVarDecl (env, (#1 cxt, #span m), kind, #tree m)             of PT.VD_Mark m => checkVarDecl (env, (#1 cxt, #span m), kind, #tree m)
34              | PT.VD_Decl(ty, x, e) => let              | PT.VD_Decl(ty, {span, tree=x}, e) => let
35                  val ty = checkTy (cxt, ty)                  val ty = CheckType.check (cxt, ty)
36                  val x' = Var.new (x, kind, ty)                  val x' = Var.new (x, Error.location(#1 cxt, span), kind, ty)
37                  val (e', ty') = checkExpr (env, cxt, e)                  val (e', ty') = chkE (env, cxt, e)
38                  in                  in
39                    case coerceType (ty, ty', e')                    case coerceType (ty, ty', e')
40                     of SOME e' => (x, x', e')                     of SOME e' => (x, x', e')
# Line 53  Line 54 
54     *)     *)
55      fun chkCtlFlow (cxt, scope, stm) = let      fun chkCtlFlow (cxt, scope, stm) = let
56            val (inFun, inInitOrUpdate, funName) = (case scope            val (inFun, inInitOrUpdate, funName) = (case scope
57                   of FunctionScope(_, f) => (true, false, Atom.toString f)                   of E.FunctionScope(_, f) => (true, false, Atom.toString f)
58                    | MethodScope StrandUtil.Initially => (false, true, "")                    | E.MethodScope StrandUtil.Initially => (false, true, "")
59                    | MethodScope StrandUtil.Update => (false, true, "")                    | E.MethodScope StrandUtil.Update => (false, true, "")
60                    | _ => (false, false, "")                    | _ => (false, false, "")
61                  (* end case *))                  (* end case *))
62          (* checks a statement for correct control flow; it returns false if control may          (* checks a statement for correct control flow; it returns false if control may
# Line 152  Line 153 
153                    (chk (Env.blockScope env, stms, []), env)                    (chk (Env.blockScope env, stms, []), env)
154                  end                  end
155              | PT.S_IfThen(e, s) => let              | PT.S_IfThen(e, s) => let
156                  val (e', ty) = checkExpr (env, cxt, e)                  val (e', ty) = chkE (env, cxt, e)
157                  val (s', _) = chkStmt (env, cxt, s)                  val (s', _) = chkStmt (env, cxt, s)
158                  in                  in
159                  (* check that condition has bool type *)                  (* check that condition has bool type *)
# Line 163  Line 164 
164                    (AST.S_IfThenElse(e', s', AST.S_Block[]), env)                    (AST.S_IfThenElse(e', s', AST.S_Block[]), env)
165                  end                  end
166              | PT.S_IfThenElse(e, s1, s2) => let              | PT.S_IfThenElse(e, s1, s2) => let
167                  val (e', ty) = checkExpr (env, cxt, e)                  val (e', ty) = chkE (env, cxt, e)
168                  val (s1', _) = chkStmt (env, cxt, s1)                  val (s1', _) = chkStmt (env, cxt, s1)
169                  val (s2', _) = chkStmt (env, cxt, s2)                  val (s2', _) = chkStmt (env, cxt, s2)
170                  in                  in
# Line 177  Line 178 
178              | PT.S_Foreach(iter, body) => ??              | PT.S_Foreach(iter, body) => ??
179              | PT.S_Print args => let              | PT.S_Print args => let
180                  fun chkArg e = let                  fun chkArg e = let
181                        val (e', ty) = checkExpr (env, cxt, e)                        val (e', ty) = chkE (env, cxt, e)
182                        in                        in
183                          if TU.isValueType ty                          if TU.isValueType ty
184                            then ()                            then ()
# Line 206  Line 207 
207              | PT.S_Continue => (* note that scope has already been checked in chkCtlFlow *)              | PT.S_Continue => (* note that scope has already been checked in chkCtlFlow *)
208                  (AST.S_Continue, env)                  (AST.S_Continue, env)
209              | PT.S_Return e => let              | PT.S_Return e => let
210                  val (e', ty) = checkExpr (env, cxt, e)                  val (e', ty) = chkE (env, cxt, e)
211                  in                  in
212                    case #scope env                    case #scope env
213                     of FunctionScope(ty', f) => (case coerceType(ty', ty, e')                     of FunctionScope(ty', f) => (case coerceType(ty', ty, e')
# Line 231  Line 232 
232                   of SOME x' => let                   of SOME x' => let
233                        val e1' = AST.E_Var x'                        val e1' = AST.E_Var x'
234                        val ty1 = Var.monoTypeOf x'                        val ty1 = Var.monoTypeOf x'
235                        val (e2', ty2) = checkExpr(env, cxt, e)                        val (e2', ty2) = chkE(env, cxt, e)
236                        val Env.PrimFun ovldList = Env.findFunc (#env env, rator)                        val Env.PrimFun ovldList = Env.findFunc (#env env, rator)
237                        val (rhs, _) = resolveOverload (cxt, rator, [ty1, ty2], [e1', e2'], ovldList)                        val (rhs, _) = resolveOverload (cxt, rator, [ty1, ty2], [e1', e2'], ovldList)
238                        in                        in
# Line 242  Line 243 
243                            | Var.LocalVar => ()                            | Var.LocalVar => ()
244                            | _ => err(cxt, [                            | _ => err(cxt, [
245                                  S "assignment to immutable variable ", A x,                                  S "assignment to immutable variable ", A x,
246                                  S " in ", S(scopeToString(#scope env))                                  S " in ", S(E.scopeToString(#scope env))
247                                ])                                ])
248                          (* end case *);                          (* end case *);
249                          (AST.S_Assign(x', rhs), env)                          (AST.S_Assign(x', rhs), env)
# Line 251  Line 252 
252                  (* end case *))                  (* end case *))
253              | PT.S_OpAssign(x, e) => (case Env.findVar (#env env, x)              | PT.S_OpAssign(x, e) => (case Env.findVar (#env env, x)
254                   of NONE => err(cxt, [                   of NONE => err(cxt, [
255                          S "undefined variable ", A x                          S "undefined variable '", A x, S "' on lhs of assignment"
256                        ])                        ])
257                    | SOME x' => let                    | SOME x' => let
 (* FIXME: check for polymorphic variables *)  
258                        val ([], ty) = Var.typeOf x'                        val ([], ty) = Var.typeOf x'
259                        val (e', ty') = checkExpr (env, cxt, e)                        val eTy = chkE (env, cxt, e)
260                          fun illegalAssign kind = err(cxt, [
261                                  S "assignment to ", S kind, S " '", A x,
262                                  S "' in ", S(E.scopeToString(#scope env))
263                                ])
264                        (* check for assignment to variables that are immutable because of their type *)
265                          fun chkAssign () = (case Var.typeOf x'
266                                 of (Ty.T_Field _) => illegalAssign "field-valued variable"
267                                  | (Ty.T_Image _) => illegalAssign "image-valued variable"
268                                  | (Ty.T_Kernel _) => illegalAssign "kernel-valued variable"
269                                  | ty => let
270                      (* check for promotion *)                      (* check for promotion *)
271                        val e' = (case coerceType(ty, ty', e')                                    val e' = (case Util.coerceType(ty, eTy)
272                               of SOME e' => e'                                           of SOME(e', _) => e'
273                                | NONE => err(cxt, [                                | NONE => err(cxt, [
274                                      S "type of assigned variable ", A x,                                      S "type of assigned variable ", A x,
275                                      S " does not match type of rhs\n",                                      S " does not match type of rhs\n",
# Line 268  Line 278 
278                                    ])                                    ])
279                              (* end case *))                              (* end case *))
280                        in                        in
                       (* check that x' is mutable *)  
                         case Var.kindOf x'  
                          of Var.StrandStateVar => ()  
                           | Var.StrandOutputVar => markUsed (x', true)  
                           | Var.LocalVar => ()  
                           | _ => err(cxt, [  
                                 S "assignment to immutable variable ", A x,  
                                 S " in ", S(scopeToString(#scope env))  
                               ])  
                         (* end case *);  
281                          (AST.S_Assign(x', e'), env)                          (AST.S_Assign(x', e'), env)
282                        end                        end
283                  (* end case *))                  (* end case *))
284                        (* check that assignment to global variables is allowed in the current scope *)
285                          fun chkGlobalAssign () = (case E.currentScope env
286                                 of E.FunctionScope _ => illegalAssign "global variable"
287                                  | E.MethodScope _ => illegalAssign "global variable"
288                                  | E.InitScope => chkAssign()
289                                  | E.UpdateScope => chkAssign()
290                                  | _ => raise Fail "impossible scope"
291                                (* end case *))
292                          in
293                          (* check that assigning to x' is okay *)
294                            case Var.kindOf x'
295                             of Var.BasisVar => illegalAssign "builtin function"
296                              | Var.ConstVar => illegalAssign "constant variable"
297                              | Var.InputVar => chkGlobalAssign ()
298                              | Var.GlobalVar => chkGlobalAssign ()
299                              | Var.FunVar => illegalAssign "function"
300                              | Var.FunParam => illegalAssign "function parameter"
301                              | Var.StrandParam => illegalAssign "strand parameter"
302                              | _ => chkAssign ()
303                            (* end case *)
304                          end
305                    (* end case *))
306              | PT.S_Deprecate(msg, stm) => (              | PT.S_Deprecate(msg, stm) => (
307                  warn (cxt, [S msg]);                  warn (cxt, [S msg]);
308                  chk (env, cxt, stm))                  chk (env, cxt, stm))
309            (* end case *))            (* end case *))
310    
311      fun check () = (      fun check arg = (chkCtlFlow arg; chk arg)
           chkCtlFlow (cxt, scope, stm);  
           chk (cxt, scope, stm))  
312    
313    end    end

Legend:
Removed from v.3402  
changed lines
  Added in v.3407

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