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

SCM Repository

[diderot] Diff of /trunk/src/compiler/typechecker/typechecker.sml
ViewVC logotype

Diff of /trunk/src/compiler/typechecker/typechecker.sml

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

trunk/src/typechecker/typechecker.sml revision 96, Thu May 27 17:57:31 2010 UTC trunk/src/compiler/typechecker/typechecker.sml revision 171, Sat Jul 24 14:13:10 2010 UTC
# Line 17  Line 17 
17      structure TU = TypeUtil      structure TU = TypeUtil
18      structure U = Util      structure U = Util
19    
20        type env = {globalScope : bool, env : Env.env}
21    
22      exception Error      exception Error
23    
24      type context = Error.err_stream * Error.span      type context = Error.err_stream * Error.span
# Line 91  Line 93 
93                    dim = checkDim (cxt, dim),                    dim = checkDim (cxt, dim),
94                    shape = checkShape (cxt, shape)                    shape = checkShape (cxt, shape)
95                  }                  }
96              | PT.T_Array(ty, dims) => raise Fail "Array type"              | PT.T_Array(ty, dims) => raise Fail "Array type not supported"
97            (* end case *))            (* end case *))
98    
99      fun checkLit lit = (case lit      fun checkLit lit = (case lit
# Line 121  Line 123 
123            end            end
124    
125    (* typecheck an expression and translate it to AST *)    (* typecheck an expression and translate it to AST *)
126      fun checkExpr (env, cxt, e) = (case e      fun checkExpr (env : env, cxt, e) = (case e
127             of PT.E_Mark m => checkExpr (withEnvAndContext (env, cxt, m))             of PT.E_Mark m => checkExpr (withEnvAndContext (env, cxt, m))
128              | PT.E_Var x => (case Env.findVar (env, x)              | PT.E_Var x => (case Env.findVar (#env env, x)
129                   of SOME x' => let                   of SOME x' => (AST.E_Var x', Var.monoTypeOf x')
                       val (args, ty) = Util.instantiate(Var.typeOf x')  
                       in  
                         (AST.E_Var(x', args, ty), ty)  
                       end  
130                    | NONE => err(cxt, [S "undeclared variable ", A x])                    | NONE => err(cxt, [S "undeclared variable ", A x])
131                  (* end case *))                  (* end case *))
132              | PT.E_Lit lit => checkLit lit              | PT.E_Lit lit => checkLit lit
# Line 139  Line 137 
137                    case (ty1, ty2)                    case (ty1, ty2)
138                     of (Ty.T_Bool, Ty.T_Bool) =>                     of (Ty.T_Bool, Ty.T_Bool) =>
139                          (AST.E_Cond(e1', AST.E_Lit(Literal.Bool true), e2'), Ty.T_Bool)                          (AST.E_Cond(e1', AST.E_Lit(Literal.Bool true), e2'), Ty.T_Bool)
140                      | _ => raise Fail "arguments to \"||\" must have bool type"                      | _ => err (cxt, [S "arguments to \"||\" must have bool type"])
141                    (* end case *)                    (* end case *)
142                  end                  end
143              | PT.E_AndAlso(e1, e2) => let              | PT.E_AndAlso(e1, e2) => let
# Line 149  Line 147 
147                    case (ty1, ty2)                    case (ty1, ty2)
148                     of (Ty.T_Bool, Ty.T_Bool) =>                     of (Ty.T_Bool, Ty.T_Bool) =>
149                          (AST.E_Cond(e1', e2', AST.E_Lit(Literal.Bool false)), Ty.T_Bool)                          (AST.E_Cond(e1', e2', AST.E_Lit(Literal.Bool false)), Ty.T_Bool)
150                      | _ => raise Fail "arguments to \"||\" must have bool type"                      | _ => err (cxt, [S "arguments to \"&&\" must have bool type"])
151                    (* end case *)                    (* end case *)
152                  end                  end
153              | PT.E_BinOp(e1, rator, e2) => let              | PT.E_BinOp(e1, rator, e2) => let
# Line 197  Line 195 
195              | PT.E_Apply(f, args) => let              | PT.E_Apply(f, args) => let
196                  val (args, tys) = checkExprList (env, cxt, args)                  val (args, tys) = checkExprList (env, cxt, args)
197                  in                  in
198                    case Env.findVar (env, f)                    case Env.findFunc (#env env, f)
199                     of SOME f => (case Util.instantiate(Var.typeOf f)                     of SOME f =>
200                            if (#globalScope env) orelse not(Basis.isRestricted f)
201                              then (case Util.instantiate(Var.typeOf f)
202                           of (tyArgs, Ty.T_Fun(domTy, rngTy)) =>                           of (tyArgs, Ty.T_Fun(domTy, rngTy)) =>
203                                if U.matchTypes(domTy, tys)                                if U.matchTypes(domTy, tys)
204                                  then (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)                                  then (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)
# Line 207  Line 207 
207                                      S "  expected:  ", TYS domTy, S "\n",                                      S "  expected:  ", TYS domTy, S "\n",
208                                      S "  but found: ", TYS tys, S "\n"                                      S "  but found: ", TYS tys, S "\n"
209                                    ])                                    ])
210                            | _ => raise Fail "application of non-function"                                | _ => err(cxt, [S "application of non-function ", V f])
211                          (* end case *))                          (* end case *))
212                      | NONE => raise Fail "unknown function"                            else err(cxt, [S "use of restricted operation ", V f, S " in actor body"])
213                        | NONE => err(cxt, [S "unknown function ", A f])
214                    (* end case *)                    (* end case *)
215                  end                  end
216              | PT.E_Cons args => let              | PT.E_Cons args => let
# Line 222  Line 223 
223                          in                          in
224                            if List.all chkTy tys                            if List.all chkTy tys
225                              then (AST.E_Cons args, resTy)                              then (AST.E_Cons args, resTy)
226                              else raise Fail "arguments of tensor construction must have same type"                              else err(cxt, [S "arguments of tensor construction must have same type"])
227                          end                          end
228                      | _ => raise Fail "Invalid argument type for tensor construction"                      | _ => err(cxt, [S "Invalid argument type for tensor construction"])
229                    (* end case *)                    (* end case *)
230                  end                  end
231              | PT.E_Real e => (case checkExpr (env, cxt, e)              | PT.E_Real e => (case checkExpr (env, cxt, e)
232                   of (e', Ty.T_Int) =>                   of (e', Ty.T_Int) =>
233                        (AST.E_Apply(BasisVars.i2r, [], [e'], Ty.realTy), Ty.realTy)                        (AST.E_Apply(BasisVars.i2r, [], [e'], Ty.realTy), Ty.realTy)
234                    | _ => raise Fail "argument of real conversion must be int"                    | _ => err(cxt, [S "argument of real conversion must be int"])
235                  (* end case *))                  (* end case *))
236            (* end case *))            (* end case *))
237    
# Line 254  Line 255 
255                  val x' = Var.new (x, kind, ty)                  val x' = Var.new (x, kind, ty)
256                  val (e', ty') = checkExpr (env, cxt, e)                  val (e', ty') = checkExpr (env, cxt, e)
257                  in                  in
258  (* FIXME: check types *)  (* FIXME: this check is not flexible enough; should allow lhs type to support
259                    (x, x', e')   * fewer levels of differentiation than rhs provides.
260     *)
261                      if U.matchType(ty, ty')
262                        then (x, x', e')
263                        else err(cxt, [
264                            S "type of variable ", A x,
265                            S " does not match type of initializer\n",
266                            S "  expected: ", TY ty, S "\n",
267                            S "  but found: ", TY ty', S "\n"
268                          ])
269                  end                  end
270            (* end case *))            (* end case *))
271    
272        fun checkGlobalExpr (env, cxt, exp) = checkExpr ({globalScope=true, env=env}, cxt, exp)
273        fun checkLocalExpr (env, cxt, exp) = checkExpr ({globalScope=false, env=env}, cxt, exp)
274        fun checkLocalExprList (env, cxt, exp) = checkExprList ({globalScope=false, env=env}, cxt, exp)
275    
276    (* typecheck a statement and translate it to AST *)    (* typecheck a statement and translate it to AST *)
277      fun checkStmt (env, cxt, s) = (case s      fun checkStmt (env, cxt, s) = (case s
278             of PT.S_Mark m => checkStmt (withEnvAndContext (env, cxt, m))             of PT.S_Mark m => checkStmt (withEnvAndContext (env, cxt, m))
# Line 273  Line 287 
287                    (chk (env, stms, []), env)                    (chk (env, stms, []), env)
288                  end                  end
289              | PT.S_Decl vd => let              | PT.S_Decl vd => let
290                  val (x, x', e) = checkVarDecl (env, cxt, Var.LocalVar, vd)                  val (x, x', e) = checkVarDecl ({globalScope=false, env=env}, cxt, Var.LocalVar, vd)
291                  in                  in
292                    (AST.S_Decl(AST.VD_Decl(x', e)), Env.insertLocal(env, x, x'))                    (AST.S_Decl(AST.VD_Decl(x', e)), Env.insertLocal(env, x, x'))
293                  end                  end
294              | PT.S_IfThen(e, s) => let              | PT.S_IfThen(e, s) => let
295                  val (e', ty) = checkExpr (env, cxt, e)                  val (e', ty) = checkLocalExpr (env, cxt, e)
296                  val (s', _) = checkStmt (env, cxt, s)                  val (s', _) = checkStmt (env, cxt, s)
297                  in                  in
298                  (* check that condition has bool type *)                  (* check that condition has bool type *)
299                    case ty                    case ty
300                     of Ty.T_Bool => ()                     of Ty.T_Bool => ()
301                      | _ => raise Fail "condition not boolean type"                      | _ => err(cxt, [S "condition not boolean type"])
302                    (* end case *);                    (* end case *);
303                    (AST.S_IfThenElse(e', s', AST.S_Block[]), env)                    (AST.S_IfThenElse(e', s', AST.S_Block[]), env)
304                  end                  end
305              | PT.S_IfThenElse(e, s1, s2) => let              | PT.S_IfThenElse(e, s1, s2) => let
306                  val (e', ty) = checkExpr (env, cxt, e)                  val (e', ty) = checkLocalExpr (env, cxt, e)
307                  val (s1', _) = checkStmt (env, cxt, s1)                  val (s1', _) = checkStmt (env, cxt, s1)
308                  val (s2', _) = checkStmt (env, cxt, s2)                  val (s2', _) = checkStmt (env, cxt, s2)
309                  in                  in
310                  (* check that condition has bool type *)                  (* check that condition has bool type *)
311                    case ty                    case ty
312                     of Ty.T_Bool => ()                     of Ty.T_Bool => ()
313                      | _ => raise Fail "condition not boolean type"                      | _ => err(cxt, [S "condition not boolean type"])
314                    (* end case *);                    (* end case *);
315                    (AST.S_IfThenElse(e', s1', s2'), env)                    (AST.S_IfThenElse(e', s1', s2'), env)
316                  end                  end
317              | PT.S_Assign(x, e) => (case Env.findVar (env, x)              | PT.S_Assign(x, e) => (case Env.findVar (env, x)
318                   of NONE => raise Fail "undefined variable"                   of NONE => err(cxt, [
319                            S "undefined variable ", A x
320                          ])
321                    | SOME x' => let                    | SOME x' => let
322                        val (e', ty) = checkExpr (env, cxt, e)  (* FIXME: check for polymorphic variables *)
323                          val ([], ty) = Var.typeOf x'
324                          val (e', ty') = checkLocalExpr (env, cxt, e)
325                        in                        in
326  (* FIXME: check types *)                          if U.matchType(ty, ty')
327                              then (x, x', e')
328                              else err(cxt, [
329                                  S "type of assigned variable ", A x,
330                                  S " does not match type of rhs\n",
331                                  S "  expected: ", TY ty, S "\n",
332                                  S "  but found: ", TY ty', S "\n"
333                                ]);
334                        (* check that x' is mutable *)                        (* check that x' is mutable *)
335                          case Var.kindOf x'                          case Var.kindOf x'
336                           of Var.ActorStateVar => ()                           of Var.ActorStateVar => ()
337                            | Var.LocalVar => ()                            | Var.LocalVar => ()
338                            | _ => raise Fail "assignment to immutable variable"                            | _ => err(cxt, [
339                                    S "assignment to immutable variable ", A x
340                                  ])
341                          (* end case *);                          (* end case *);
342                          (AST.S_Assign(x', e'), env)                          (AST.S_Assign(x', e'), env)
343                        end                        end
344                  (* end case *))                  (* end case *))
345              | PT.S_New(actor, args) => let              | PT.S_New(actor, args) => let
346                  val argsAndTys' = List.map (fn e => checkExpr(env, cxt, e)) args                  val argsAndTys' = List.map (fn e => checkLocalExpr(env, cxt, e)) args
347                  val (args', tys') = ListPair.unzip argsAndTys'                  val (args', tys') = ListPair.unzip argsAndTys'
348                  in                  in
349  (* FIXME: check that actor is defined and has the argument types match *)  (* FIXME: check that actor is defined and has the argument types match *)
# Line 359  Line 386 
386            val (params, env) = checkParams (env, cxt, params)            val (params, env) = checkParams (env, cxt, params)
387          (* check the actor state variable definitions *)          (* check the actor state variable definitions *)
388            val (vds, env) = let            val (vds, env) = let
389                  fun checkStateVar (vd, (vds, env)) = let                  fun checkStateVar ((isOut, vd), (vds, env)) = let
390                        val (x, x', e') = checkVarDecl (env, cxt, AST.ActorStateVar, vd)                        val (x, x', e') = checkVarDecl ({globalScope=false, env=env}, cxt, AST.ActorStateVar, vd)
391                        in                        in
392                          (AST.VD_Decl(x', e')::vds, Env.insertLocal(env, x, x'))                          ((isOut, AST.VD_Decl(x', e'))::vds, Env.insertLocal(env, x, x'))
393                        end                        end
394                  val (vds, env) = List.foldl checkStateVar ([], env) state                  val (vds, env) = List.foldl checkStateVar ([], env) state
395                  in                  in
# Line 376  Line 403 
403    
404      fun checkCreate (env, cxt, PT.C_Mark m) = checkCreate (withEnvAndContext (env, cxt, m))      fun checkCreate (env, cxt, PT.C_Mark m) = checkCreate (withEnvAndContext (env, cxt, m))
405        | checkCreate (env, cxt, PT.C_Create(actor, args)) = let        | checkCreate (env, cxt, PT.C_Create(actor, args)) = let
406            val (args, tys) = checkExprList (env, cxt, args)            val (args, tys) = checkLocalExprList (env, cxt, args)
407            in            in
408  (* FIXME: check against actor definition *)  (* FIXME: check against actor definition *)
409              AST.C_Create(actor, args)              AST.C_Create(actor, args)
# Line 384  Line 411 
411    
412      fun checkIter (env, cxt, PT.I_Mark m) = checkIter (withEnvAndContext (env, cxt, m))      fun checkIter (env, cxt, PT.I_Mark m) = checkIter (withEnvAndContext (env, cxt, m))
413        | checkIter (env, cxt, PT.I_Range(x, e1, e2)) = let        | checkIter (env, cxt, PT.I_Range(x, e1, e2)) = let
414            val (e1', ty1) = checkExpr (env, cxt, e1)            val (e1', ty1) = checkLocalExpr (env, cxt, e1)
415            val (e2', ty2) = checkExpr (env, cxt, e2)            val (e2', ty2) = checkLocalExpr (env, cxt, e2)
416            val x' = Var.new(x, Var.LocalVar, Ty.T_Int)            val x' = Var.new(x, Var.LocalVar, Ty.T_Int)
417            val env' = Env.insertLocal(env, x, x')            val env' = Env.insertLocal(env, x, x')
418            in            in
# Line 417  Line 444 
444                  val dcl = (case optExp                  val dcl = (case optExp
445                         of NONE => AST.D_Input(x', NONE)                         of NONE => AST.D_Input(x', NONE)
446                          | SOME e => let                          | SOME e => let
447                              val (e', ty') = checkExpr (env, cxt, e)                              val (e', ty') = checkGlobalExpr (env, cxt, e)
448                              in                              in
449                                if U.matchType (ty, ty')                                if U.matchType (ty, ty')
450                                  then AST.D_Input(x', SOME e')                                  then AST.D_Input(x', SOME e')
# Line 432  Line 459 
459                    (dcl, Env.insertGlobal(env, x, x'))                    (dcl, Env.insertGlobal(env, x, x'))
460                  end                  end
461              | PT.D_Var vd => let              | PT.D_Var vd => let
462                  val (x, x', e') = checkVarDecl (env, cxt, Var.GlobalVar, vd)                  val (x, x', e') = checkVarDecl ({globalScope=true, env=env}, cxt, Var.GlobalVar, vd)
463                  in                  in
464                    (AST.D_Var(AST.VD_Decl(x', e')), Env.insertGlobal(env, x, x'))                    (AST.D_Var(AST.VD_Decl(x', e')), Env.insertGlobal(env, x, x'))
465                  end                  end

Legend:
Removed from v.96  
changed lines
  Added in v.171

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