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

SCM Repository

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

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

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

revision 235, Thu Aug 5 21:57:46 2010 UTC revision 475, Thu Nov 4 18:57:11 2010 UTC
# Line 1  Line 1 
1  (* typechecker.sml  (* typechecker.sml
2   *   *
3   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4   * All rights reserved.   * All rights reserved.
5   *   *
6   *)   *)
# Line 150  Line 150 
150                  in                  in
151                    case (ty1, ty2)                    case (ty1, ty2)
152                     of (Ty.T_Bool, Ty.T_Bool) =>                     of (Ty.T_Bool, Ty.T_Bool) =>
153                          (AST.E_Cond(e1', AST.E_Lit(Literal.Bool true), e2'), Ty.T_Bool)                          (AST.E_Cond(e1', AST.E_Lit(Literal.Bool true), e2', Ty.T_Bool), Ty.T_Bool)
154                      | _ => err (cxt, [S "arguments to \"||\" must have bool type"])                      | _ => err (cxt, [S "arguments to \"||\" must have bool type"])
155                    (* end case *)                    (* end case *)
156                  end                  end
# Line 160  Line 160 
160                  in                  in
161                    case (ty1, ty2)                    case (ty1, ty2)
162                     of (Ty.T_Bool, Ty.T_Bool) =>                     of (Ty.T_Bool, Ty.T_Bool) =>
163                          (AST.E_Cond(e1', e2', AST.E_Lit(Literal.Bool false)), Ty.T_Bool)                          (AST.E_Cond(e1', e2', AST.E_Lit(Literal.Bool false), Ty.T_Bool), Ty.T_Bool)
164                      | _ => err (cxt, [S "arguments to \"&&\" must have bool type"])                      | _ => err (cxt, [S "arguments to \"&&\" must have bool type"])
165                    (* end case *)                    (* end case *)
166                  end                  end
167                | PT.E_Cond(e1, cond, e2) => let
168                    val (e1', ty1) = checkExpr(env, cxt, e1)
169                    val (e2', ty2) = checkExpr(env, cxt, e2)
170                    in
171                      case checkExpr(env, cxt, cond)
172                       of (cond', Ty.T_Bool) =>
173                            if U.matchType(ty1, ty2)
174                              then (AST.E_Cond(cond', e1', e2', ty1), ty1)
175                              else err (cxt, [
176                                  S "type do not match in conditional expression\n",
177                                  S "  true branch:  ", TY ty1,
178                                  S "  false branch: ", TY ty2
179                                ])
180                        | (_, ty') => err (cxt, [S "expected bool type, but found ", TY ty'])
181                      (* end case *)
182                    end
183              | PT.E_BinOp(e1, rator, e2) => let              | PT.E_BinOp(e1, rator, e2) => let
184                  val (e1', ty1) = checkExpr(env, cxt, e1)                  val (e1', ty1) = checkExpr(env, cxt, e1)
185                  val (e2', ty2) = checkExpr(env, cxt, e2)                  val (e2', ty2) = checkExpr(env, cxt, e2)
# Line 188  Line 204 
204                  in                  in
205                    case Basis.findOp rator                    case Basis.findOp rator
206                     of [rator] => let                     of [rator] => let
207                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = Util.instantiate(Var.typeOf rator)                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = U.instantiate(Var.typeOf rator)
208                          in                          in
209                            if U.matchType(domTy, ty)                            if U.matchType(domTy, ty)
210                              then (AST.E_Apply(rator, tyArgs, [e'], rngTy), rngTy)                              then (AST.E_Apply(rator, tyArgs, [e'], rngTy), rngTy)
# Line 201  Line 217 
217                      | ovldList => resolveOverload (cxt, rator, [ty], [e'], ovldList)                      | ovldList => resolveOverload (cxt, rator, [ty], [e'], ovldList)
218                    (* end case *)                    (* end case *)
219                  end                  end
220                | PT.E_Slice(e, indices) => let
221                    val (e', ty) = checkExpr (env, cxt, e)
222                    fun checkIndex NONE = NONE
223                      | checkIndex (SOME e) = let
224                          val (e', ty) = checkExpr (env, cxt, e)
225                          in
226                            if U.matchType(ty, Ty.T_Int)
227                              then (SOME e')
228                              else err (cxt, [
229                                  S "type error in index expression\n",
230                                  S "  expected int, but found: ", TY ty, S "\n"
231                                ])
232                          end
233                    val indices' = List.map checkIndex indices
234                    val order = List.length indices'
235                    val expectedTy = TU.mkTensorTy order
236                    val resultTy = TU.slice(expectedTy, List.map Option.isSome indices')
237                    in
238                      if U.matchType(ty, expectedTy)
239                        then ()
240                        else err (cxt, [
241                            S "type error in slice operation\n",
242                            S "  expected:  ", S(Int.toString order), S "-order tensor\n",
243                            S "  but found: ", TY ty, S "\n"
244                          ]);
245                      (AST.E_Slice(e', indices', resultTy), resultTy)
246                    end
247              | PT.E_Tuple args => let              | PT.E_Tuple args => let
248                  val (args, tys) = checkExprList (env, cxt, args)                  val (args, tys) = checkExprList (env, cxt, args)
249                  in                  in
# Line 231  Line 274 
274                  val (args, ty::tys) = checkExprList (env, cxt, args)                  val (args, ty::tys) = checkExprList (env, cxt, args)
275                  in                  in
276                    case TU.pruneHead ty                    case TU.pruneHead ty
277                     of Ty.T_Tensor shape => let                     of ty as Ty.T_Tensor shape => let
278                            val Ty.Shape dd = TU.pruneShape shape (* NOTE: this may fail if we allow user polymorphism *)
279                          fun chkTy ty' = U.matchType(ty, ty')                          fun chkTy ty' = U.matchType(ty, ty')
280                          val resTy = Ty.T_Tensor(Ty.shapeExt(shape, Ty.DimConst(List.length args)))                          val resTy = Ty.T_Tensor(Ty.Shape(Ty.DimConst(List.length args) :: dd))
281                          in                          in
282                            if List.all chkTy tys                            if List.all chkTy tys
283                              then (AST.E_Cons args, resTy)                              then (AST.E_Cons args, resTy)

Legend:
Removed from v.235  
changed lines
  Added in v.475

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