Добавлена проверка базы записи на рекурсивное расширение

[dsw-obn.git] / src / oberon.c

diff --git a/src/oberon.c b/src/oberon.c
index 064cfb10bd0b24955eb0b23655c12ee68d62cf52..cf1a570f8084f96c21234f7de51ad5e1c4406676 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -24,8 +24,6 @@ enum {
        BEGIN,
        ASSIGN,
        INTEGER,
        BEGIN,
        ASSIGN,
        INTEGER,

-       TRUE,
-       FALSE,

        LPAREN,
        RPAREN,
        EQUAL,
        LPAREN,
        RPAREN,
        EQUAL,


@@ -344,14 +342,6 @@ oberon_read_ident(oberon_context_t * ctx)
        {
                ctx -> token = BEGIN;
        }
        {
                ctx -> token = BEGIN;
        }

-       else if(strcmp(ident, "TRUE") == 0)
-       {
-               ctx -> token = TRUE;
-       }
-       else if(strcmp(ident, "FALSE") == 0)
-       {
-               ctx -> token = FALSE;
-       }

        else if(strcmp(ident, "OR") == 0)
        {
                ctx -> token = OR;
        else if(strcmp(ident, "OR") == 0)
        {
                ctx -> token = OR;


@@ -700,8 +690,6 @@ static void oberon_read_string(oberon_context_t * ctx)
 
        ctx -> token = STRING;
        ctx -> string = string;
 
        ctx -> token = STRING;
        ctx -> string = string;

-
-       printf("oberon_read_string: string ((%s))\n", string);

 }
 
 static void oberon_read_token(oberon_context_t * ctx);
 }
 
 static void oberon_read_token(oberon_context_t * ctx);


@@ -996,11 +984,8 @@ oberno_make_record_cast(oberon_context_t * ctx, oberon_expr_t * expr, oberon_typ
        oberon_type_t * from = expr -> result;
        oberon_type_t * to = rec;
 
        oberon_type_t * from = expr -> result;
        oberon_type_t * to = rec;
 

-       printf("oberno_make_record_cast: from class %i to class %i\n", from -> class, to -> class);
-

        if(from -> class == OBERON_TYPE_POINTER && to -> class == OBERON_TYPE_POINTER)
        {
        if(from -> class == OBERON_TYPE_POINTER && to -> class == OBERON_TYPE_POINTER)
        {

-               printf("oberno_make_record_cast: pointers\n");

                from = from -> base;
                to = to -> base;
        }
                from = from -> base;
                to = to -> base;
        }


@@ -1117,9 +1102,6 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t *
        bool error = false;
        if(pref -> class != expr -> result -> class)
        {
        bool error = false;
        if(pref -> class != expr -> result -> class)
        {

-               printf("expr class %i\n", expr -> result -> class);
-               printf("pref class %i\n", pref -> class);
-

                if(expr -> result -> class == OBERON_TYPE_STRING)
                {
                        if(pref -> class == OBERON_TYPE_CHAR)
                if(expr -> result -> class == OBERON_TYPE_STRING)
                {
                        if(pref -> class == OBERON_TYPE_CHAR)


@@ -1364,14 +1346,11 @@ oberon_make_call_proc(oberon_context_t * ctx, oberon_item_t * item, int num_args
        || ((x) == STRING) \
        || ((x) == NIL) \
        || ((x) == LPAREN) \
        || ((x) == STRING) \
        || ((x) == NIL) \
        || ((x) == LPAREN) \

-       || ((x) == NOT) \
-       || ((x) == TRUE) \
-       || ((x) == FALSE)) 
+       || ((x) == NOT))

 
 static oberon_expr_t *
 oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr)
 {
 
 static oberon_expr_t *
 oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr)
 {

-       printf("oberno_make_dereferencing\n");

        if(expr -> result -> class != OBERON_TYPE_POINTER)
        {
                oberon_error(ctx, "not a pointer");
        if(expr -> result -> class != OBERON_TYPE_POINTER)
        {
                oberon_error(ctx, "not a pointer");


@@ -1770,6 +1749,15 @@ oberon_set(oberon_context_t * ctx)
        return set;
 }
 
        return set;
 }
 

+static oberon_expr_t *
+oberon_make_boolean(oberon_context_t * ctx, bool cond)
+{
+       oberon_expr_t * expr;
+       expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, true);
+       expr -> item.integer = cond;
+       return expr;
+}
+

 static oberon_expr_t *
 oberon_factor(oberon_context_t * ctx)
 {
 static oberon_expr_t *
 oberon_factor(oberon_context_t * ctx)
 {


@@ -1804,16 +1792,6 @@ oberon_factor(oberon_context_t * ctx)
                        expr -> item.real = ctx -> real;
                        oberon_assert_token(ctx, REAL);
                        break;
                        expr -> item.real = ctx -> real;
                        oberon_assert_token(ctx, REAL);
                        break;

-               case TRUE:
-                       expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, true);
-                       expr -> item.boolean = true;
-                       oberon_assert_token(ctx, TRUE);
-                       break;
-               case FALSE:
-                       expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, true);
-                       expr -> item.boolean = false;
-                       oberon_assert_token(ctx, FALSE);
-                       break;

                case LBRACE:
                        expr = oberon_set(ctx);
                        break;
                case LBRACE:
                        expr = oberon_set(ctx);
                        break;


@@ -2896,6 +2874,11 @@ oberon_prevent_recursive_record(oberon_context_t * ctx, oberon_type_t * type)
 
        type -> recursive = 1;
 
 
        type -> recursive = 1;
 

+       if(type -> base)
+       {
+               oberon_prevent_recursive_record(ctx, type -> base);
+       }
+

        int num_fields = type -> num_decl;
        oberon_object_t * field = type -> decl;
        for(int i = 0; i < num_fields; i++)
        int num_fields = type -> num_decl;
        oberon_object_t * field = type -> decl;
        for(int i = 0; i < num_fields; i++)


@@ -4038,6 +4021,15 @@ oberon_make_new_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
        oberon_assign(ctx, src, dst);
 }
 
        oberon_assign(ctx, src, dst);
 }
 

+static void
+oberon_new_const(oberon_context_t * ctx, char * name, oberon_expr_t * expr)
+{
+       oberon_object_t * constant;
+       constant = oberon_define_object(ctx -> decl, name, OBERON_CLASS_CONST, true, false, false);
+       oberon_check_const(ctx, expr);
+       constant -> value = (oberon_item_t *) expr;
+}
+

 oberon_context_t *
 oberon_create_context(ModuleImportCallback import_module)
 {
 oberon_context_t *
 oberon_create_context(ModuleImportCallback import_module)
 {


@@ -4053,6 +4045,10 @@ oberon_create_context(ModuleImportCallback import_module)
 
        register_default_types(ctx);
 
 
        register_default_types(ctx);
 

+       /* Constants */
+       oberon_new_const(ctx, "TRUE", oberon_make_boolean(ctx, true));
+       oberon_new_const(ctx, "FALSE", oberon_make_boolean(ctx, false));
+

        /* Functions */
        oberon_new_intrinsic(ctx, "ABS", oberon_make_abs_call, NULL);
        oberon_new_intrinsic(ctx, "MIN", oberon_make_min_call, NULL);
        /* Functions */
        oberon_new_intrinsic(ctx, "ABS", oberon_make_abs_call, NULL);
        oberon_new_intrinsic(ctx, "MIN", oberon_make_min_call, NULL);