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

Parent Directory | Revision Log | Patch

	revision 87, Wed May 26 23:07:39 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"

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

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

---

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