From: Joshua Wise Date: Sat, 10 Jul 2010 05:33:31 +0000 (-0400) Subject: Add cast syntax. X-Git-Url: http://git.joshuawise.com/snipe.git/commitdiff_plain/e63d3705454c62fd1eff1c0c9cd78f042e621fbc?ds=sidebyside Add cast syntax. --- diff --git a/parse/ast.sml b/parse/ast.sml index ce756ab..9645f6a 100644 --- a/parse/ast.sml +++ b/parse/ast.sml @@ -38,6 +38,7 @@ sig datatype exp = Var of ident + | Cast of Type.vtype * exp | ConstExp of Word32.word | StringExp of string | OpExp of oper * exp list @@ -109,6 +110,7 @@ struct datatype exp = Var of ident + | Cast of Type.vtype * exp | ConstExp of Word32.word | StringExp of string | OpExp of oper * exp list @@ -172,6 +174,7 @@ struct | pp_oper GE = ">=" fun pp_exp (Var(id)) = pp_ident id + | pp_exp (Cast(ty, exp)) = "["^(Type.Print.pp_type ty)^"]"^(pp_exp exp) | pp_exp (ConstExp(c)) = Word32Signed.toString c | pp_exp (StringExp(s)) = "\"" ^ s ^ "\"" | pp_exp (OpExp(oper, [e])) = diff --git a/parse/l5.grm b/parse/l5.grm index 39f33cd..bf2e261 100644 --- a/parse/l5.grm +++ b/parse/l5.grm @@ -188,6 +188,7 @@ exp : LPAREN exp RPAREN (exp) | INTNUM (mark (A.ConstExp(INTNUM),(INTNUMleft,INTNUMright))) | STRING (mark (A.StringExp(STRING),(STRINGleft,STRINGright))) | IDENT (mark (A.Var(IDENT), (IDENTleft,IDENTright))) + | LBRACKET vtype RBRACKET exp %prec UNARY (mark (A.Cast (vtype, exp), (LBRACKETleft, expright))) | exp DOT IDENT (mark (A.Member(exp, IDENT), (expleft, IDENTright))) | exp ARROW IDENT (mark (A.DerefMember(exp, IDENT), (expleft, IDENTright))) | STAR exp %prec UNARY (mark (A.Dereference(exp), (STARleft, expright))) diff --git a/trans/trans.sml b/trans/trans.sml index 0ec6574..ec66fd5 100644 --- a/trans/trans.sml +++ b/trans/trans.sml @@ -97,6 +97,7 @@ struct fun trans_exp env vartypes (A.Var(id)) = (* after type-checking, id must be declared; do not guard lookup *) T.TEMP (Symbol.look' env id) + | trans_exp env vartypes (A.Cast (ty, e)) = trans_exp env vartypes e (* lurrr *) | trans_exp env vartypes (A.ConstExp c) = T.CONST(c) | trans_exp env vartypes (A.StringExp s) = T.STRING(Stringref.new s) | trans_exp env vartypes (A.OpExp(oper, [e1, e2])) = diff --git a/type/typechecker.sml b/type/typechecker.sml index 8be3731..3191979 100644 --- a/type/typechecker.sml +++ b/type/typechecker.sml @@ -24,6 +24,9 @@ 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]) => @@ -207,6 +210,7 @@ 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