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 1686, Mon Jan 23 18:49:17 2012 UTC revision 1687, Wed Jan 25 13:02:32 2012 UTC
# Line 142  Line 142 
142              | PT.T_Seq(ty, dim) => let              | PT.T_Seq(ty, dim) => let
143                  val ty = checkTy(cxt, ty)                  val ty = checkTy(cxt, ty)
144                  in                  in
145                    if TU.isValueType ty                    if TU.isFixedSizeType ty
146                      then Ty.T_Sequence(ty, checkDim (cxt, dim))                      then Ty.T_Sequence(ty, checkDim (cxt, dim))
147                      else err(cxt, [S "elements of sequence types must be value types"])                      else err(cxt, [S "elements of sequence types must be fixed-size types"])
148                    end
149                | PT.T_DynSeq ty => let
150                    val ty = checkTy(cxt, ty)
151                    in
152                      if TU.isFixedSizeType ty
153                        then Ty.T_DynSequence(ty)
154                        else err(cxt, [S "elements of sequence types must be fixed-size types"])
155                  end                  end
156            (* end case *))            (* end case *))
157    
# Line 177  Line 184 
184              tryCandidates candidates              tryCandidates candidates
185            end            end
186    
187        fun coerceType (ty1, ty2, e) = (case U.matchType(ty1, ty2)
188               of U.EQ => SOME(e, ty2)
189                | U.COERCE => SOME(AST.E_Coerce{srcTy=ty2, dstTy=ty1, e=e}, ty1)
190                | U.FAIL => NONE
191              (* end case *))
192    
193    (* typecheck an expression and translate it to AST *)    (* typecheck an expression and translate it to AST *)
194      fun checkExpr (env : env, cxt, e) = (case e      fun checkExpr (env : env, cxt, e) = (case e
195             of PT.E_Mark m => checkExpr (withEnvAndContext (env, cxt, m))             of PT.E_Mark m => checkExpr (withEnvAndContext (env, cxt, m))
# Line 211  Line 224 
224                  in                  in
225                    case checkExpr(env, cxt, cond)                    case checkExpr(env, cxt, cond)
226                     of (cond', Ty.T_Bool) =>                     of (cond', Ty.T_Bool) =>
227                          if U.matchType(ty1, ty2)                          if U.equalType(ty1, ty2)
228                            then (AST.E_Cond(cond', e1', e2', ty1), ty1)                            then (AST.E_Cond(cond', e1', e2', ty1), ty1)
229                            else err (cxt, [                            else err (cxt, [
230                                S "type do not match in conditional expression\n",                                S "type do not match in conditional expression\n",
# Line 242  Line 255 
255                              val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf BV.op_inner)                              val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf BV.op_inner)
256                              val resTy = Ty.T_Tensor(Ty.Shape(dd1@dd2))                              val resTy = Ty.T_Tensor(Ty.Shape(dd1@dd2))
257                              in                              in
258                                if U.matchDim(d1, d2)                                if U.equalDim(d1, d2)
259                                andalso U.matchTypes(domTy, [ty1, ty2])                                andalso U.equalTypes(domTy, [ty1, ty2])
260                                andalso U.matchType(rngTy, resTy)                                andalso U.equalType(rngTy, resTy)
261                                  then (AST.E_Apply(BV.op_inner, tyArgs, [e1', e2'], rngTy), rngTy)                                  then (AST.E_Apply(BV.op_inner, tyArgs, [e1', e2'], rngTy), rngTy)
262                                  else err (cxt, [                                  else err (cxt, [
263                                      S "type error for arguments of binary operator \"•\"\n",                                      S "type error for arguments of binary operator \"•\"\n",
# Line 260  Line 273 
273                         of [rator] => let                         of [rator] => let
274                              val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf rator)                              val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf rator)
275                              in                              in
276                                if U.matchTypes(domTy, [ty1, ty2])                                if U.equalTypes(domTy, [ty1, ty2])
277                                  then (AST.E_Apply(rator, tyArgs, [e1', e2'], rngTy), rngTy)                                  then (AST.E_Apply(rator, tyArgs, [e1', e2'], rngTy), rngTy)
278                                  else err (cxt, [                                  else err (cxt, [
279                                      S "type error for binary operator \"", V rator, S "\"\n",                                      S "type error for binary operator \"", V rator, S "\"\n",
# Line 278  Line 291 
291                     of [rator] => let                     of [rator] => let
292                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = U.instantiate(Var.typeOf rator)                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = U.instantiate(Var.typeOf rator)
293                          in                          in
294                            if U.matchType(domTy, ty)                            if U.equalType(domTy, ty)
295                              then (AST.E_Apply(rator, tyArgs, [e'], rngTy), rngTy)                              then (AST.E_Apply(rator, tyArgs, [e'], rngTy), rngTy)
296                              else err (cxt, [                              else err (cxt, [
297                                  S "type error for unary operator \"", V rator, S "\"\n",                                  S "type error for unary operator \"", V rator, S "\"\n",
# Line 295  Line 308 
308                    | checkIndex (SOME e) = let                    | checkIndex (SOME e) = let
309                        val (e', ty) = checkExpr (env, cxt, e)                        val (e', ty) = checkExpr (env, cxt, e)
310                        in                        in
311                          if U.matchType(ty, Ty.T_Int)                          if U.equalType(ty, Ty.T_Int)
312                            then (SOME e')                            then (SOME e')
313                            else err (cxt, [                            else err (cxt, [
314                                S "type error in index expression\n",                                S "type error in index expression\n",
# Line 307  Line 320 
320                  val expectedTy = TU.mkTensorTy order                  val expectedTy = TU.mkTensorTy order
321                  val resultTy = TU.slice(expectedTy, List.map Option.isSome indices')                  val resultTy = TU.slice(expectedTy, List.map Option.isSome indices')
322                  in                  in
323                    if U.matchType(ty, expectedTy)                    if U.equalType(ty, expectedTy)
324                      then ()                      then ()
325                      else err (cxt, [                      else err (cxt, [
326                          S "type error in slice operation\n",                          S "type error in slice operation\n",
# Line 321  Line 334 
334                  val (e2', ty2) = checkExpr (env, cxt, e2)                  val (e2', ty2) = checkExpr (env, cxt, e2)
335                  val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf BV.subscript)                  val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf BV.subscript)
336                  in                  in
337                    if U.matchTypes(domTy, [ty1, ty2])                    if U.equalTypes(domTy, [ty1, ty2])
338                      then let                      then let
339                        val exp = AST.E_Apply(BasisVars.subscript, tyArgs, [e1', e2'], rngTy)                        val exp = AST.E_Apply(BasisVars.subscript, tyArgs, [e1', e2'], rngTy)
340                        in                        in
# Line 340  Line 353 
353                  fun checkFieldApp (e1', ty1) = (case (args, tys)                  fun checkFieldApp (e1', ty1) = (case (args, tys)
354                         of ([e2'], [ty2]) => let                         of ([e2'], [ty2]) => let
355                              val (tyArgs, Ty.T_Fun(domTy, rngTy)) =                              val (tyArgs, Ty.T_Fun(domTy, rngTy)) =
356                                    Util.instantiate(Var.typeOf BV.op_at)                                    Util.instantiate(Var.typeOf BV.op_probe)
357                              in                              in
358                                if U.matchTypes(domTy, [ty1, ty2])                                if U.equalTypes(domTy, [ty1, ty2])
359                                  then (AST.E_Apply(BV.op_at, tyArgs, [e1', e2'], rngTy), rngTy)                                  then (AST.E_Apply(BV.op_probe, tyArgs, [e1', e2'], rngTy), rngTy)
360                                  else err (cxt, [                                  else err (cxt, [
361                                      S "type error for field application\n",                                      S "type error for field application\n",
362                                      S "  expected:  ", TYS domTy, S "\n",                                      S "  expected:  ", TYS domTy, S "\n",
# Line 366  Line 379 
379                                          ])                                          ])
380                                        else (case Util.instantiate(Var.typeOf f)                                        else (case Util.instantiate(Var.typeOf f)
381                                           of (tyArgs, Ty.T_Fun(domTy, rngTy)) =>                                           of (tyArgs, Ty.T_Fun(domTy, rngTy)) =>
382                                                if U.matchTypes(domTy, tys)                                                if U.equalTypes(domTy, tys)
383                                                  then (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)                                                  then (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)
384                                                  else err(cxt, [                                                  else err(cxt, [
385                                                      S "type error in application of ", V f, S "\n",                                                      S "type error in application of ", V f, S "\n",
# Line 389  Line 402 
402              | PT.E_Sequence args => let              | PT.E_Sequence args => let
403                  val (args, ty::tys) = checkExprList (env, cxt, args)                  val (args, ty::tys) = checkExprList (env, cxt, args)
404                  in                  in
405                    if TU.isValueType(TU.pruneHead ty)                    if TU.isFixedSizeType(TU.pruneHead ty)
406                      then let                      then let
407                        fun chkTy ty' = U.matchType(ty, ty')                        fun chkTy ty' = U.equalType(ty, ty')
408                        val resTy = Ty.T_Sequence(ty, Ty.DimConst(List.length args))                        val resTy = Ty.T_Sequence(ty, Ty.DimConst(List.length args))
409                        in                        in
410                          if List.all chkTy tys                          if List.all chkTy tys
# Line 406  Line 419 
419                    case TU.pruneHead ty                    case TU.pruneHead ty
420                     of ty as Ty.T_Tensor shape => let                     of ty as Ty.T_Tensor shape => let
421                          val Ty.Shape dd = TU.pruneShape shape (* NOTE: this may fail if we allow user polymorphism *)                          val Ty.Shape dd = TU.pruneShape shape (* NOTE: this may fail if we allow user polymorphism *)
422                          fun chkTy ty' = U.matchType(ty, ty')                          fun chkTy ty' = U.equalType(ty, ty')
423                          val resTy = Ty.T_Tensor(Ty.Shape(Ty.DimConst(List.length args) :: dd))                          val resTy = Ty.T_Tensor(Ty.Shape(Ty.DimConst(List.length args) :: dd))
424                          in                          in
425                            if List.all chkTy tys                            if List.all chkTy tys
# Line 425  Line 438 
438                  val (tyArgs, Ty.T_Fun(_, rngTy)) =                  val (tyArgs, Ty.T_Fun(_, rngTy)) =
439                        Util.instantiate(Var.typeOf(BV.identity))                        Util.instantiate(Var.typeOf(BV.identity))
440                  in                  in
441                    if U.matchType(Ty.T_Tensor(checkShape(cxt, [d,d])), rngTy)                    if U.equalType(Ty.T_Tensor(checkShape(cxt, [d,d])), rngTy)
442                      then (AST.E_Apply(BV.identity, tyArgs, [], rngTy), rngTy)                      then (AST.E_Apply(BV.identity, tyArgs, [], rngTy), rngTy)
443                      else raise Fail "impossible"                      else raise Fail "impossible"
444                  end                  end
# Line 433  Line 446 
446                  val (tyArgs, Ty.T_Fun(_, rngTy)) =                  val (tyArgs, Ty.T_Fun(_, rngTy)) =
447                        Util.instantiate(Var.typeOf(BV.zero))                        Util.instantiate(Var.typeOf(BV.zero))
448                  in                  in
449                    if U.matchType(Ty.T_Tensor(checkShape(cxt, dd)), rngTy)                    if U.equalType(Ty.T_Tensor(checkShape(cxt, dd)), rngTy)
450                      then (AST.E_Apply(BV.zero, tyArgs, [], rngTy), rngTy)                      then (AST.E_Apply(BV.zero, tyArgs, [], rngTy), rngTy)
451                      else raise Fail "impossible"                      else raise Fail "impossible"
452                  end                  end
# Line 459  Line 472 
472                  val x' = Var.new (x, kind, ty)                  val x' = Var.new (x, kind, ty)
473                  val (e', ty') = checkExpr (env, cxt, e)                  val (e', ty') = checkExpr (env, cxt, e)
474                  in                  in
475  (* FIXME: this check is not flexible enough; should allow lhs type to support                    case coerceType (ty, ty', e')
476   * fewer levels of differentiation than rhs provides.                     of SOME(e', _) => (x, x', e')
477   *)                      | NONE => err(cxt, [
                   if U.matchType(ty, ty')  
                     then (x, x', e')  
                     else err(cxt, [  
478                          S "type of variable ", A x,                          S "type of variable ", A x,
479                          S " does not match type of initializer\n",                          S " does not match type of initializer\n",
480                          S "  expected: ", TY ty, S "\n",                          S "  expected: ", TY ty, S "\n",
481                          S "  but found: ", TY ty'                          S "  but found: ", TY ty'
482                        ])                        ])
483                      (* end case *)
484                  end                  end
485            (* end case *))            (* end case *))
486    
# Line 524  Line 535 
535                        val ([], ty) = Var.typeOf x'                        val ([], ty) = Var.typeOf x'
536                        val (e', ty') = checkExpr (env, cxt, e)                        val (e', ty') = checkExpr (env, cxt, e)
537                        in                        in
538                          if U.matchType(ty, ty')                          if U.equalType(ty, ty')
539                            then (x, x', e')                            then (x, x', e')
540                            else err(cxt, [                            else err(cxt, [
541                                S "type of assigned variable ", A x,                                S "type of assigned variable ", A x,
# Line 715  Line 726 
726                          | SOME e => let                          | SOME e => let
727                              val (e', ty') = checkExpr (env, cxt, e)                              val (e', ty') = checkExpr (env, cxt, e)
728                              in                              in
729                                if U.matchType (ty, ty')                                if U.equalType (ty, ty')
730                                  then AST.D_Input(x', desc, SOME e')                                  then AST.D_Input(x', desc, SOME e')
731                                  else err(cxt, [                                  else err(cxt, [
732                                      S "definition of ", V x', S " has wrong type\n",                                      S "definition of ", V x', S " has wrong type\n",

Legend:
Removed from v.1686  
changed lines
  Added in v.1687

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