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

SCM Repository

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

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

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

revision 83, Wed May 26 18:50:44 2010 UTC revision 85, Wed May 26 19:51:10 2010 UTC
# Line 67  Line 67 
67              | (Literal.Bool _) => (AST.E_Lit lit, Ty.T_Bool)              | (Literal.Bool _) => (AST.E_Lit lit, Ty.T_Bool)
68            (* end case *))            (* end case *))
69    
70      (* resolve overloading: we use a simple scheme that selects the first operator in the
71       * list that matches the argument types.
72       *)
73        fun resolveOverload (rator, argTys, args, candidates) = let
74              fun tryCandidates [] = raise Fail(concat[
75                      "unable to resolve overloaded operator \"", Atom.toString rator, "\""
76                    ])
77                | tryCandidates (x::xs) = let
78                    val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf x)
79                    in
80                      if U.tryMatchTypes(domTy, argTys)
81                        then (AST.E_Apply(x, tyArgs, args, rngTy), rngTy)
82                        else tryCandidates xs
83                    end
84              in
85                tryCandidates candidates
86              end
87    
88    (* typecheck an expression and translate it to AST *)    (* typecheck an expression and translate it to AST *)
89      fun checkExpr (env, cxt, e) = (case e      fun checkExpr (env, cxt, e) = (case e
90             of PT.E_Mark m => checkExpr (env, #span m, #tree m)             of PT.E_Mark m => checkExpr (env, #span m, #tree m)
# Line 109  Line 127 
127                          in                          in
128                            if U.matchTypes(domTy, [ty1, ty2])                            if U.matchTypes(domTy, [ty1, ty2])
129                              then (AST.E_Apply(rator, tyArgs, [e1', e2'], rngTy), rngTy)                              then (AST.E_Apply(rator, tyArgs, [e1', e2'], rngTy), rngTy)
130                              else raise Fail "type error for binary operator"                              else raise Fail(concat[
131                                    "type error for binary operator \"", Var.nameOf rator, "\""
132                                  ])
133                          end                          end
134                      | ovldList => raise Fail "overloaded binops unimplemented" (* FIXME *)                      | ovldList => resolveOverload (rator, [ty1, ty2], [e1', e2'], ovldList)
135                    (* end case *)                    (* end case *)
136                  end                  end
137              | PT.E_UnaryOp(rator, e) => let              | PT.E_UnaryOp(rator, e) => let
# Line 123  Line 143 
143                          in                          in
144                            if U.matchType(domTy, ty)                            if U.matchType(domTy, ty)
145                              then (AST.E_Apply(rator, tyArgs, [e'], rngTy), rngTy)                              then (AST.E_Apply(rator, tyArgs, [e'], rngTy), rngTy)
146                              else raise Fail "type error for binary operator"                              else raise Fail(concat[
147                                    "type error for unary operator \"", Var.nameOf rator, "\""
148                                  ])
149                          end                          end
150                      | ovldList => raise Fail "unimplemented" (* FIXME *)                      | ovldList => resolveOverload (rator, [ty], [e'], ovldList)
151                    (* end case *)                    (* end case *)
152                  end                  end
153              | PT.E_Tuple args => let              | PT.E_Tuple args => let

Legend:
Removed from v.83  
changed lines
  Added in v.85

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