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 227, Wed Aug 4 05:27:13 2010 UTC revision 228, Wed Aug 4 13:36:35 2010 UTC
# Line 2  Line 2 
2   *   *
3   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
4   * All rights reserved.   * All rights reserved.
5     *
6   *)   *)
7    
8  structure Typechecker : sig  structure Typechecker : sig
# Line 17  Line 18 
18      structure TU = TypeUtil      structure TU = TypeUtil
19      structure U = Util      structure U = Util
20    
21      type env = {globalScope : bool, env : Env.env}      datatype scope = GlobalScope | ActorScope | MethodScope | InitScope
22    
23        type env = {scope : scope, env : Env.env}
24    
25        fun actorScope {scope, env} = {scope=ActorScope, env=env}
26        fun methodScope {scope, env} = {scope=MethodScope, env=env}
27        fun initScope {scope, env} = {scope=InitScope, env=env}
28    
29        fun inActor {scope=ActorScope, env} = true
30          | inActor {scope=MethodScope, ...} = true
31          | inActor _ = false
32    
33        fun insertLocal ({scope, env}, x, x') = {scope=scope, env=Env.insertLocal(env, x, x')}
34        fun insertGlobal ({scope, env}, x, x') = {scope=scope, env=Env.insertGlobal(env, x, x')}
35    
36      exception Error      exception Error
37    
# Line 197  Line 211 
211                  in                  in
212                    case Env.findFunc (#env env, f)                    case Env.findFunc (#env env, f)
213                     of SOME f =>                     of SOME f =>
214                          if (#globalScope env) orelse not(Basis.isRestricted f)                          if (inActor env) andalso (Basis.isRestricted f)
215                            then (case Util.instantiate(Var.typeOf f)                            then err(cxt, [S "use of restricted operation ", V f, S " in actor body"])
216                              else (case Util.instantiate(Var.typeOf f)
217                               of (tyArgs, Ty.T_Fun(domTy, rngTy)) =>                               of (tyArgs, Ty.T_Fun(domTy, rngTy)) =>
218                                    if U.matchTypes(domTy, tys)                                    if U.matchTypes(domTy, tys)
219                                      then (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)                                      then (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)
# Line 209  Line 224 
224                                        ])                                        ])
225                                | _ => err(cxt, [S "application of non-function ", V f])                                | _ => err(cxt, [S "application of non-function ", V f])
226                              (* end case *))                              (* end case *))
                           else err(cxt, [S "use of restricted operation ", V f, S " in actor body"])  
227                      | NONE => err(cxt, [S "unknown function ", A f])                      | NONE => err(cxt, [S "unknown function ", A f])
228                    (* end case *)                    (* end case *)
229                  end                  end
# Line 269  Line 283 
283                  end                  end
284            (* end case *))            (* end case *))
285    
     fun checkGlobalExpr (env, cxt, exp) = checkExpr ({globalScope=true, env=env}, cxt, exp)  
     fun checkLocalExpr (env, cxt, exp) = checkExpr ({globalScope=false, env=env}, cxt, exp)  
     fun checkLocalExprList (env, cxt, exp) = checkExprList ({globalScope=false, env=env}, cxt, exp)  
   
