Add cast syntax.

diff --git a/parse/ast.sml b/parse/ast.sml
index ce756abb87e7714fb5988df088b4be3698653f30..9645f6ae9c17525dec83e013fd18f859b30fd45c 100644 (file)
--- 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 39f33cd2ad7cb5d1e271a75c7f13136ea4ce7ebd..bf2e2616f3ac4a722f592fed243b2970006f1427 100644 (file)
--- 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 0ec657403bf018b7f01007fc62bf87719ed52518..ec66fd5f4507cb8df767ae89babaacbb572d5e72 100644 (file)
--- 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 8be373158bbeac5c1bea4c2e34d473f919ac6436..3191979319b9e292b56ff14d865fc4e806d87585 100644 (file)
--- 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