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 1970, Sun Jul 15 14:20:23 2012 UTC revision 1971, Sun Jul 15 16:24:43 2012 UTC
# Line 164  Line 164 
164              | (Literal.Bool _) => (AST.E_Lit lit, Ty.T_Bool)              | (Literal.Bool _) => (AST.E_Lit lit, Ty.T_Bool)
165            (* end case *))            (* end case *))
166    
167        fun coerceType (ty1, ty2, e) = (case U.matchType(ty1, ty2)
168               of U.EQ => SOME e
169                | U.COERCE => SOME(AST.E_Coerce{srcTy=ty2, dstTy=ty1, e=e})
170                | U.FAIL => NONE
171              (* end case *))
172    
173        fun realType (ty as Ty.T_Tensor(Ty.Shape[])) = ty
174          | realType (ty as Ty.T_Int) = Ty.realTy
175          | realType ty = ty
176    
177    (* resolve overloading: we use a simple scheme that selects the first operator in the    (* resolve overloading: we use a simple scheme that selects the first operator in the
178     * list that matches the argument types.     * list that matches the argument types.
179     *)     *)
# Line 171  Line 181 
181              "resolveOverload: \"", Atom.toString rator, "\" has no candidates"              "resolveOverload: \"", Atom.toString rator, "\" has no candidates"
182            ])            ])
183        | resolveOverload (cxt, rator, argTys, args, candidates) = let        | resolveOverload (cxt, rator, argTys, args, candidates) = let
184            fun tryCandidates [] = err(cxt, [  (* FIXME: we could be more efficient by just checking for coercion matchs the first pass
185     * and remembering those that are not pure EQ matches.
186     *)
187            (* try to match candidates while allowing type coercions *)
188              fun tryMatchCandidates [] = err(cxt, [
189                    S "unable to resolve overloaded operator \"", A rator, S "\"\n",                    S "unable to resolve overloaded operator \"", A rator, S "\"\n",
190                    S "  argument type is: ", TYS argTys, S "\n"                    S "  argument type is: ", TYS argTys, S "\n"
191                  ])                  ])
192                | tryMatchCandidates (x::xs) = let
193                    val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf x)
194                    fun matchArgTys ([], [], [], args') =
195                          (AST.E_Apply(x, tyArgs, List.rev args', rngTy), rngTy)
196                      | matchArgTys (ty1::tys1, ty2::tys2, arg::args, args') = (
197                          case coerceType (ty1, ty2, arg)
198                           of SOME arg' => matchArgTys (tys1, tys2, args, arg'::args')
199                            | NONE => tryMatchCandidates xs
200                          (* end case *))
201                    in
202                      matchArgTys (domTy, argTys, args, [])
203                    end
204              fun tryCandidates [] = tryMatchCandidates candidates
205              | tryCandidates (x::xs) = let              | tryCandidates (x::xs) = let
206                  val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf x)                  val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf x)
207                  in                  in
208                    if U.tryMatchTypes(domTy, argTys)                    if U.tryEqualTypes(domTy, argTys)
209                      then (AST.E_Apply(x, tyArgs, args, rngTy), rngTy)                      then (AST.E_Apply(x, tyArgs, args, rngTy), rngTy)
210                      else tryCandidates xs                      else tryCandidates xs
211                  end                  end
# Line 186  Line 213 
213              tryCandidates candidates              tryCandidates candidates
214            end            end
215    
     fun coerceType (ty1, ty2, e) = (case U.matchType(ty1, ty2)  
            of U.EQ => SOME(e, ty2)  
             | U.COERCE => SOME(AST.E_Coerce{srcTy=ty2, dstTy=ty1, e=e}, ty1)  
             | U.FAIL => NONE  
           (* end case *))  
   
216    (* typecheck an expression and translate it to AST *)    (* typecheck an expression and translate it to AST *)
217      fun checkExpr (env : env, cxt, e) = (case e      fun checkExpr (env : env, cxt, e) = (case e
218             of PT.E_Mark m => checkExpr (withEnvAndContext (env, cxt, m))             of PT.E_Mark m => checkExpr (withEnvAndContext (env, cxt, m))
# Line 443  Line 464 
464                      else err(cxt, [S "sequence expression of non-value argument type"])                      else err(cxt, [S "sequence expression of non-value argument type"])
465                  end                  end
466              | PT.E_Cons args => let              | PT.E_Cons args => let
467                  val (args, ty::tys) = checkExprList (env, cxt, args)                  val (args, tys as ty::_) = checkExprList (env, cxt, args)
468                  in                  in
469                    case TU.pruneHead ty                    case realType(TU.pruneHead ty)
470                     of ty as Ty.T_Tensor shape => let                     of ty as Ty.T_Tensor shape => let
471                          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 *)
                         fun chkTy ty' = U.equalType(ty, ty')  
472                          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))
473                            fun chkArgs (arg::args, argTy::tys, args') = (case coerceType(ty, argTy, arg)
474                                   of SOME arg' => chkArgs (args, tys, arg'::args')
475                                    | NONE => err(cxt, [S "arguments of tensor construction must have same type"])
476                                  (* end case *))
477                              | chkArgs ([], [], args') = (AST.E_Cons(List.rev args'), resTy)
478                          in                          in
479                            if List.all chkTy tys                            chkArgs (args, tys, [])
                             then (AST.E_Cons args, resTy)  
                             else err(cxt, [S "arguments of tensor construction must have same type"])  
480                          end                          end
481                      | _ => err(cxt, [S "Invalid argument type for tensor construction"])                      | _ => err(cxt, [S "Invalid argument type for tensor construction"])
482                    (* end case *)                    (* end case *)
# Line 502  Line 525 
525                  val (e', ty') = checkExpr (env, cxt, e)                  val (e', ty') = checkExpr (env, cxt, e)
526                  in                  in
527                    case coerceType (ty, ty', e')                    case coerceType (ty, ty', e')
528                     of SOME(e', _) => (x, x', e')                     of SOME e' => (x, x', e')
529                      | NONE => err(cxt, [                      | NONE => err(cxt, [
530                          S "type of variable ", A x,                          S "type of variable ", A x,
531                          S " does not match type of initializer\n",                          S " does not match type of initializer\n",
# Line 755  Line 778 
778                          | SOME e => let                          | SOME e => let
779                              val (e', ty') = checkExpr (env, cxt, e)                              val (e', ty') = checkExpr (env, cxt, e)
780                              in                              in
781                                if U.equalType (ty, ty')                                case coerceType (ty, ty', e')
782                                  then AST.D_Input(x', desc, SOME e')                                 of SOME e' => AST.D_Input(x', desc, SOME e')
783                                  else err(cxt, [                                  | NONE => err(cxt, [
784                                      S "definition of ", V x', S " has wrong type\n",                                      S "definition of ", V x', S " has wrong type\n",
785                                      S "  expected:  ", TY ty, S "\n",                                      S "  expected:  ", TY ty, S "\n",
786                                      S "  but found: ", TY ty'                                      S "  but found: ", TY ty'
787                                    ])                                    ])
788                                  (* end case *)
789                              end                              end
790                        (* end case *))                        (* end case *))
791                  in                  in

Legend:
Removed from v.1970  
changed lines
  Added in v.1971

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