286    (* typecheck a statement and translate it to AST *)    (* typecheck a statement and translate it to AST *)
287      fun checkStmt (env, cxt, s) = (case s      fun checkStmt (env, cxt, s) = (case s
288             of PT.S_Mark m => checkStmt (withEnvAndContext (env, cxt, m))             of PT.S_Mark m => checkStmt (withEnvAndContext (env, cxt, m))
# Line 287  Line 297 
297                    (chk (env, stms, []), env)                    (chk (env, stms, []), env)
298                  end                  end
299              | PT.S_Decl vd => let              | PT.S_Decl vd => let
300                  val (x, x', e) = checkVarDecl ({globalScope=false, env=env}, cxt, Var.LocalVar, vd)                  val (x, x', e) = checkVarDecl (methodScope env, cxt, Var.LocalVar, vd)
301                  in                  in
302                    (AST.S_Decl(AST.VD_Decl(x', e)), Env.insertLocal(env, x, x'))                    (AST.S_Decl(AST.VD_Decl(x', e)), insertLocal(env, x, x'))
303                  end                  end
304              | PT.S_IfThen(e, s) => let              | PT.S_IfThen(e, s) => let
305                  val (e', ty) = checkLocalExpr (env, cxt, e)                  val (e', ty) = checkExpr (env, cxt, e)
306                  val (s', _) = checkStmt (env, cxt, s)                  val (s', _) = checkStmt (env, cxt, s)
307                  in                  in
308                  (* check that condition has bool type *)                  (* check that condition has bool type *)
# Line 303  Line 313 
313                    (AST.S_IfThenElse(e', s', AST.S_Block[]), env)                    (AST.S_IfThenElse(e', s', AST.S_Block[]), env)
314                  end                  end
315              | PT.S_IfThenElse(e, s1, s2) => let              | PT.S_IfThenElse(e, s1, s2) => let
316                  val (e', ty) = checkLocalExpr (env, cxt, e)                  val (e', ty) = checkExpr (env, cxt, e)
317                  val (s1', _) = checkStmt (env, cxt, s1)                  val (s1', _) = checkStmt (env, cxt, s1)
318                  val (s2', _) = checkStmt (env, cxt, s2)                  val (s2', _) = checkStmt (env, cxt, s2)
319                  in                  in
# Line 314  Line 324 
324                    (* end case *);                    (* end case *);
325                    (AST.S_IfThenElse(e', s1', s2'), env)                    (AST.S_IfThenElse(e', s1', s2'), env)
326                  end                  end
327              | PT.S_Assign(x, e) => (case Env.findVar (env, x)              | PT.S_Assign(x, e) => (case Env.findVar (#env env, x)
328                   of NONE => err(cxt, [                   of NONE => err(cxt, [
329                          S "undefined variable ", A x                          S "undefined variable ", A x
330                        ])                        ])
331                    | SOME x' => let                    | SOME x' => let
332  (* FIXME: check for polymorphic variables *)  (* FIXME: check for polymorphic variables *)
333                        val ([], ty) = Var.typeOf x'                        val ([], ty) = Var.typeOf x'
334                        val (e', ty') = checkLocalExpr (env, cxt, e)                        val (e', ty') = checkExpr (env, cxt, e)
335                        in                        in
336                          if U.matchType(ty, ty')                          if U.matchType(ty, ty')
337                            then (x, x', e')                            then (x, x', e')
# Line 344  Line 354 
354                        end                        end
355                  (* end case *))                  (* end case *))
356              | PT.S_New(actor, args) => let              | PT.S_New(actor, args) => let
357                  val argsAndTys' = List.map (fn e => checkLocalExpr(env, cxt, e)) args                  val argsAndTys' = List.map (fn e => checkExpr(env, cxt, e)) args
358                  val (args', tys') = ListPair.unzip argsAndTys'                  val (args', tys') = ListPair.unzip argsAndTys'
359                  in                  in
360                      case #scope env
361                       of MethodScope => ()
362                        | InitScope => ()
363                        | _ => err(cxt, [S "invalid scope for new actor"])
364                      (* end case *);
365  (* FIXME: check that actor is defined and has the argument types match *)  (* FIXME: check that actor is defined and has the argument types match *)
366                    (AST.S_New(actor, args'), env)                    (AST.S_New(actor, args'), env)
367                  end                  end
368              | PT.S_Die => (AST.S_Die, env)              | PT.S_Die => (
369              | PT.S_Stabilize => (AST.S_Stabilize, env)                  case #scope env
370                     of ActorScope => ()
371                      | _ => err(cxt, [S "\"die\" statment outside of actor body"])
372                    (* end case *);
373                    (AST.S_Die, env))
374                | PT.S_Stabilize => (
375                    case #scope env
376                     of ActorScope => ()
377                      | _ => err(cxt, [S "\"stabilize\" statment outside of actor body"])
378                    (* end case *);
379                    (AST.S_Stabilize, env))
380            (* end case *))            (* end case *))
381    
382      fun checkParams (env, cxt, params) = let      fun checkParams (env, cxt, params) = let
# Line 360  Line 385 
385                    | PT.P_Param(ty, x) => let                    | PT.P_Param(ty, x) => let
386                        val x' = Var.new(x, AST.ActorParam, checkTy (cxt, ty))                        val x' = Var.new(x, AST.ActorParam, checkTy (cxt, ty))
387                        in                        in
388                          (x', Env.insertLocal(env, x, x'))                          (x', insertLocal(env, x, x'))
389                        end                        end
390                  (* end case *))                  (* end case *))
391            fun chk (param, (xs, env)) = let            fun chk (param, (xs, env)) = let
# Line 376  Line 401 
401      fun checkMethod (env, cxt, meth) = (case meth      fun checkMethod (env, cxt, meth) = (case meth
402             of PT.M_Mark m => checkMethod (withEnvAndContext (env, cxt, m))             of PT.M_Mark m => checkMethod (withEnvAndContext (env, cxt, m))
403              | PT.M_Method(name, body) => let              | PT.M_Method(name, body) => let
404                  val (body, _) = checkStmt(env, cxt, body)                  val (body, _) = checkStmt(methodScope env, cxt, body)
405                  in                  in
406                    AST.M_Method(name, body)                    AST.M_Method(name, body)
407                  end                  end
# Line 389  Line 414 
414            val (vds, env) = let            val (vds, env) = let
415                  fun checkStateVar ((isOut, vd), (vds, env)) = let                  fun checkStateVar ((isOut, vd), (vds, env)) = let
416                        val kind = if isOut then AST.ActorOutputVar else AST.ActorStateVar                        val kind = if isOut then AST.ActorOutputVar else AST.ActorStateVar
417                        val (x, x', e') = checkVarDecl ({globalScope=false, env=env}, cxt, kind, vd)                        val (x, x', e') = checkVarDecl (env, cxt, kind, vd)
418                        in                        in
419                          (AST.VD_Decl(x', e')::vds, Env.insertLocal(env, x, x'))                        (* check that output variables have value types *)
420                            if isOut andalso not(TU.isValueType(Var.monoTypeOf x'))
421                              then err(cxt, [
422                                  S "output variable ", V x', S " has non-value type ",
423                                  TY(Var.monoTypeOf x')
424                                ])
425                              else ();
426                            (AST.VD_Decl(x', e')::vds, insertLocal(env, x, x'))
427                        end                        end
428                  val (vds, env) = List.foldl checkStateVar ([], env) state                  val (vds, env) = List.foldl checkStateVar ([], env) state
429                  in                  in
# Line 405  Line 437 
437    
438      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))
439        | checkCreate (env, cxt, PT.C_Create(actor, args)) = let        | checkCreate (env, cxt, PT.C_Create(actor, args)) = let
440            val (args, tys) = checkLocalExprList (env, cxt, args)            val (args, tys) = checkExprList (env, cxt, args)
441            in            in
442  (* FIXME: check against actor definition *)  (* FIXME: check against actor definition *)
443              AST.C_Create(actor, args)              AST.C_Create(actor, args)
# Line 413  Line 445 
445    
446      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))
447        | checkIter (env, cxt, PT.I_Range(x, e1, e2)) = let        | checkIter (env, cxt, PT.I_Range(x, e1, e2)) = let
448            val (e1', ty1) = checkLocalExpr (env, cxt, e1)            val (e1', ty1) = checkExpr (env, cxt, e1)
449            val (e2', ty2) = checkLocalExpr (env, cxt, e2)            val (e2', ty2) = checkExpr (env, cxt, e2)
450            val x' = Var.new(x, Var.LocalVar, Ty.T_Int)            val x' = Var.new(x, Var.LocalVar, Ty.T_Int)
451            val env' = Env.insertLocal(env, x, x')            val env' = insertLocal(env, x, x')
452            in            in
453              case (ty1, ty2)              case (ty1, ty2)
454               of (Ty.T_Int, Ty.T_Int) => (AST.I_Range(x', e1', e2'), env')               of (Ty.T_Int, Ty.T_Int) => (AST.I_Range(x', e1', e2'), env')
# Line 446  Line 478 
478                  val dcl = (case optExp                  val dcl = (case optExp
479                         of NONE => AST.D_Input(x', NONE)                         of NONE => AST.D_Input(x', NONE)
480                          | SOME e => let                          | SOME e => let
481                              val (e', ty') = checkGlobalExpr (env, cxt, e)                              val (e', ty') = checkExpr (env, cxt, e)
482                              in                              in
483                                if U.matchType (ty, ty')                                if U.matchType (ty, ty')
484                                  then AST.D_Input(x', SOME e')                                  then AST.D_Input(x', SOME e')
# Line 458  Line 490 
490                              end                              end
491                        (* end case *))                        (* end case *))
492                  in                  in
493                    (dcl, Env.insertGlobal(env, x, x'))                  (* check that input variables have value types *)
494                      if not(TU.isValueType ty)
495                        then err(cxt, [S "input variable ", V x', S " has non-value type ", TY ty])
496                        else ();
497                      (dcl, insertGlobal(env, x, x'))
498                  end                  end
499              | PT.D_Var vd => let              | PT.D_Var vd => let
500                  val (x, x', e') = checkVarDecl ({globalScope=true, env=env}, cxt, Var.GlobalVar, vd)                  val (x, x', e') = checkVarDecl (env, cxt, Var.GlobalVar, vd)
501                  in                  in
502                    (AST.D_Var(AST.VD_Decl(x', e')), Env.insertGlobal(env, x, x'))                    (AST.D_Var(AST.VD_Decl(x', e')), insertGlobal(env, x, x'))
503                  end                  end
504              | PT.D_Actor arg => (checkActor(env, cxt, arg), env)              | PT.D_Actor arg => (checkActor(actorScope env, cxt, arg), env)
505              | PT.D_InitialArray(create, iterators) => let              | PT.D_InitialArray(create, iterators) => let
506                    val env = initScope env
507                  val (iterators, env') = checkIters (env, cxt, iterators)                  val (iterators, env') = checkIters (env, cxt, iterators)
508                  val create = checkCreate (env', cxt, create)                  val create = checkCreate (env', cxt, create)
509                  in                  in
510                    (AST.D_InitialArray(create, iterators), env)                    (AST.D_InitialArray(create, iterators), env)
511                  end                  end
512              | PT.D_InitialCollection(create, iterators) => let              | PT.D_InitialCollection(create, iterators) => let
513                    val env = initScope env
514                  val (iterators, env') = checkIters (env, cxt, iterators)                  val (iterators, env') = checkIters (env, cxt, iterators)
515                  val create = checkCreate (env', cxt, create)                  val create = checkCreate (env', cxt, create)
516                  in                  in
# Line 489  Line 527 
527                    chk (env, dcls, dcl'::dcls')                    chk (env, dcls, dcl'::dcls')
528                  end                  end
529            in            in
530              chk (Basis.env, tree, [])              chk ({scope=GlobalScope, env=Basis.env}, tree, [])
531            end            end
532    
533    end    end

Legend:
Removed from v.227  
changed lines
  Added in v.228

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