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 86, Wed May 26 22:23:17 2010 UTC revision 88, Wed May 26 23:07:50 2010 UTC
# Line 6  Line 6 
6    
7  structure Typechecker : sig  structure Typechecker : sig
8    
9        exception Error
10    
11      val check : Error.err_stream -> ParseTree.program -> AST.program      val check : Error.err_stream -> ParseTree.program -> AST.program
12    
13    end = struct    end = struct
# Line 14  Line 16 
16      structure Ty = Types      structure Ty = Types
17      structure U = Util      structure U = Util
18    
19        exception Error
20    
21      type context = Error.err_stream * Error.span      type context = Error.err_stream * Error.span
22    
23      fun withContext ((errStrm, _), {span, tree}) =      fun withContext ((errStrm, _), {span, tree}) =
# Line 21  Line 25 
25      fun withEnvAndContext (env, (errStrm, _), {span, tree}) =      fun withEnvAndContext (env, (errStrm, _), {span, tree}) =
26            (env, (errStrm, span), tree)            (env, (errStrm, span), tree)
27    
28      fun error ((errStrm, span), msg) = Error.errorAt(errStrm, span, msg)      fun error ((errStrm, span), msg) = (
29              Error.errorAt(errStrm, span, msg);
30              raise Error)
31    
32        datatype token
33          = S of string | A of Atom.atom
34          | V of AST.var | TY of Types.ty | TYS of Types.ty list
35    
36        fun err (cxt, toks) = let
37              fun tok2str (S s) = s
38                | tok2str (A a) = Atom.toString a
39                | tok2str (V x) = Var.nameOf x
40                | tok2str (TY ty) = TypeUtil.toString ty
41                | tok2str (TYS []) = "()"
42                | tok2str (TYS[ty]) = TypeUtil.toString ty
43                | tok2str (TYS tys) = String.concat[
44                      "(", String.concatWith " * " (List.map TypeUtil.toString tys), ")"
45                    ]
46              in
47                error(cxt, List.map tok2str toks)
48              end
49    
50      val realZero = AST.E_Lit(Literal.Float(FloatLit.zero true))      val realZero = AST.E_Lit(Literal.Float(FloatLit.zero true))
51    
# Line 103  Line 127 
127                        in                        in
128                          (AST.E_Var(x', args, ty), ty)                          (AST.E_Var(x', args, ty), ty)
129                        end                        end
130                    | NONE => raise Fail "undefined variable"                    | NONE => err(cxt, [S "undeclared variable ", A x])
131                  (* end case *))                  (* end case *))
132              | PT.E_Lit lit => checkLit lit              | PT.E_Lit lit => checkLit lit
133              | PT.E_OrElse(e1, e2) => let              | PT.E_OrElse(e1, e2) => let
# Line 172  Line 196 
196                           of (tyArgs, Ty.T_Fun(domTy, rngTy)) =>                           of (tyArgs, Ty.T_Fun(domTy, rngTy)) =>
197                                if U.matchTypes(domTy, tys)                                if U.matchTypes(domTy, tys)
198                                  then (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)                                  then (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)
199                                  else raise Fail "type error for application"                                  else err(cxt, [
200                                        S "type error in application of ", V f, S "\n",
201                                        S "  expected:  ", TYS domTy, S "\n",
202                                        S "  but found: ", TYS tys, S "\n"
203                                      ])
204                            | _ => raise Fail "application of non-function"                            | _ => raise Fail "application of non-function"
205                          (* end case *))                          (* end case *))
206                      | NONE => raise Fail "unknown function"                      | NONE => raise Fail "unknown function"

Legend:
Removed from v.86  
changed lines
  Added in v.88

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