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

revision 164, Tue Jul 20 18:56:04 2010 UTC revision 169, Thu Jul 22 20:07:37 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 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' => let
130                        val (args, ty) = Util.instantiate(Var.typeOf x')                        val (args, ty) = Util.instantiate(Var.typeOf x')
131                        in                        in
# Line 197  Line 199 
199              | PT.E_Apply(f, args) => let              | PT.E_Apply(f, args) => let
200                  val (args, tys) = checkExprList (env, cxt, args)                  val (args, tys) = checkExprList (env, cxt, args)
201                  in                  in
202                    case Env.findVar (env, f)                    case Env.findFunc (#env env, f)
203                     of SOME f => (case Util.instantiate(Var.typeOf f)                     of SOME f =>
204                            if (#globalScope env) orelse not(Basis.isRestricted f)
205                              then (case Util.instantiate(Var.typeOf f)
206                           of (tyArgs, Ty.T_Fun(domTy, rngTy)) =>                           of (tyArgs, Ty.T_Fun(domTy, rngTy)) =>
207                                if U.matchTypes(domTy, tys)                                if U.matchTypes(domTy, tys)
208                                  then (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)                                  then (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)
# Line 209  Line 213 
213                                    ])                                    ])
214                            | _ => err(cxt, [S "application of non-function ", V f])                            | _ => err(cxt, [S "application of non-function ", V f])
215                          (* end case *))                          (* end case *))
216                              else err(cxt, [S "use of restricted operation ", V f, S " in actor body"])
217                      | NONE => err(cxt, [S "unknown function ", A f])                      | NONE => err(cxt, [S "unknown function ", A f])
218                    (* end case *)                    (* end case *)
219                  end                  end
# Line 268  Line 273 
273                  end                  end
274            (* end case *))            (* end case *))
275    
276        fun checkGlobalExpr (env, cxt, exp) = checkExpr ({globalScope=true, env=env}, cxt, exp)
277        fun checkLocalExpr (env, cxt, exp) = checkExpr ({globalScope=false, env=env}, cxt, exp)
278        fun checkLocalExprList (env, cxt, exp) = checkExprList ({globalScope=false, env=env}, cxt, exp)
279    
280    (* typecheck a statement and translate it to AST *)    (* typecheck a statement and translate it to AST *)
281      fun checkStmt (env, cxt, s) = (case s      fun checkStmt (env, cxt, s) = (case s
282             of PT.S_Mark m => checkStmt (withEnvAndContext (env, cxt, m))             of PT.S_Mark m => checkStmt (withEnvAndContext (env, cxt, m))
# Line 282  Line 291 
291                    (chk (env, stms, []), env)                    (chk (env, stms, []), env)
292                  end                  end
293              | PT.S_Decl vd => let              | PT.S_Decl vd => let
294                  val (x, x', e) = checkVarDecl (env, cxt, Var.LocalVar, vd)                  val (x, x', e) = checkVarDecl ({globalScope=false, env=env}, cxt, Var.LocalVar, vd)
295                  in                  in
296                    (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'))
297                  end                  end
298              | PT.S_IfThen(e, s) => let              | PT.S_IfThen(e, s) => let
299                  val (e', ty) = checkExpr (env, cxt, e)                  val (e', ty) = checkLocalExpr (env, cxt, e)
300                  val (s', _) = checkStmt (env, cxt, s)                  val (s', _) = checkStmt (env, cxt, s)
301                  in                  in
302                  (* check that condition has bool type *)                  (* check that condition has bool type *)
# Line 298  Line 307 
307                    (AST.S_IfThenElse(e', s', AST.S_Block[]), env)                    (AST.S_IfThenElse(e', s', AST.S_Block[]), env)
308                  end                  end
309              | PT.S_IfThenElse(e, s1, s2) => let              | PT.S_IfThenElse(e, s1, s2) => let
310                  val (e', ty) = checkExpr (env, cxt, e)                  val (e', ty) = checkLocalExpr (env, cxt, e)
311                  val (s1', _) = checkStmt (env, cxt, s1)                  val (s1', _) = checkStmt (env, cxt, s1)
312                  val (s2', _) = checkStmt (env, cxt, s2)                  val (s2', _) = checkStmt (env, cxt, s2)
313                  in                  in
# Line 316  Line 325 
325                    | SOME x' => let                    | SOME x' => let
326  (* FIXME: check for polymorphic variables *)  (* FIXME: check for polymorphic variables *)
327                        val ([], ty) = Var.typeOf x'                        val ([], ty) = Var.typeOf x'
328                        val (e', ty') = checkExpr (env, cxt, e)                        val (e', ty') = checkLocalExpr (env, cxt, e)
329                        in                        in
330                          if U.matchType(ty, ty')                          if U.matchType(ty, ty')
331                            then (x, x', e')                            then (x, x', e')
# Line 338  Line 347 
347                        end                        end
348                  (* end case *))                  (* end case *))
349              | PT.S_New(actor, args) => let              | PT.S_New(actor, args) => let
350                  val argsAndTys' = List.map (fn e => checkExpr(env, cxt, e)) args                  val argsAndTys' = List.map (fn e => checkLocalExpr(env, cxt, e)) args
351                  val (args', tys') = ListPair.unzip argsAndTys'                  val (args', tys') = ListPair.unzip argsAndTys'
352                  in                  in
353  (* 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 382  Line 391 
391          (* check the actor state variable definitions *)          (* check the actor state variable definitions *)
392            val (vds, env) = let            val (vds, env) = let
393                  fun checkStateVar ((isOut, vd), (vds, env)) = let                  fun checkStateVar ((isOut, vd), (vds, env)) = let
394                        val (x, x', e') = checkVarDecl (env, cxt, AST.ActorStateVar, vd)                        val (x, x', e') = checkVarDecl ({globalScope=false, env=env}, cxt, AST.ActorStateVar, vd)
395                        in                        in
396                          ((isOut, AST.VD_Decl(x', e'))::vds, Env.insertLocal(env, x, x'))                          ((isOut, AST.VD_Decl(x', e'))::vds, Env.insertLocal(env, x, x'))
397                        end                        end
# Line 398  Line 407 
407    
408      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))
409        | checkCreate (env, cxt, PT.C_Create(actor, args)) = let        | checkCreate (env, cxt, PT.C_Create(actor, args)) = let
410            val (args, tys) = checkExprList (env, cxt, args)            val (args, tys) = checkLocalExprList (env, cxt, args)
411            in            in
412  (* FIXME: check against actor definition *)  (* FIXME: check against actor definition *)
413              AST.C_Create(actor, args)              AST.C_Create(actor, args)
# Line 406  Line 415 
415    
416      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))
417        | checkIter (env, cxt, PT.I_Range(x, e1, e2)) = let        | checkIter (env, cxt, PT.I_Range(x, e1, e2)) = let
418            val (e1', ty1) = checkExpr (env, cxt, e1)            val (e1', ty1) = checkLocalExpr (env, cxt, e1)
419            val (e2', ty2) = checkExpr (env, cxt, e2)            val (e2', ty2) = checkLocalExpr (env, cxt, e2)
420            val x' = Var.new(x, Var.LocalVar, Ty.T_Int)            val x' = Var.new(x, Var.LocalVar, Ty.T_Int)
421            val env' = Env.insertLocal(env, x, x')            val env' = Env.insertLocal(env, x, x')
422            in            in
# Line 439  Line 448 
448                  val dcl = (case optExp                  val dcl = (case optExp
449                         of NONE => AST.D_Input(x', NONE)                         of NONE => AST.D_Input(x', NONE)
450                          | SOME e => let                          | SOME e => let
451                              val (e', ty') = checkExpr (env, cxt, e)                              val (e', ty') = checkGlobalExpr (env, cxt, e)
452                              in                              in
453                                if U.matchType (ty, ty')                                if U.matchType (ty, ty')
454                                  then AST.D_Input(x', SOME e')                                  then AST.D_Input(x', SOME e')
# Line 454  Line 463 
463                    (dcl, Env.insertGlobal(env, x, x'))                    (dcl, Env.insertGlobal(env, x, x'))
464                  end                  end
465              | PT.D_Var vd => let              | PT.D_Var vd => let
466                  val (x, x', e') = checkVarDecl (env, cxt, Var.GlobalVar, vd)                  val (x, x', e') = checkVarDecl ({globalScope=true, env=env}, cxt, Var.GlobalVar, vd)
467                  in                  in
468                    (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'))
469                  end                  end

Legend:
Removed from v.164  
changed lines
  Added in v.169

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