X-Git-Url: http://git.joshuawise.com/snipe.git/blobdiff_plain/5c79bb689ab446551bc7ec4497e6c9b75582837e..a644da892dbd55a7be1aed029dafebe28d26d27e:/type/typechecker.sml diff --git a/type/typechecker.sml b/type/typechecker.sml index 06c6d89..3191979 100644 --- a/type/typechecker.sml +++ b/type/typechecker.sml @@ -24,7 +24,11 @@ struct of A.Var a => (case Symbol.look vars a of NONE => (ErrorMsg.error mark ("variable `"^(Symbol.name a)^"' not declared here") ; raise ErrorMsg.Error) | SOME t => t) + | A.Cast (ty, e') => if (T.issmall ty) andalso (T.issmall (typeof (tds, funcs) vars mark e')) + then ty + else (ErrorMsg.error mark ("cannot cast: one of `"^(T.Print.pp_type ty)^"' or `"^(T.Print.pp_type (typeof (tds, funcs) vars mark e))^"' was not small"); raise ErrorMsg.Error) | A.ConstExp _ => T.Int + | A.StringExp _ => T.String | A.OpExp (A.EQ, [a, b]) => (case (typeof (tds, funcs) vars mark a, typeof (tds, funcs) vars mark b) of (T.Int, T.Int) => T.Int (* You shall pass! *) @@ -206,7 +210,9 @@ struct | SOME UNASSIGNED => ( ErrorMsg.error mark ("usage of unassigned variable `" ^ Symbol.name v ^ "'") ; raise ErrorMsg.Error ) | SOME ASSIGNED => ()) + | varcheck_exp env (A.Cast (ty, e)) mark = varcheck_exp env e mark | varcheck_exp env (A.ConstExp _) mark = () + | varcheck_exp env (A.StringExp _) mark = () | varcheck_exp env (A.OpExp (_, l)) mark = List.app (fn znt => varcheck_exp env znt mark) l | varcheck_exp env (A.FuncCall (f, l)) mark = List.app (fn znt => varcheck_exp env znt mark) l | varcheck_exp env (A.Marked m) mark = varcheck_exp env (Mark.kane m) (Mark.ext m) @@ -408,6 +414,7 @@ struct (* XXX does not check big vs. small types *) fun typecheck_type (tds, funcs) mark T.Int = () + | typecheck_type (tds, funcs) mark T.String = () | typecheck_type (tds, funcs) mark T.TNull = () | typecheck_type (tds, funcs) mark (T.Pointer t) = typecheck_type (tds, funcs) mark t | typecheck_type (tds, funcs) mark (T.Array t) = typecheck_type (tds, funcs) mark t