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

Parent Directory | Revision Log | Patch

	revision 168, Wed Jul 21 20:58:37 2010 UTC	revision 169, Thu Jul 22 20:07:37 2010 UTC
#	Line 17	Line 17
17	structure TU = TypeUtil	structure TU = TypeUtil
18	structure U = Util	structure U = Util
19
20		type env = {globalScope : bool, env : Env.env}
21
22	exception Error	exception Error
23
24	type context = Error.err_stream * Error.span	type context = Error.err_stream * Error.span
#	Line 121	Line 123
123	end	end
124
125	(* typecheck an expression and translate it to AST *)	(* typecheck an expression and translate it to AST *)
126	fun checkExpr (env, cxt, e) = (case e	fun checkExpr (env : env, cxt, e) = (case e
127	of PT.E_Mark m => checkExpr (withEnvAndContext (env, cxt, m))	of PT.E_Mark m => checkExpr (withEnvAndContext (env, cxt, m))
128	| PT.E_Var x => (case Env.findVar (env, x)	| PT.E_Var x => (case Env.findVar (#env env, x)
129	of SOME x' => let	of SOME x' => let
130	val (args, ty) = Util.instantiate(Var.typeOf x')	val (args, ty) = Util.instantiate(Var.typeOf x')
131	in	in
#	Line 197	Line 199
199	| PT.E_Apply(f, args) => let	| PT.E_Apply(f, args) => let
200	val (args, tys) = checkExprList (env, cxt, args)	val (args, tys) = checkExprList (env, cxt, args)
201	in	in
202	case Env.findVar (env, f)	case Env.findFunc (#env env, f)
203	of SOME f => (case Util.instantiate(Var.typeOf f)	of SOME f =>
204		if (#globalScope env) orelse not(Basis.isRestricted f)
205		then (case Util.instantiate(Var.typeOf f)
206	of (tyArgs, Ty.T_Fun(domTy, rngTy)) =>	of (tyArgs, Ty.T_Fun(domTy, rngTy)) =>
207	if U.matchTypes(domTy, tys)	if U.matchTypes(domTy, tys)
208	then (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)	then (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)
#	Line 209	Line 213
213	])	])
214	| _ => err(cxt, [S "application of non-function ", V f])	| _ => err(cxt, [S "application of non-function ", V f])
215	(* end case *))	(* end case *))
216		else err(cxt, [S "use of restricted operation ", V f, S " in actor body"])
217	| NONE => err(cxt, [S "unknown function ", A f])	| NONE => err(cxt, [S "unknown function ", A f])
218	(* end case *)	(* end case *)
219	end	end
#	Line 268	Line 273
273	end	end
274	(* end case *))	(* end case *))
275
276		fun checkGlobalExpr (env, cxt, exp) = checkExpr ({globalScope=true, env=env}, cxt, exp)
277		fun checkLocalExpr (env, cxt, exp) = checkExpr ({globalScope=false, env=env}, cxt, exp)
278		fun checkLocalExprList (env, cxt, exp) = checkExprList ({globalScope=false, env=env}, cxt, exp)
279
280	(* typecheck a statement and translate it to AST *)	(* typecheck a statement and translate it to AST *)
281	fun checkStmt (env, cxt, s) = (case s	fun checkStmt (env, cxt, s) = (case s
282	of PT.S_Mark m => checkStmt (withEnvAndContext (env, cxt, m))	of PT.S_Mark m => checkStmt (withEnvAndContext (env, cxt, m))
#	Line 282	Line 291
291	(chk (env, stms, []), env)	(chk (env, stms, []), env)
292	end	end
293	| PT.S_Decl vd => let	| PT.S_Decl vd => let
294	val (x, x', e) = checkVarDecl (env, cxt, Var.LocalVar, vd)	val (x, x', e) = checkVarDecl ({globalScope=false, env=env}, cxt, Var.LocalVar, vd)
295	in	in
296	(AST.S_Decl(AST.VD_Decl(x', e)), Env.insertLocal(env, x, x'))	(AST.S_Decl(AST.VD_Decl(x', e)), Env.insertLocal(env, x, x'))
297	end	end
298	| PT.S_IfThen(e, s) => let	| PT.S_IfThen(e, s) => let
299	val (e', ty) = checkExpr (env, cxt, e)	val (e', ty) = checkLocalExpr (env, cxt, e)
300	val (s', _) = checkStmt (env, cxt, s)	val (s', _) = checkStmt (env, cxt, s)
301	in	in
302	(* check that condition has bool type *)	(* check that condition has bool type *)
#	Line 298	Line 307
307	(AST.S_IfThenElse(e', s', AST.S_Block[]), env)	(AST.S_IfThenElse(e', s', AST.S_Block[]), env)
308	end	end
309	| PT.S_IfThenElse(e, s1, s2) => let	| PT.S_IfThenElse(e, s1, s2) => let
310	val (e', ty) = checkExpr (env, cxt, e)	val (e', ty) = checkLocalExpr (env, cxt, e)
311	val (s1', _) = checkStmt (env, cxt, s1)	val (s1', _) = checkStmt (env, cxt, s1)
312	val (s2', _) = checkStmt (env, cxt, s2)	val (s2', _) = checkStmt (env, cxt, s2)
313	in	in
#	Line 316	Line 325
325	| SOME x' => let	| SOME x' => let
326	(* FIXME: check for polymorphic variables *)	(* FIXME: check for polymorphic variables *)
327	val ([], ty) = Var.typeOf x'	val ([], ty) = Var.typeOf x'
328	val (e', ty') = checkExpr (env, cxt, e)	val (e', ty') = checkLocalExpr (env, cxt, e)
329	in	in
330	if U.matchType(ty, ty')	if U.matchType(ty, ty')
331	then (x, x', e')	then (x, x', e')
#	Line 338	Line 347
347	end	end
348	(* end case *))	(* end case *))
349	| PT.S_New(actor, args) => let	| PT.S_New(actor, args) => let
350	val argsAndTys' = List.map (fn e => checkExpr(env, cxt, e)) args	val argsAndTys' = List.map (fn e => checkLocalExpr(env, cxt, e)) args
351	val (args', tys') = ListPair.unzip argsAndTys'	val (args', tys') = ListPair.unzip argsAndTys'
352	in	in
353	(* FIXME: check that actor is defined and has the argument types match *)	(* FIXME: check that actor is defined and has the argument types match *)
#	Line 382	Line 391
391	(* check the actor state variable definitions *)	(* check the actor state variable definitions *)
392	val (vds, env) = let	val (vds, env) = let
393	fun checkStateVar ((isOut, vd), (vds, env)) = let	fun checkStateVar ((isOut, vd), (vds, env)) = let
394	val (x, x', e') = checkVarDecl (env, cxt, AST.ActorStateVar, vd)	val (x, x', e') = checkVarDecl ({globalScope=false, env=env}, cxt, AST.ActorStateVar, vd)
395	in	in
396	((isOut, AST.VD_Decl(x', e'))::vds, Env.insertLocal(env, x, x'))	((isOut, AST.VD_Decl(x', e'))::vds, Env.insertLocal(env, x, x'))
397	end	end
#	Line 398	Line 407
407
408	fun checkCreate (env, cxt, PT.C_Mark m) = checkCreate (withEnvAndContext (env, cxt, m))	fun checkCreate (env, cxt, PT.C_Mark m) = checkCreate (withEnvAndContext (env, cxt, m))
409	| checkCreate (env, cxt, PT.C_Create(actor, args)) = let	| checkCreate (env, cxt, PT.C_Create(actor, args)) = let
410	val (args, tys) = checkExprList (env, cxt, args)	val (args, tys) = checkLocalExprList (env, cxt, args)
411	in	in
412	(* FIXME: check against actor definition *)	(* FIXME: check against actor definition *)
413	AST.C_Create(actor, args)	AST.C_Create(actor, args)
#	Line 406	Line 415
415
416	fun checkIter (env, cxt, PT.I_Mark m) = checkIter (withEnvAndContext (env, cxt, m))	fun checkIter (env, cxt, PT.I_Mark m) = checkIter (withEnvAndContext (env, cxt, m))
417	| checkIter (env, cxt, PT.I_Range(x, e1, e2)) = let	| checkIter (env, cxt, PT.I_Range(x, e1, e2)) = let
418	val (e1', ty1) = checkExpr (env, cxt, e1)	val (e1', ty1) = checkLocalExpr (env, cxt, e1)
419	val (e2', ty2) = checkExpr (env, cxt, e2)	val (e2', ty2) = checkLocalExpr (env, cxt, e2)
420	val x' = Var.new(x, Var.LocalVar, Ty.T_Int)	val x' = Var.new(x, Var.LocalVar, Ty.T_Int)
421	val env' = Env.insertLocal(env, x, x')	val env' = Env.insertLocal(env, x, x')
422	in	in
#	Line 439	Line 448
448	val dcl = (case optExp	val dcl = (case optExp
449	of NONE => AST.D_Input(x', NONE)	of NONE => AST.D_Input(x', NONE)
450	| SOME e => let	| SOME e => let
451	val (e', ty') = checkExpr (env, cxt, e)	val (e', ty') = checkGlobalExpr (env, cxt, e)
452	in	in
453	if U.matchType (ty, ty')	if U.matchType (ty, ty')
454	then AST.D_Input(x', SOME e')	then AST.D_Input(x', SOME e')
#	Line 454	Line 463
463	(dcl, Env.insertGlobal(env, x, x'))	(dcl, Env.insertGlobal(env, x, x'))
464	end	end
465	| PT.D_Var vd => let	| PT.D_Var vd => let
466	val (x, x', e') = checkVarDecl (env, cxt, Var.GlobalVar, vd)	val (x, x', e') = checkVarDecl ({globalScope=true, env=env}, cxt, Var.GlobalVar, vd)
467	in	in
468	(AST.D_Var(AST.VD_Decl(x', e')), Env.insertGlobal(env, x, x'))	(AST.D_Var(AST.VD_Decl(x', e')), Env.insertGlobal(env, x, x'))
469	end	end

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.168   changed lines   Added in v.169

---

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