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

SCM Repository

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

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

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

revision 88, Wed May 26 23:07:50 2010 UTC revision 89, Thu May 27 01:37:21 2010 UTC
# Line 160  Line 160 
160                          in                          in
161                            if U.matchTypes(domTy, [ty1, ty2])                            if U.matchTypes(domTy, [ty1, ty2])
162                              then (AST.E_Apply(rator, tyArgs, [e1', e2'], rngTy), rngTy)                              then (AST.E_Apply(rator, tyArgs, [e1', e2'], rngTy), rngTy)
163                              else raise Fail(concat[                              else err (cxt, [
164                                  "type error for binary operator \"", Var.nameOf rator, "\""                                  S "type error for binary operator \"", V rator, S "\"\n",
165                                    S "  expected:  ", TYS domTy, S "\n",
166                                    S "  but found: ", TYS[ty1, ty2], S "\n"
167                                ])                                ])
168                          end                          end
169                      | ovldList => resolveOverload (rator, [ty1, ty2], [e1', e2'], ovldList)                      | ovldList => resolveOverload (rator, [ty1, ty2], [e1', e2'], ovldList)
# Line 176  Line 178 
178                          in                          in
179                            if U.matchType(domTy, ty)                            if U.matchType(domTy, ty)
180                              then (AST.E_Apply(rator, tyArgs, [e'], rngTy), rngTy)                              then (AST.E_Apply(rator, tyArgs, [e'], rngTy), rngTy)
181                              else raise Fail(concat[                              else err (cxt, [
182                                  "type error for unary operator \"", Var.nameOf rator, "\""                                  S "type error for unary operator \"", V rator, S "\"\n",
183                                    S "  expected:  ", TY domTy, S "\n",
184                                    S "  but found: ", TY ty, S "\n"
185                                ])                                ])
186                          end                          end
187                      | ovldList => resolveOverload (rator, [ty], [e'], ovldList)                      | ovldList => resolveOverload (rator, [ty], [e'], ovldList)
# Line 368  Line 372 
372              AST.D_Actor{name = name, params = params, state = vds, methods = methods}              AST.D_Actor{name = name, params = params, state = vds, methods = methods}
373            end            end
374    
375        fun checkCreate (env, cxt, PT.C_Mark m) = checkCreate (withEnvAndContext (env, cxt, m))
376          | checkCreate (env, cxt, PT.C_Create(actor, args)) = let
377              val (args, tys) = checkExprList (env, cxt, args)
378              in
379    (* FIXME: check against actor definition *)
380                AST.C_Create(actor, args)
381              end
382    
383        fun checkIter (env, cxt, PT.I_Mark m) = checkIter (withEnvAndContext (env, cxt, m))
384          | checkIter (env, cxt, PT.I_Range(x, e1, e2)) = let
385              val (e1', ty1) = checkExpr (env, cxt, e1)
386              val (e2', ty2) = checkExpr (env, cxt, e2)
387              val x' = Var.new(x, Var.LocalVar, Ty.T_Int)
388              val env' = Env.insertLocal(env, x, x')
389              in
390                case (ty1, ty2)
391                 of (Ty.T_Int, Ty.T_Int) => (AST.I_Range(x', e1', e2'), env')
392                  | _ => err(cxt, [
393                        S "range expressions must have integer type\n",
394                        S "  but found: ", TY ty1, S " .. ", TY ty2, S "\n"
395                      ])
396                (* end case *)
397              end
398    
399        fun checkIters (env, cxt, iters) = let
400              fun chk (env, [], iters) = (List.rev iters, env)
401                | chk (env, iter::rest, iters) = let
402                    val (iter, env) = checkIter (env, cxt, iter)
403                    in
404                      chk (env, rest, iter::iters)
405                    end
406              in
407                chk (env, iters, [])
408              end
409    
410      fun checkDecl (env, cxt, d) = (case d      fun checkDecl (env, cxt, d) = (case d
411             of PT.D_Mark m => checkDecl (withEnvAndContext (env, cxt, m))             of PT.D_Mark m => checkDecl (withEnvAndContext (env, cxt, m))
412              | PT.D_Input(ty, x, optExp) => let              | PT.D_Input(ty, x, optExp) => let
# Line 378  Line 417 
417                          | SOME e => let                          | SOME e => let
418                              val (e', ty') = checkExpr (env, cxt, e)                              val (e', ty') = checkExpr (env, cxt, e)
419                              in                              in
420  (* FIXME: check types *)                                if U.matchType (ty, ty')
421                                AST.D_Input(x', SOME e')                                  then AST.D_Input(x', SOME e')
422                                    else err(cxt, [
423                                        S "definition of ", V x', S " has wrong type\n",
424                                        S "  expected:  ", TY ty, S "\n",
425                                        S "  but found: ", TY ty', S "\n"
426                                      ])
427                              end                              end
428                        (* end case *))                        (* end case *))
429                  in                  in
# Line 391  Line 435 
435                    (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'))
436                  end                  end
437              | PT.D_Actor arg => (checkActor(env, cxt, arg), env)              | PT.D_Actor arg => (checkActor(env, cxt, arg), env)
438              | PT.D_InitialArray(bindings, iterators) => raise Fail "unimplemented" (* FIXME *)              | PT.D_InitialArray(create, iterators) => let
439              | PT.D_InitialCollection(bindings, iterators) => raise Fail "unimplemented" (* FIXME *)                  val (iterators, env') = checkIters (env, cxt, iterators)
440                    val create = checkCreate (env', cxt, create)
441                    in
442                      (AST.D_InitialArray(create, iterators), env)
443                    end
444                | PT.D_InitialCollection(create, iterators) => let
445                    val (iterators, env') = checkIters (env, cxt, iterators)
446                    val create = checkCreate (env', cxt, create)
447                    in
448                      (AST.D_InitialCollection(create, iterators), env)
449                    end
450            (* end case *))            (* end case *))
451    
452      fun check errStrm (PT.Program{span, tree}) = let      fun check errStrm (PT.Program{span, tree}) = let

Legend:
Removed from v.88  
changed lines
  Added in v.89

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