Добавлены опережающие объявления процедур

diff --git a/notes b/notes
index 2bf0b297a3034ad4870e7a3aeb352dc3f9efdcd6..0bf5789be9888a088582eaf1b13f0654952d719e 100644 (file)
--- a/notes
+++ b/notes
@@ -1,12 +1,10 @@
-- не реализованы объявления процедур наперёд
-
+- нужно сделать объявление встроенных процедур
 - нету процедуры NEW
 - нету открытых массивов
 
 - нету секции import
 
-- не понятен результат присваивания статических структур (* reca := recb; *)
-- не понятен результат присваивания статических массивов (* arr1 := arr2; *)
+- нету операторов if, while и т.д.
 
 - нету типа set
 - не реализована свёртка констант
@@ -16,3 +14,5 @@
 - не работает присваивание к переменным-процедурам.
 - не реализован автокаст (libgccjit сам разруливает)
 - libgccjit не умеет в локальные функции (опять пилить костыли как в jvm)
+- не понятен результат присваивания статических/разыменованных структур (* reca := recb; *)
+- не понятен результат присваивания статических/разыменованных массивов (* arr1 := arr2; *)

diff --git a/oberon.c b/oberon.c
index ac695d384bd17567d76620269a3ad02ac3929d57..4eb240b043479840196b87af05eb0fb037ebba10 100644 (file)
--- a/oberon.c
+++ b/oberon.c
@@ -286,6 +286,7 @@ oberon_find_var(oberon_scope_t * scope, char * name)
 }
 */
 
+/*
 static oberon_object_t *
 oberon_define_proc(oberon_scope_t * scope, char * name, oberon_type_t * signature)
 {
@@ -294,6 +295,7 @@ oberon_define_proc(oberon_scope_t * scope, char * name, oberon_type_t * signatur
        proc -> type = signature;
        return proc;
 }
+*/
 
 // =======================================================================
 //   SCANER
@@ -1401,6 +1403,34 @@ oberon_opt_formal_pars(oberon_context_t * ctx, oberon_type_t ** type)
        }
 }
 
+static void
+oberon_compare_signatures(oberon_context_t * ctx, oberon_type_t * a, oberon_type_t * b)
+{
+       if(a -> num_decl != b -> num_decl)
+       {
+               oberon_error(ctx, "number parameters not matched");
+       }
+
+       int num_param = a -> num_decl;
+       oberon_object_t * param_a = a -> decl;
+       oberon_object_t * param_b = b -> decl;
+       for(int i = 0; i < num_param; i++)
+       {
+               if(strcmp(param_a -> name, param_b -> name) != 0)
+               {
+                       oberon_error(ctx, "param %i name not matched", i + 1);
+               }
+
+               if(param_a -> type != param_b -> type)
+               {
+                       oberon_error(ctx, "param %i type not matched", i + 1);
+               }
+
+               param_a = param_a -> next;
+               param_b = param_b -> next;
+       }
+}
+
 static void
 oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr)
 {
@@ -1430,34 +1460,13 @@ oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr)
 }
 
 static void
-oberon_proc_decl(oberon_context_t * ctx)
+oberon_proc_decl_body(oberon_context_t * ctx, oberon_object_t * proc)
 {
-       oberon_assert_token(ctx, PROCEDURE);
-
-       char * name;
-       name = oberon_assert_ident(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);
-       oberon_opt_formal_pars(ctx, &signature);
-
-       oberon_object_t * proc;
-       proc = oberon_define_proc(this_proc_def_scope, name, signature);
-
-       // процедура как новый родительский объект
-       ctx -> decl -> parent = proc;
-
-       oberon_initialize_decl(ctx);
-       oberon_generator_init_proc(ctx, proc);
-
        oberon_assert_token(ctx, SEMICOLON);
 
+       ctx -> decl = proc -> scope;
+
        oberon_decl_seq(ctx);
-       oberon_generator_init_type(ctx, signature);
 
        oberon_generate_begin_proc(ctx, proc);
 
@@ -1468,13 +1477,14 @@ oberon_proc_decl(oberon_context_t * ctx)
        }
 
        oberon_assert_token(ctx, END);
-       char * name2 = oberon_assert_ident(ctx);
-       if(strcmp(name2, name) != 0)
+       char * name = oberon_assert_ident(ctx);
+       if(strcmp(name, proc -> name) != 0)
        {
                oberon_error(ctx, "procedure name not matched");
        }
 
-       if(signature -> base -> class == OBERON_TYPE_VOID)
+       if(proc -> type -> base -> class == OBERON_TYPE_VOID
+               && proc -> has_return == 0)
        {
                oberon_make_return(ctx, NULL);
        }
