From: DeaDDooMER <deaddoomer@deadsoftware.ru>
Date: Mon, 24 Jul 2017 19:38:25 +0000 (+0300)
Subject: Добавлены опережающие объявления процедур
X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=commitdiff_plain;h=734fa8f9223c140a583e7f193df810d48555ac34

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

diff --git a/notes b/notes
index 2bf0b29..0bf5789 100644
--- 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 ac695d3..4eb240b 100644
--- 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 9d17afd..f84d332 100644
--- 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 44b8465..b07a08d 100644
--- 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."
 ;