Добавлен оператор IS

diff --git a/notes b/notes
index 416ccefe02bdce71148f6bef1e5eb98030c15c18..23e0d235844ce33253b5d73fd7fc99f33d9d32f8 100644 (file)
--- a/notes
+++ b/notes
@@ -1,8 +1,4 @@
-- Нужен тип представляющий типы
-    Требуется для оператора IS и некоторых встраиваемых функций
-
 - Нет типа SET
-- Нет оператора IS
 - Нет конструкции CASE
 - Нет конструкции WITH
 - Нет модуля SYSTEM

diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c
index ca0f88565536d1ae11ce2022c4713099fb9bcf0c..e6a26bdbb3d8230733f43e5f4232869f3fea786d 100644 (file)
--- a/src/backends/jvm/generator-jvm.c
+++ b/src/backends/jvm/generator-jvm.c
@@ -1755,6 +1755,13 @@ push_operator(gen_proc_t * p, oberon_oper_t * oper)
                case OP_LOGIC_AND:
                        jvm_generate_logical_and(p, oper -> left, oper -> right);
                        break;
+
+               case OP_IS:
+                       preq = oper -> right -> result;
+                       char * cname = jvm_get_class_full_name(preq);
+                       push_expr(p, oper -> left);
+                       jvm_generate(p, 1, 1, "instanceof %s", cname);
+                       break;
                default:
                        gen_error("push_oper: unk op %i", op);
                        break;

diff --git a/src/oberon-internals.h b/src/oberon-internals.h
index 07d8d032a85b8460ffa9a6f1617fb19863306cab..5dd3582576af7e07980552a59f3763025a098fa8 100644 (file)
--- a/src/oberon-internals.h
+++ b/src/oberon-internals.h
@@ -204,7 +204,8 @@ enum oberon_operator_kind
        OP_GRT,
        OP_GEQ,
 
-       OP_CAST
+       OP_CAST,
+       OP_IS
 };
 
 struct oberon_item_t

diff --git a/src/oberon.c b/src/oberon.c
index a2a567036598a90f005bcc1780531e18e6d54701..e88ff79159e28e93c010a73ebde045ee8a6c9132 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -1720,7 +1720,45 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
        oberon_expr_t * expr;
        oberon_type_t * result;
 
-       if(ITMAKESBOOLEAN(token))
+       if(token == IS)
+       {
+               oberon_type_t * v = a -> result;
+               if(v -> class == OBERON_TYPE_POINTER)
+               {
+                       v = v -> base;
+                       if(v -> class != OBERON_TYPE_RECORD)
+                       {
+                               oberon_error(ctx, "must be record");
+                       }
+               }
+               else if(v -> class != OBERON_TYPE_RECORD)
+               {
+                       oberon_error(ctx, "must be record");
+               }               
+
+               if(b -> is_item == false || b -> item.mode != MODE_TYPE)
+               {
+                       oberon_error(ctx, "requires type");
+               }
+
+               oberon_type_t * t = b -> result;
+               if(t -> class == OBERON_TYPE_POINTER)
+               {
+                       t = t -> base;
+                       if(t -> class != OBERON_TYPE_RECORD)
+                       {
+                               oberon_error(ctx, "must be record");
+                       }
+               }
+               else if(t -> class != OBERON_TYPE_RECORD)
+               {
+                       oberon_error(ctx, "must be record");
+               }
+
+               result = ctx -> bool_type;
+               expr = oberon_new_operator(OP_IS, result, a, b);
+       }
+       else if(ITMAKESBOOLEAN(token))
        {
                if(ITUSEONLYINTEGER(token))
                {
@@ -3501,6 +3539,7 @@ oberon_make_abs_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
 
        oberon_expr_t * arg;
        arg = list_args;
+       oberon_check_src(ctx, arg);
 
        oberon_type_t * result_type;
        result_type = arg -> result;
@@ -3523,8 +3562,10 @@ oberon_make_new_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
                oberon_error(ctx, "too few arguments");
        }
 
+
        oberon_expr_t * dst;
        dst = list_args;
+       oberon_check_dst(ctx, dst);
 
        oberon_type_t * type;
        type = dst -> result;
@@ -3573,6 +3614,7 @@ oberon_make_new_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
                oberon_expr_t * arg = size_list;
                for(int i = 0; i < max_args - 1; i++)
                {
+                       oberon_check_src(ctx, arg);
                        if(arg -> result -> class != OBERON_TYPE_INTEGER)
                        {
                                oberon_error(ctx, "size must be integer");

diff --git a/src/test.c b/src/test.c
index 33f1aeba29afe63852163207b4e4baef9900f715..024252a2def43abc44d82e38d95f1180f551caa2 100644 (file)
--- a/src/test.c
+++ b/src/test.c
@@ -9,23 +9,23 @@ static char source_test[] =
        "MODULE Test;"
        "IMPORT Out;"
        ""
+       "TYPE"
+       "  RecA = POINTER TO RecADesc;"
+       "  RecADesc = RECORD END;"
+       ""
+       "  RecB = POINTER TO RecBDesc;"
+       "  RecBDesc = RECORD (RecADesc) END;"
+       ""
        "VAR"
-       "  i, len : INTEGER;"
+       "  a : RecA;"
+       "  b : RecB;"
        ""
        "BEGIN"
+       "  NEW(a);"
+       "  NEW(b);"
        "  Out.Open;"
-       "  Out.Int(MIN(BYTE), 0); Out.Ln;"
-       "  Out.Int(MIN(SHORTINT), 0); Out.Ln;"
-       "  Out.Int(MIN(INTEGER), 0); Out.Ln;"
-       "  Out.Int(MIN(LONGINT), 0); Out.Ln;"
-       "  Out.Int(MAX(BYTE), 0); Out.Ln;"
-       "  Out.Int(MAX(SHORTINT), 0); Out.Ln;"
-       "  Out.Int(MAX(INTEGER), 0); Out.Ln;"
-       "  Out.Int(MAX(LONGINT), 0); Out.Ln;"
-       "  Out.Int(SIZE(BYTE), 0); Out.Ln;"
-       "  Out.Int(SIZE(SHORTINT), 0); Out.Ln;"
-       "  Out.Int(SIZE(INTEGER), 0); Out.Ln;"
-       "  Out.Int(SIZE(LONGINT), 0); Out.Ln;"
+       "  a := b;"
+       "  IF a IS RecA THEN Out.String('Yes'); Out.Ln; END;"
        "END Test."
 ;