Add cast syntax.

[snipe.git] / type / typechecker.sml

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)
       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]) =>
        | 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 => ())
            | 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.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