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

SCM Repository

[diderot] Diff of /branches/pure-cfg/src/compiler/typechecker/typechecker.sml
ViewVC logotype

Diff of /branches/pure-cfg/src/compiler/typechecker/typechecker.sml

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

revision 894, Wed Apr 20 16:18:45 2011 UTC revision 895, Wed Apr 20 17:20:44 2011 UTC
# Line 28  Line 28 
28    
29      datatype scope = GlobalScope | StrandScope | MethodScope | InitScope      datatype scope = GlobalScope | StrandScope | MethodScope | InitScope
30    
31      type env = {scope : scope, env : Env.env}      type env = {
32            scope : scope,
33            bindings : Error.location AtomMap.map,
34            env : Env.env
35          }
36    
37        type context = Error.err_stream * Error.span
38    
39      fun strandScope {scope, env} = {scope=StrandScope, env=env}    (* start a new scope *)
40      fun methodScope {scope, env} = {scope=MethodScope, env=env}      fun strandScope {scope, bindings, env} =
41      fun initScope {scope, env} = {scope=InitScope, env=env}            {scope=StrandScope, bindings=AtomMap.empty, env=env}
42        fun methodScope {scope, bindings, env} =
43              {scope=MethodScope, bindings=AtomMap.empty, env=env}
44        fun initScope {scope, bindings, env} =
45              {scope=InitScope, bindings=AtomMap.empty, env=env}
46        fun blockScope {scope, bindings, env} =
47              {scope=scope, bindings=AtomMap.empty, env=env}
48    
49      fun inStrand {scope=StrandScope, env} = true      fun inStrand {scope=StrandScope, bindings, env} = true
50        | inStrand {scope=MethodScope, ...} = true        | inStrand {scope=MethodScope, ...} = true
51        | inStrand _ = false        | inStrand _ = false
52    
53      fun insertLocal ({scope, env}, x, x') = {scope=scope, env=Env.insertLocal(env, x, x')}      fun insertLocal ({scope, bindings, env}, cxt, x, x') = {
54      fun insertGlobal ({scope, env}, x, x') = {scope=scope, env=Env.insertGlobal(env, x, x')}              scope=scope,
55                bindings = AtomMap.insert(bindings, x, Error.location cxt),
56                env=Env.insertLocal(env, x, x')
57              }
58        fun insertGlobal ({scope, bindings, env}, cxt, x, x') = {
59                scope=scope,
60                bindings = AtomMap.insert(bindings, x, Error.location cxt),
61                env=Env.insertGlobal(env, x, x')
62              }
63    
64      exception Error      exception Error
65    
     type context = Error.err_stream * Error.span  
   
66      fun withContext ((errStrm, _), {span, tree}) =      fun withContext ((errStrm, _), {span, tree}) =
67            ((errStrm, span), tree)            ((errStrm, span), tree)
68      fun withEnvAndContext (env, (errStrm, _), {span, tree}) =      fun withEnvAndContext (env, (errStrm, _), {span, tree}) =
# Line 72  Line 90 
90              error(cxt, List.map tok2str toks)              error(cxt, List.map tok2str toks)
91            end            end
92    
93        fun checkForRedef (env : env, cxt : context, x) = (case AtomMap.find(#bindings env,x)
94               of SOME loc => err (cxt, [
95                      S "redefinition of ", A x, S ", previous definition at ",
96                      S(Error.locToString loc)
97                    ])
98                | NONE => ()
99              (* end case *))
100    
101      val realZero = AST.E_Lit(Literal.Float(FloatLit.zero true))      val realZero = AST.E_Lit(Literal.Float(FloatLit.zero true))
102    
103    (* check a differentiation level, which muse be >= 0 *)    (* check a differentiation level, which muse be >= 0 *)
# Line 186  Line 212 
212                            then (AST.E_Cond(cond', e1', e2', ty1), ty1)                            then (AST.E_Cond(cond', e1', e2', ty1), ty1)
213                            else err (cxt, [                            else err (cxt, [
214                                S "type do not match in conditional expression\n",                                S "type do not match in conditional expression\n",
215                                S "  true branch:  ", TY ty1,                                S "  true branch:  ", TY ty1, S "\n",
216                                S "  false branch: ", TY ty2                                S "  false branch: ", TY ty2
217                              ])                              ])
218                      | (_, ty') => err (cxt, [S "expected bool type, but found ", TY ty'])                      | (_, ty') => err (cxt, [S "expected bool type, but found ", TY ty'])
# Line 236  Line 262 
262                                  else err (cxt, [                                  else err (cxt, [
263                                      S "type error for binary operator \"", V rator, S "\"\n",                                      S "type error for binary operator \"", V rator, S "\"\n",
264                                      S "  expected:  ", TYS domTy, S "\n",                                      S "  expected:  ", TYS domTy, S "\n",
265                                      S "  but found: ", TYS[ty1, ty2], S "\n"                                      S "  but found: ", TYS[ty1, ty2]
266                                    ])                                    ])
267                              end                              end
268                          | ovldList => resolveOverload (cxt, rator, [ty1, ty2], [e1', e2'], ovldList)                          | ovldList => resolveOverload (cxt, rator, [ty1, ty2], [e1', e2'], ovldList)
# Line 254  Line 280 
280                              else err (cxt, [                              else err (cxt, [
281                                  S "type error for unary operator \"", V rator, S "\"\n",                                  S "type error for unary operator \"", V rator, S "\"\n",
282                                  S "  expected:  ", TY domTy, S "\n",                                  S "  expected:  ", TY domTy, S "\n",
283                                  S "  but found: ", TY ty, S "\n"                                  S "  but found: ", TY ty
284                                ])                                ])
285                          end                          end
286                      | ovldList => resolveOverload (cxt, rator, [ty], [e'], ovldList)                      | ovldList => resolveOverload (cxt, rator, [ty], [e'], ovldList)
# Line 270  Line 296 
296                            then (SOME e')                            then (SOME e')
297                            else err (cxt, [                            else err (cxt, [
298                                S "type error in index expression\n",                                S "type error in index expression\n",
299                                S "  expected int, but found: ", TY ty, S "\n"                                S "  expected int, but found: ", TY ty
300                              ])                              ])
301                        end                        end
302                  val indices' = List.map checkIndex indices                  val indices' = List.map checkIndex indices
# Line 283  Line 309 
309                      else err (cxt, [                      else err (cxt, [
310                          S "type error in slice operation\n",                          S "type error in slice operation\n",
311                          S "  expected:  ", S(Int.toString order), S "-order tensor\n",                          S "  expected:  ", S(Int.toString order), S "-order tensor\n",
312                          S "  but found: ", TY ty, S "\n"                          S "  but found: ", TY ty
313                        ]);                        ]);
314                    (AST.E_Slice(e', indices', resultTy), resultTy)                    (AST.E_Slice(e', indices', resultTy), resultTy)
315                  end                  end
# Line 308  Line 334 
334                                      else err(cxt, [                                      else err(cxt, [
335                                          S "type error in application of ", V f, S "\n",                                          S "type error in application of ", V f, S "\n",
336                                          S "  expected:  ", TYS domTy, S "\n",                                          S "  expected:  ", TYS domTy, S "\n",
337                                          S "  but found: ", TYS tys, S "\n"                                          S "  but found: ", TYS tys
338                                        ])                                        ])
339                                | _ => err(cxt, [S "application of non-function ", V f])                                | _ => err(cxt, [S "application of non-function ", V f])
340                              (* end case *))                              (* end case *))
# Line 393  Line 419 
419                          S "type of variable ", A x,                          S "type of variable ", A x,
420                          S " does not match type of initializer\n",                          S " does not match type of initializer\n",
421                          S "  expected: ", TY ty, S "\n",                          S "  expected: ", TY ty, S "\n",
422                          S "  but found: ", TY ty', S "\n"                          S "  but found: ", TY ty'
423                        ])                        ])
424                  end                  end
425            (* end case *))            (* end case *))
# Line 409  Line 435 
435                          chk (env', ss, s'::stms)                          chk (env', ss, s'::stms)
436                        end                        end
437                  in                  in
438                    (chk (env, stms, []), env)                    (chk (blockScope env, stms, []), env)
439                  end                  end
440              | PT.S_Decl vd => let              | PT.S_Decl vd => let
441                  val (x, x', e) = checkVarDecl (methodScope env, cxt, Var.LocalVar, vd)                  val (x, x', e) = checkVarDecl (env, cxt, Var.LocalVar, vd)
442                  in                  in
443                    (AST.S_Decl(AST.VD_Decl(x', e)), insertLocal(env, x, x'))                    checkForRedef (env, cxt, x);
444                      (AST.S_Decl(AST.VD_Decl(x', e)), insertLocal(env, cxt, x, x'))
445                  end                  end
446              | PT.S_IfThen(e, s) => let              | PT.S_IfThen(e, s) => let
447                  val (e', ty) = checkExpr (env, cxt, e)                  val (e', ty) = checkExpr (env, cxt, e)
# Line 454  Line 481 
481                                S "type of assigned variable ", A x,                                S "type of assigned variable ", A x,
482                                S " does not match type of rhs\n",                                S " does not match type of rhs\n",
483                                S "  expected: ", TY ty, S "\n",                                S "  expected: ", TY ty, S "\n",
484                                S "  but found: ", TY ty', S "\n"                                S "  but found: ", TY ty'
485                              ]);                              ]);
486                        (* check that x' is mutable *)                        (* check that x' is mutable *)
487                          case Var.kindOf x'                          case Var.kindOf x'
# Line 500  Line 527 
527                    | PT.P_Param(ty, x) => let                    | PT.P_Param(ty, x) => let
528                        val x' = Var.new(x, AST.StrandParam, checkTy (cxt, ty))                        val x' = Var.new(x, AST.StrandParam, checkTy (cxt, ty))
529                        in                        in
530                          (x', insertLocal(env, x, x'))                          checkForRedef (env, cxt, x);
531                            (x', insertLocal(env, cxt, x, x'))
532                        end                        end
533                  (* end case *))                  (* end case *))
534            fun chk (param, (xs, env)) = let            fun chk (param, (xs, env)) = let
# Line 538  Line 566 
566                                TY(Var.monoTypeOf x')                                TY(Var.monoTypeOf x')
567                              ])                              ])
568                            else ();                            else ();
569                          (AST.VD_Decl(x', e')::vds, insertLocal(env, x, x'))                          checkForRedef (env, cxt, x);
570                            (AST.VD_Decl(x', e')::vds, insertLocal(env, cxt, x, x'))
571                        end                        end
572                  val (vds, env) = List.foldl checkStateVar ([], env) state                  val (vds, env) = List.foldl checkStateVar ([], env) state
573                  in                  in
# Line 586  Line 615 
615                     of (Ty.T_Int, Ty.T_Int) => (AST.I_Range(x', e1', e2'), (x, x'))                     of (Ty.T_Int, Ty.T_Int) => (AST.I_Range(x', e1', e2'), (x, x'))
616                      | _ => err(cxt, [                      | _ => err(cxt, [
617                            S "range expressions must have integer type\n",                            S "range expressions must have integer type\n",
618                            S "  but found: ", TY ty1, S " .. ", TY ty2, S "\n"                            S "  but found: ", TY ty1, S " .. ", TY ty2
619                          ])                          ])
620                    (* end case *)                    (* end case *)
621                  end                  end
622            fun chk ([], iters, bindings) =            fun chk ([], iters, bindings) =
623                  (List.rev iters, List.foldl (fn ((x, x'), env) => insertLocal(env, x, x')) env0 bindings)                  (List.rev iters, List.foldl (fn ((x, x'), env) => insertLocal(env, cxt, x, x')) env0 bindings)
624              | chk (iter::rest, iters, bindings) = let              | chk (iter::rest, iters, bindings) = let
625                  val (iter, binding) = checkIter (env0, cxt, iter)                  val (iter, binding) = checkIter (env0, cxt, iter)
626                  in                  in
# Line 616  Line 645 
645                                  else err(cxt, [                                  else err(cxt, [
646                                      S "definition of ", V x', S " has wrong type\n",                                      S "definition of ", V x', S " has wrong type\n",
647                                      S "  expected:  ", TY ty, S "\n",                                      S "  expected:  ", TY ty, S "\n",
648                                      S "  but found: ", TY ty', S "\n"                                      S "  but found: ", TY ty'
649                                    ])                                    ])
650                              end                              end
651                        (* end case *))                        (* end case *))
# Line 625  Line 654 
654                    if not(TU.isValueType ty)                    if not(TU.isValueType ty)
655                      then err(cxt, [S "input variable ", V x', S " has non-value type ", TY ty])                      then err(cxt, [S "input variable ", V x', S " has non-value type ", TY ty])
656                      else ();                      else ();
657                    (dcl, insertGlobal(env, x, x'))                    checkForRedef (env, cxt, x);
658                      (dcl, insertGlobal(env, cxt, x, x'))
659                  end                  end
660              | PT.D_Var vd => let              | PT.D_Var vd => let
661                  val (x, x', e') = checkVarDecl (env, cxt, Var.GlobalVar, vd)                  val (x, x', e') = checkVarDecl (env, cxt, Var.GlobalVar, vd)
662                  in                  in
663                    (AST.D_Var(AST.VD_Decl(x', e')), insertGlobal(env, x, x'))                    checkForRedef (env, cxt, x);
664                      (AST.D_Var(AST.VD_Decl(x', e')), insertGlobal(env, cxt, x, x'))
665                  end                  end
666              | PT.D_Strand arg => (checkStrand(strandScope env, cxt, arg), env)              | PT.D_Strand arg => (checkStrand(strandScope env, cxt, arg), env)
667              | PT.D_InitialArray(create, iterators) => let              | PT.D_InitialArray(create, iterators) => let
# Line 658  Line 689 
689                    chk (env, dcls, dcl'::dcls')                    chk (env, dcls, dcl'::dcls')
690                  end                  end
691            in            in
692              chk ({scope=GlobalScope, env=Basis.env}, tree, [])              chk ({scope=GlobalScope, bindings=AtomMap.empty, env=Basis.env}, tree, [])
693            end            end
694    
695    end    end

Legend:
Removed from v.894  
changed lines
  Added in v.895

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