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

SCM Repository

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

Diff of /branches/vis12/src/compiler/typechecker/typechecker.sml

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

revision 1974, Sun Jul 15 22:59:41 2012 UTC revision 1975, Mon Jul 16 01:01:19 2012 UTC
# Line 319  Line 319 
319                         of [rator] => let                         of [rator] => let
320                              val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf rator)                              val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf rator)
321                              in                              in
322                                if U.equalTypes(domTy, [ty1, ty2])                                case U.matchArgs(domTy, [e1', e2'], [ty1, ty2])
323                                  then (AST.E_Apply(rator, tyArgs, [e1', e2'], rngTy), rngTy)                                 of SOME args => (AST.E_Apply(rator, tyArgs, args, rngTy), rngTy)
324                                  else err (cxt, [                                  | NONE => err (cxt, [
325                                      S "type error for binary operator \"", V rator, S "\"\n",                                      S "type error for binary operator \"", V rator, S "\"\n",
326                                      S "  expected:  ", TYS domTy, S "\n",                                      S "  expected:  ", TYS domTy, S "\n",
327                                      S "  but found: ", TYS[ty1, ty2]                                      S "  but found: ", TYS[ty1, ty2]
328                                    ])                                    ])
329                                  (* end case *)
330                              end                              end
331                          | ovldList => resolveOverload (cxt, rator, [ty1, ty2], [e1', e2'], ovldList)                          | ovldList => resolveOverload (cxt, rator, [ty1, ty2], [e1', e2'], ovldList)
332                        (* end case *))                        (* end case *))
# Line 337  Line 338 
338                     of [rator] => let                     of [rator] => let
339                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = U.instantiate(Var.typeOf rator)                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = U.instantiate(Var.typeOf rator)
340                          in                          in
341                            if U.equalType(domTy, ty)                            case coerceType (domTy, ty, e')
342                              then (AST.E_Apply(rator, tyArgs, [e'], rngTy), rngTy)                             of SOME e' => (AST.E_Apply(rator, tyArgs, [e'], rngTy), rngTy)
343                              else err (cxt, [                              | NONE => err (cxt, [
344                                  S "type error for unary operator \"", V rator, S "\"\n",                                  S "type error for unary operator \"", V rator, S "\"\n",
345                                  S "  expected:  ", TY domTy, S "\n",                                  S "  expected:  ", TY domTy, S "\n",
346                                  S "  but found: ", TY ty                                  S "  but found: ", TY ty
347                                ])                                ])
348                              (* end case *)
349                          end                          end
350                      | ovldList => resolveOverload (cxt, rator, [ty], [e'], ovldList)                      | ovldList => resolveOverload (cxt, rator, [ty], [e'], ovldList)
351                    (* end case *)                    (* end case *)
# Line 398  Line 400 
400                  val (args, tys) = checkExprList (env, cxt, args)                  val (args, tys) = checkExprList (env, cxt, args)
401                  fun checkFieldApp (e1', ty1) = (case (args, tys)                  fun checkFieldApp (e1', ty1) = (case (args, tys)
402                         of ([e2'], [ty2]) => let                         of ([e2'], [ty2]) => let
403                              val (tyArgs, Ty.T_Fun(domTy, rngTy)) =                              val (tyArgs, Ty.T_Fun([fldTy, domTy], rngTy)) =
404                                    Util.instantiate(Var.typeOf BV.op_probe)                                    Util.instantiate(Var.typeOf BV.op_probe)
405                              in                              fun tyError () = err (cxt, [
                               if U.equalTypes(domTy, [ty1, ty2])  
                                 then (AST.E_Apply(BV.op_probe, tyArgs, [e1', e2'], rngTy), rngTy)  
                                 else err (cxt, [  
406                                      S "type error for field application\n",                                      S "type error for field application\n",
407                                      S "  expected:  ", TYS domTy, S "\n",                                      S "  expected:  ", TYS[fldTy, domTy], S "\n",
408                                      S "  but found: ", TYS[ty1, ty2]                                      S "  but found: ", TYS[ty1, ty2]
409                                    ])                                    ])
410                                in
411                                  if U.equalType(fldTy, ty1)
412                                    then (case coerceType(domTy, ty2, e2')
413                                       of SOME e2' => (AST.E_Apply(BV.op_probe, tyArgs, [e1', e2'], rngTy), rngTy)
414                                        | NONE => tyError()
415                                      (* end case *))
416                                    else tyError()
417                              end                              end
418                          | _ => err(cxt, [S "badly formed field application"])                          | _ => err(cxt, [S "badly formed field application"])
419                        (* end case *))                        (* end case *))
# Line 424  Line 430 
430                                            S " in strand body"                                            S " in strand body"
431                                          ])                                          ])
432                                        else (case Util.instantiate(Var.typeOf f)                                        else (case Util.instantiate(Var.typeOf f)
433                                           of (tyArgs, Ty.T_Fun(domTy, rngTy)) =>                                           of (tyArgs, Ty.T_Fun(domTy, rngTy)) => (
434                                                if U.equalTypes(domTy, tys)                                                case U.matchArgs (domTy, args, tys)
435                                                  then (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)                                                 of SOME args => (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)
436                                                  else err(cxt, [                                                  | NONE => err(cxt, [
437                                                      S "type error in application of ", V f, S "\n",                                                      S "type error in application of ", V f, S "\n",
438                                                      S "  expected:  ", TYS domTy, S "\n",                                                      S "  expected:  ", TYS domTy, S "\n",
439                                                      S "  but found: ", TYS tys                                                      S "  but found: ", TYS tys
440                                                    ])                                                    ])
441                                                  (* end case *))
442                                            | _ => err(cxt, [S "application of non-function ", V f])                                            | _ => err(cxt, [S "application of non-function ", V f])
443                                          (* end case *))                                          (* end case *))
444                                  | ovldList => resolveOverload (cxt, f, tys, args, ovldList)                                  | ovldList => resolveOverload (cxt, f, tys, args, ovldList)
# Line 582  Line 589 
589  (* FIXME: check for polymorphic variables *)  (* FIXME: check for polymorphic variables *)
590                        val ([], ty) = Var.typeOf x'                        val ([], ty) = Var.typeOf x'
591                        val (e', ty') = checkExpr (env, cxt, e)                        val (e', ty') = checkExpr (env, cxt, e)
592                        in                      (* check for promotion *)
593                          if U.equalType(ty, ty')                        val e' = (case coerceType(ty, ty', e')
594                            then (x, x', e')                               of SOME e' => e'
595                            else err(cxt, [                                | NONE => err(cxt, [
596                                S "type of assigned variable ", A x,                                S "type of assigned variable ", A x,
597                                S " does not match type of rhs\n",                                S " does not match type of rhs\n",
598                                S "  expected: ", TY ty, S "\n",                                S "  expected: ", TY ty, S "\n",
599                                S "  but found: ", TY ty'                                S "  but found: ", TY ty'
600                              ]);                                    ])
601                                (* end case *))
602                          in
603                        (* check that x' is mutable *)                        (* check that x' is mutable *)
604                          case Var.kindOf x'                          case Var.kindOf x'
605                           of Var.StrandStateVar => ()                           of Var.StrandStateVar => ()

Legend:
Removed from v.1974  
changed lines
  Added in v.1975

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