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

SCM Repository

[diderot] Diff of /branches/vis15/src/compiler/typechecker/check-expr.sml
ViewVC logotype

Diff of /branches/vis15/src/compiler/typechecker/check-expr.sml

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

revision 3398, Wed Nov 11 01:17:58 2015 UTC revision 3402, Wed Nov 11 02:54:23 2015 UTC
# Line 26  Line 26 
26      fun err arg = (TypeError.error arg; bogusExp)      fun err arg = (TypeError.error arg; bogusExp)
27      val warn = TypeError.warning      val warn = TypeError.warning
28    
29      datatype tokens = datatype TypeError.tokens      datatype token = datatype TypeError.token
30    
31    (* check the type of a literal *)    (* check the type of a literal *)
32      fun checkLit lit = (case lit      fun checkLit lit = (case lit
# Line 43  Line 43 
43                  val eTy1 = check (env, cxt, e1)                  val eTy1 = check (env, cxt, e1)
44                  val eTy2 = check (env, cxt, e2)                  val eTy2 = check (env, cxt, e2)
45                  in                  in
46                    case checkExpr(env, cxt, cond)                    case check(env, cxt, cond)
47                     of (cond', Ty.T_Bool) => (case Util.coerceType2(eTy1, eTy2)                     of (cond', Ty.T_Bool) => (case Util.coerceType2(eTy1, eTy2)
48                           of SOME(e1, e2, ty) => (AST.E_Cond(cond', e1', e2', ty), ty)                           of SOME(e1, e2, ty) => (AST.E_Cond(cond', e1', e2', ty), ty)
49                            | NONE => err (cxt, [                            | NONE => err (cxt, [
# Line 97  Line 97 
97                              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)
98                              val resTy = Ty.T_Tensor(Ty.Shape(dd1@dd2))                              val resTy = Ty.T_Tensor(Ty.Shape(dd1@dd2))
99                              in                              in
100                                if U.equalDim(d1, d2)                                if Unify.equalDim(d1, d2)
101                                andalso U.equalTypes(domTy, [ty1, ty2])                                andalso Unify.equalTypes(domTy, [ty1, ty2])
102                                andalso U.equalType(rngTy, resTy)                                andalso Unify.equalType(rngTy, resTy)
103                                  then (AST.E_Apply(BV.op_inner, tyArgs, [e1', e2'], rngTy), rngTy)                                  then (AST.E_Apply(BV.op_inner, tyArgs, [e1', e2'], rngTy), rngTy)
104                                  else err (cxt, [                                  else err (cxt, [
105                                      S "type error for arguments of binary operator '•'\n",                                      S "type error for arguments of binary operator '•'\n",
# Line 124  Line 124 
124                              val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf BV.op_colon)                              val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf BV.op_colon)
125                              val resTy = Ty.T_Tensor(Ty.Shape(dd1@dd2))                              val resTy = Ty.T_Tensor(Ty.Shape(dd1@dd2))
126                              in                              in
127                                if U.equalDim(d11, d21) andalso U.equalDim(d12, d22)                                if Unify.equalDim(d11, d21) andalso Unify.equalDim(d12, d22)
128                                andalso U.equalTypes(domTy, [ty1, ty2])                                andalso Unify.equalTypes(domTy, [ty1, ty2])
129                                andalso U.equalType(rngTy, resTy)                                andalso Unify.equalType(rngTy, resTy)
130                                  then (AST.E_Apply(BV.op_colon, tyArgs, [e1', e2'], rngTy), rngTy)                                  then (AST.E_Apply(BV.op_colon, tyArgs, [e1', e2'], rngTy), rngTy)
131                                  else err (cxt, [                                  else err (cxt, [
132                                      S "type error for arguments of binary operator ':'\n",                                      S "type error for arguments of binary operator ':'\n",
# Line 142  Line 142 
142                         of Env.PrimFun[rator] => let                         of Env.PrimFun[rator] => let
143                              val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf rator)                              val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf rator)
144                              in                              in
145                                case U.matchArgs(domTy, [e1', e2'], [ty1, ty2])                                case Unify.matchArgs(domTy, [e1', e2'], [ty1, ty2])
146                                 of SOME args => (AST.E_Apply(rator, tyArgs, args, rngTy), rngTy)                                 of SOME args => (AST.E_Apply(rator, tyArgs, args, rngTy), rngTy)
147                                  | NONE => err (cxt, [                                  | NONE => err (cxt, [
148                                        S "type error for binary operator '", V rator, S "'\n",                                        S "type error for binary operator '", V rator, S "'\n",
# Line 157  Line 157 
157                        (* end case *))                        (* end case *))
158                  end                  end
159              | PT.E_UnaryOp(rator, e) => let              | PT.E_UnaryOp(rator, e) => let
160                  val (e', ty) = checkExpr(env, cxt, e)                  val (e', ty) = check(env, cxt, e)
161                  in                  in
162                    case Env.findFunc (#env env, rator)                    case Env.findFunc (#env env, rator)
163                     of Env.PrimFun[rator] => let                     of Env.PrimFun[rator] => let
# Line 239  Line 239 
239                  val (tyArgs, Ty.T_Fun(_, rngTy)) =                  val (tyArgs, Ty.T_Fun(_, rngTy)) =
240                        Util.instantiate(Var.typeOf(BV.identity))                        Util.instantiate(Var.typeOf(BV.identity))
241                  in                  in
242                    if U.equalType(Ty.T_Tensor(checkShape(cxt, [d,d])), rngTy)                    if Unify.equalType(Ty.T_Tensor(checkShape(cxt, [d,d])), rngTy)
243                      then (AST.E_Apply(BV.identity, tyArgs, [], rngTy), rngTy)                      then (AST.E_Apply(BV.identity, tyArgs, [], rngTy), rngTy)
244                      else raise Fail "impossible"                      else raise Fail "impossible"
245                  end                  end
# Line 247  Line 247 
247                  val (tyArgs, Ty.T_Fun(_, rngTy)) =                  val (tyArgs, Ty.T_Fun(_, rngTy)) =
248                        Util.instantiate(Var.typeOf(BV.zero))                        Util.instantiate(Var.typeOf(BV.zero))
249                  in                  in
250                    if U.equalType(Ty.T_Tensor(checkShape(cxt, dd)), rngTy)                    if Unify.equalType(Ty.T_Tensor(checkShape(cxt, dd)), rngTy)
251                      then (AST.E_Apply(BV.zero, tyArgs, [], rngTy), rngTy)                      then (AST.E_Apply(BV.zero, tyArgs, [], rngTy), rngTy)
252                      else raise Fail "impossible"                      else raise Fail "impossible"
253                  end                  end
# Line 255  Line 255 
255                  val (tyArgs, Ty.T_Fun(_, rngTy)) =                  val (tyArgs, Ty.T_Fun(_, rngTy)) =
256                        Util.instantiate(Var.typeOf(BV.nan))                        Util.instantiate(Var.typeOf(BV.nan))
257                  in                  in
258                    if U.equalType(Ty.T_Tensor(checkShape(cxt, dd)), rngTy)                    if Unify.equalType(Ty.T_Tensor(checkShape(cxt, dd)), rngTy)
259                      then (AST.E_Apply(BV.nan, tyArgs, [], rngTy), rngTy)                      then (AST.E_Apply(BV.nan, tyArgs, [], rngTy), rngTy)
260                      else raise Fail "impossible"                      else raise Fail "impossible"
261                  end                  end
# Line 291  Line 291 
291                  end                  end
292              | PT.E_Deprecate(msg, e) => (              | PT.E_Deprecate(msg, e) => (
293                  warn (cxt, [S msg]);                  warn (cxt, [S msg]);
294                  chk (env, cxt, e))                  check (env, cxt, e))
295            (* end case *))            (* end case *))
296    
297    (* check a conditional operator (e.g., || or &&) *)    (* check a conditional operator (e.g., || or &&) *)
# Line 313  Line 313 
313     *)     *)
314      and checkList (env, cxt, exprs) = let      and checkList (env, cxt, exprs) = let
315            fun chk (e, (es, tys)) = let            fun chk (e, (es, tys)) = let
316                  val (e, ty) = checkExpr (env, cxt, e)                  val (e, ty) = check (env, cxt, e)
317                  in                  in
318                    (e::es, ty::tys)                    (e::es, ty::tys)
319                  end                  end

Legend:
Removed from v.3398  
changed lines
  Added in v.3402

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