@@ -1488,6 +1498,69 @@ oberon_proc_decl(oberon_context_t * ctx)
        oberon_close_scope(ctx -> decl);
 }
 
+static void
+oberon_proc_decl(oberon_context_t * ctx)
+{
+       oberon_assert_token(ctx, PROCEDURE);
+
+       int forward = 0;
+       if(ctx -> token == UPARROW)
+       {
+               oberon_assert_token(ctx, UPARROW);
+               forward = 1;
+       }
+
+       char * name;
+       name = oberon_assert_ident(ctx);
+
+       oberon_scope_t * proc_scope;
+       proc_scope = oberon_open_scope(ctx);
+       ctx -> decl -> local = 1;
+
+       oberon_type_t * signature;
+       signature = oberon_new_type_ptr(OBERON_TYPE_VOID);
+       oberon_opt_formal_pars(ctx, &signature);        
+
+       oberon_initialize_decl(ctx);
+       oberon_generator_init_type(ctx, signature);
+       oberon_close_scope(ctx -> decl);
+
+       oberon_object_t * proc;
+       proc = oberon_find_object(ctx -> decl, name, 0);
+       if(proc != NULL)
+       {
+               if(proc -> class != OBERON_CLASS_PROC)
+               {
+                       oberon_error(ctx, "mult definition");
+               }
+
+               if(forward == 0)
+               {
+                       if(proc -> linked)
+                       {
+                               oberon_error(ctx, "mult procedure definition");
+                       }
+
+                       oberon_compare_signatures(ctx, proc -> type, signature);
+               }
+       }
+       else
+       {
+               proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC);
+               proc -> type = signature;
+               proc -> scope = proc_scope;
+               oberon_generator_init_proc(ctx, proc);
+       }
+
+       proc -> scope -> parent = proc;
+
+       if(forward == 0)
+       {
+               proc -> linked = 1;
+               oberon_proc_decl_body(ctx, proc);
+       }
+}
+
 static void
 oberon_const_decl(oberon_context_t * ctx)
 {
@@ -1975,6 +2048,24 @@ oberon_initialize_decl(oberon_context_t * ctx)
        }       
 }
 
+static void
+oberon_prevent_undeclarated_procedures(oberon_context_t * ctx)
+{
+       oberon_object_t * x = ctx -> decl -> list;
+
+       while(x -> next)
+       {
+               if(x -> next -> class == OBERON_CLASS_PROC)
+               {
+                       if(x -> next -> linked == 0)
+                       {
+                               oberon_error(ctx, "unresolved forward declaration");
+                       }
+               }
+               x = x -> next;
+       }       
+}
+
 static void
 oberon_decl_seq(oberon_context_t * ctx)
 {
@@ -2016,6 +2107,8 @@ oberon_decl_seq(oberon_context_t * ctx)
                oberon_proc_decl(ctx);
                oberon_assert_token(ctx, SEMICOLON);
        }
+
+       oberon_prevent_undeclarated_procedures(ctx);
 }
 
 static void

diff --git a/oberon.h b/oberon.h
index 9d17afdb16e76ff0bbfa3e8d2ce30d4b80e46a7b..f84d332ca73124ace42cbaaa6c097586038bd114 100644 (file)
--- a/oberon.h
+++ b/oberon.h
@@ -158,6 +158,7 @@ struct oberon_object_s
        int initialized;
 
        oberon_object_t * parent;
+       oberon_scope_t * scope; // for proc
        int has_return; // for proc
 
 

diff --git a/test.c b/test.c
index 44b84651f535348afba524c61fa810f634bbe4fd..b07a08d0898a7f2816a6bb281c9f6050ac31d9bb 100644 (file)
--- a/test.c
+++ b/test.c
@@ -10,16 +10,19 @@ static const char source[] =
        "       i : INTEGER;"
        "       j : INTEGER;"
        ""
-       "PROCEDURE Tier(VAR x : INTEGER);"
-       "VAR"
-       "       z : INTEGER;"
+       "PROCEDURE ^ Tier(x : INTEGER);"
+       ""
+       "PROCEDURE Tier(x : INTEGER);"
+       "VAR a : INTEGER;"
        "BEGIN;"
-       "       x := i;"
+       "       a := 1;"
        "END Tier;"
        ""
+       "PROCEDURE ^ Tier(x : INTEGER);"
+       ""
        "BEGIN;"
        "       i := 666;"
-       "       Tier(j);"
+       "       Tier(1);"
        "END Test."
 ;