Добавлены локальные объявления

[dsw-obn.git] / oberon.c

diff --git a/oberon.c b/oberon.c
index 3837bf5b92702c744bcf7b883ff73395826063a8..ac695d384bd17567d76620269a3ad02ac3929d57 100644 (file)
--- a/oberon.c
+++ b/oberon.c
@@ -118,6 +118,12 @@ oberon_open_scope(oberon_context_t * ctx)
        scope -> list = list;
        scope -> up = ctx -> decl;
 
+       if(scope -> up)
+       {
+               scope -> parent = scope -> up -> parent;
+               scope -> local = scope -> up -> local;
+       }
+
        ctx -> decl = scope;
        return scope;
 }
@@ -147,6 +153,8 @@ oberon_define_object(oberon_scope_t * scope, char * name, int class)
        memset(newvar, 0, sizeof *newvar);
        newvar -> name = name;
        newvar -> class = class;
+       newvar -> local = scope -> local;
+       newvar -> parent = scope -> parent;
 
        x -> next = newvar;
 
@@ -156,6 +164,8 @@ oberon_define_object(oberon_scope_t * scope, char * name, int class)
 static void
 oberon_define_field(oberon_context_t * ctx, oberon_type_t * rec, char *  name, oberon_type_t * type)
 {
+       // TODO check base fields
+
        oberon_object_t * x = rec -> decl;
        while(x -> next && strcmp(x -> next -> name, name) != 0)
        {
@@ -172,6 +182,8 @@ oberon_define_field(oberon_context_t * ctx, oberon_type_t * rec, char *  name, o
        field -> name = name;
        field -> class = OBERON_CLASS_FIELD;
        field -> type = type;
+       field -> local = 1;
+       field -> parent = NULL;
 
        rec -> num_decl += 1;
        x -> next = field;
@@ -1259,6 +1271,7 @@ oberon_const_expr(oberon_context_t * ctx)
 
 static void oberon_decl_seq(oberon_context_t * ctx);
 static void oberon_statement_seq(oberon_context_t * ctx);
+static void oberon_initialize_decl(oberon_context_t * ctx);
 
 static void
 oberon_expect_token(oberon_context_t * ctx, int token)
@@ -1391,7 +1404,10 @@ oberon_opt_formal_pars(oberon_context_t * ctx, oberon_type_t ** type)
 static void
 oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr)
 {
-       if(ctx -> result_type -> class == OBERON_TYPE_VOID)
+       oberon_object_t * proc = ctx -> decl -> parent;
+       oberon_type_t * result_type = proc -> type -> base;
+
+       if(result_type -> class == OBERON_TYPE_VOID)
        {
                if(expr != NULL)
                {
@@ -1405,10 +1421,10 @@ oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr)
                        oberon_error(ctx, "procedure requires expression on result");
                }
 
-               oberon_autocast_to(ctx, expr, ctx -> result_type);
+               oberon_autocast_to(ctx, expr, result_type);
        }
 
-       ctx -> has_return = 1;
+       proc -> has_return = 1;
 
        oberon_generate_return(ctx, expr);
 }
@@ -1423,6 +1439,7 @@ oberon_proc_decl(oberon_context_t * ctx)
 
        oberon_scope_t * this_proc_def_scope = ctx -> decl;
        oberon_open_scope(ctx);
+       ctx -> decl -> local = 1;
 
        oberon_type_t * signature;
        signature = oberon_new_type_ptr(OBERON_TYPE_VOID);
@@ -1431,14 +1448,16 @@ oberon_proc_decl(oberon_context_t * ctx)
        oberon_object_t * proc;
        proc = oberon_define_proc(this_proc_def_scope, name, signature);
 
-       ctx -> result_type = signature -> base;
-       ctx -> has_return = 0;
+       // процедура как новый родительский объект
+       ctx -> decl -> parent = proc;
+
+       oberon_initialize_decl(ctx);
+       oberon_generator_init_proc(ctx, proc);
 
        oberon_assert_token(ctx, SEMICOLON);
 
        oberon_decl_seq(ctx);
        oberon_generator_init_type(ctx, signature);
-       oberon_generator_init_proc(ctx, proc);
 
        oberon_generate_begin_proc(ctx, proc);
 
@@ -1460,11 +1479,10 @@ oberon_proc_decl(oberon_context_t * ctx)
                oberon_make_return(ctx, NULL);
        }
 
-       if(ctx -> has_return == 0)
+       if(proc -> has_return == 0)
        {
                oberon_error(ctx, "procedure requires return");
        }
-       ctx -> result_type = NULL;
 
        oberon_generate_end_proc(ctx);
        oberon_close_scope(ctx -> decl);
@@ -1917,7 +1935,13 @@ oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type)
 static void
 oberon_initialize_object(oberon_context_t * ctx, oberon_object_t * x)
 {
-       printf("oberon_initialize_object: name %s class %i\n", x -> name, x -> class);
+       if(x -> initialized)
+       {
+               return;
+       }
+
+       x -> initialized = 1;
+
        switch(x -> class)
        {
                case OBERON_CLASS_TYPE:
@@ -2006,7 +2030,10 @@ oberon_make_call(oberon_context_t * ctx, oberon_expr_t * desig)
 {
        if(desig -> result -> class != OBERON_TYPE_VOID)
        {
-               oberon_error(ctx, "procedure with result");
+               if(desig -> result -> class != OBERON_TYPE_PROCEDURE)
+               {
+                       oberon_error(ctx, "procedure with result");
+               }
        }
 
        oberon_autocast_call(ctx, desig);