From: DeaDDooMER <deaddoomer@deadsoftware.ru>
Date: Thu, 10 Aug 2017 13:12:29 +0000 (+0300)
Subject: Исправлено присваивание и синхронизация сравнений со стандартом
X-Git-Url: http://deadsoftware.ru/gitweb?a=commitdiff_plain;h=496b7b4a5162004e33dfd3328aee7d155342f09f;p=dsw-obn.git

Исправлено присваивание и синхронизация сравнений со стандартом
---

diff --git a/Test.obn b/Test.obn
index b80d7a1..4f53910 100644
--- a/Test.obn
+++ b/Test.obn
@@ -1,22 +1,14 @@
 MODULE Test;
 
-TYPE
-  R1 = RECORD END;
-  R2 = RECORD (R1) END;
-  R3 = RECORD END;
-
-  P1 = POINTER TO R1;
-  P2 = POINTER TO R2;
+IMPORT Out;
 
 VAR
-  a : R1;
-  b : R2;
-  c : R3;
-  p1 : P1;
-  p2 : P2;
+  f : BOOLEAN;
+  r, e : POINTER TO RECORD END;
 
 BEGIN
-  a := b;
-  p2 := p1(P2);
-  p1 := p2(P2);
+  f := r = e;
+  IF f THEN
+    Out.String('Yes'); Out.Ln;
+  END;
 END Test.
diff --git a/notes b/notes
index 762ef89..ab857f4 100644
--- a/notes
+++ b/notes
@@ -1,4 +1,6 @@
 - Уточнить как должна работать проверка импорта на чтение. (8.1)
+- Уточнить результат оператора "/" (8.2.2)
+- Примеры -5 DIV 3 и -5 MOD 3 работают не так как в (8.2.2)
 
 - Нет модуля SYSTEM
 - Нет функций ASH CAP CHR ENTIER LEN LONG ODD ORD SHORT
@@ -8,10 +10,9 @@
 - Нужно пробежаться по стандарту и всё перепроверить.
 
 - JVM: Импортируемые модули не инициализируются
-- JVM: Не реализовано полное сранение массивов.
-- JVM: Не реализовано полное сранение записей.
+- JVM: Не реализовано сравнение строк.
 - JVM: Не достаточно средств для реализации рефлексии на уровне локальных процедур.
-    (Как минимум нужно каждой функции добавлять фрейм к параметрам)
+    Как минимум нужно каждой функции добавлять фрейм к параметрам (динамическая связь?)
 
 - Нужны средства создания биндингов. На данный момент реализуемо как заглушки для модулей.
 - Любая ошибка фатальна
diff --git a/src/backends/jvm/generator-jvm-abi.c b/src/backends/jvm/generator-jvm-abi.c
index ddaf45f..d0dabd2 100644
--- a/src/backends/jvm/generator-jvm-abi.c
+++ b/src/backends/jvm/generator-jvm-abi.c
@@ -69,6 +69,7 @@ void
 jvm_generate_load(gen_proc_t * p, gen_var_t * src)
 {
 	char prefix = src -> type -> prefix;
+	char postfix = src -> type -> postfix;
 	int cell_size = src -> type -> cell_size;
 	char * full_name = src -> full_name;
 	char * desc = src -> type -> desc;
@@ -94,7 +95,7 @@ jvm_generate_load(gen_proc_t * p, gen_var_t * src)
 		case JVM_STORAGE_FRAME_PARAM_VAR:
 		case JVM_STORAGE_FRAME_PARAM_VARPTR:
 			jvm_generate_ldst_prepare(p, src);
-			jvm_generate(p, 1 + 1, cell_size, "%caload", prefix);
+			jvm_generate(p, 1 + 1, cell_size, "%caload", postfix);
 			break;
 		case JVM_STORAGE_FRAME:
 		case JVM_STORAGE_FRAME_PARAM:
@@ -111,6 +112,7 @@ void
 jvm_generate_store(gen_proc_t * p, gen_var_t * dst)
 {
 	char prefix = dst -> type -> prefix;
+	char postfix = dst -> type -> postfix;
 	int cell_size = dst -> type -> cell_size;
 	char * full_name = dst -> full_name;
 	char * desc = dst -> type -> desc;
@@ -135,7 +137,7 @@ jvm_generate_store(gen_proc_t * p, gen_var_t * dst)
 		case JVM_STORAGE_FRAME_VAR:
 		case JVM_STORAGE_FRAME_PARAM_VAR:
 		case JVM_STORAGE_FRAME_PARAM_VARPTR:
-			jvm_generate(p, 1 + 1 + cell_size, 0, "%castore", prefix);
+			jvm_generate(p, 1 + 1 + cell_size, 0, "%castore", postfix);
 			break;
 		case JVM_STORAGE_FRAME:
 		case JVM_STORAGE_FRAME_PARAM:
@@ -295,6 +297,7 @@ jvm_generate_param_initialization(gen_proc_t * p, gen_var_t * v)
 	int old_reg = v -> reg;
 	int cell_size = v -> type -> cell_size;
 	char prefix = v -> type -> prefix;
+	char postfix = v -> type -> postfix;
 	char * name = v -> name;
 	char * desc = v -> type -> desc;
 
@@ -308,7 +311,7 @@ jvm_generate_param_initialization(gen_proc_t * p, gen_var_t * v)
 
 	jvm_generate(p, 0, 1, "iconst_0");
 	jvm_generate(p, 0, cell_size, "%cload %i", prefix, old_reg);
-	jvm_generate(p, 1 + 1 + cell_size, 0, "%castore", prefix);
+	jvm_generate(p, 1 + 1 + cell_size, 0, "%castore", postfix);
 }
 
 void
diff --git a/src/oberon.c b/src/oberon.c
index ece881f..9738056 100644
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -1573,17 +1573,9 @@ oberon_qualident_expr(oberon_context_t * ctx)
 	return expr;
 }
 
-static oberon_expr_t *
-oberon_make_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_object_t * objtype)
+static void
+oberon_check_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * type)
 {
-	oberon_type_t * type;
-
-	if(objtype -> class != OBERON_CLASS_TYPE)
-	{
-		oberon_error(ctx, "must be type");
-	}
-	type = objtype -> type;
-
 	/* Охрана типа применима, если */
 	/*   1. v - параметр-переменная типа запись, или v - указатель, и если */
 	/*   2. T - расширение статического типа v */
@@ -1594,7 +1586,8 @@ oberon_make_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_obje
 	{
 		// accept
 	}
-	else if(expr -> result -> class == OBERON_TYPE_POINTER)
+	else if(expr -> result -> class == OBERON_TYPE_POINTER
+		|| expr -> result -> class == OBERON_TYPE_RECORD)
 	{
 		// accept
 	}
@@ -1604,6 +1597,20 @@ oberon_make_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_obje
 	}
 
 	oberon_check_record_compatibility(ctx, type, expr -> result);
+}
+
+static oberon_expr_t *
+oberon_make_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_object_t * objtype)
+{
+	oberon_type_t * type;
+
+	if(objtype -> class != OBERON_CLASS_TYPE)
+	{
+		oberon_error(ctx, "must be type");
+	}
+	type = objtype -> type;
+
+	oberon_check_type_guard(ctx, expr, type);
 	return oberno_make_record_cast(ctx, expr, objtype -> type);
 }
 
@@ -1858,15 +1865,6 @@ oberon_factor(oberon_context_t * ctx)
 	return expr;
 }
 
-#define ITMAKESBOOLEAN(x) \
-	(((x) >= EQUAL && (x) <= GEQ) || ((x) == OR) || ((x) == AND))
-
-#define ITUSEONLYINTEGER(x) \
-	((x) >= LESS && (x) <= GEQ)
-
-#define ITUSEONLYBOOLEAN(x) \
-	(((x) == OR) || ((x) == AND))
-
 static void
 oberon_autocast_to_real(oberon_context_t * ctx, oberon_expr_t ** e)
 {
@@ -1888,6 +1886,49 @@ oberon_autocast_to_real(oberon_context_t * ctx, oberon_expr_t ** e)
 	}
 }
 
+static bool
+oberon_is_numeric_type(oberon_type_t * t)
+{
+	return (t -> class == OBERON_TYPE_INTEGER) || (t -> class == OBERON_TYPE_REAL);
+}
+
+static bool
+oberon_is_char_type(oberon_type_t * t)
+{
+	return (t -> class == OBERON_TYPE_CHAR);
+}
+
+static bool
+oberon_is_string_type(oberon_type_t * t)
+{
+	return (t -> class == OBERON_TYPE_STRING)
+		|| (t -> class == OBERON_TYPE_ARRAY && t -> base -> class == OBERON_TYPE_CHAR);
+}
+
+static bool
+oberon_is_boolean_type(oberon_type_t * t)
+{
+	return (t -> class == OBERON_TYPE_BOOLEAN);
+}
+
+static bool
+oberon_is_set_type(oberon_type_t * t)
+{
+	return (t -> class == OBERON_TYPE_SET);
+}
+
+static bool
+oberon_is_pointer_type(oberon_type_t * t)
+{
+	return (t -> class == OBERON_TYPE_POINTER) || (t -> class == OBERON_TYPE_NIL);
+}
+
+static bool
+oberon_is_procedure_type(oberon_type_t * t)
+{
+	return (t -> class == OBERON_TYPE_POINTER) || (t -> class == OBERON_TYPE_NIL);
+}
+
 static oberon_expr_t *
 oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_expr_t * b)
 {
@@ -1912,66 +1953,82 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
 	}
 	else 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;
+		oberon_check_type_guard(ctx, a, b -> result);
 		expr = oberon_new_operator(OP_IS, result, a, b);
 	}
-	else if(ITMAKESBOOLEAN(token))
+	else if((token >= EQUAL && token <= GEQ) || token == OR || token == AND)
 	{
-		if(ITUSEONLYINTEGER(token))
+		if(token >= LESS && token <= GEQ)
+		{
+			if(oberon_is_numeric_type(a -> result) && oberon_is_numeric_type(b -> result))
+			{
+				// accept
+			}
+			else if(oberon_is_char_type(a -> result) && oberon_is_char_type(b -> result))
+			{
+				// accept
+			}
+			else if(oberon_is_string_type(a -> result) && oberon_is_string_type(b -> result))
+			{
+				// accept
+			}
+			else
+			{
+				oberon_error(ctx, "invalid comparation");
+			}
+		}
+		else if(token == EQUAL || token == NEQ)
 		{
-			if(a -> result -> class == OBERON_TYPE_INTEGER
-				|| b -> result -> class == OBERON_TYPE_INTEGER
-				|| a -> result -> class == OBERON_TYPE_REAL
-				|| b -> result -> class == OBERON_TYPE_REAL)
+			if(oberon_is_numeric_type(a -> result) && oberon_is_numeric_type(b -> result))
+			{
+				// accept
+			}
+			else if(oberon_is_char_type(a -> result) && oberon_is_char_type(b -> result))
+			{
+				// accept
+			}
+			else if(oberon_is_string_type(a -> result) && oberon_is_string_type(b -> result))
+			{
+				// accept
+			}
+			else if(oberon_is_boolean_type(a -> result) && oberon_is_boolean_type(b -> result))
+			{
+				// accept
+			}
+			else if(oberon_is_set_type(a -> result) && oberon_is_set_type(b -> result))
+			{
+				// accept
+			}
+			else if(oberon_is_pointer_type(a -> result) && oberon_is_pointer_type(b -> result))
+			{
+				// accept
+			}
+			else if(oberon_is_procedure_type(a -> result) && oberon_is_procedure_type(b -> result))
 			{
 				// accept
 			}
 			else
 			{
-				oberon_error(ctx, "used only with numeric types");
+				oberon_error(ctx, "invalid comparation");
 			}
 		}
-		else if(ITUSEONLYBOOLEAN(token))
+		else if(token == AND || token == OR)
 		{
-			if(a -> result -> class != OBERON_TYPE_BOOLEAN
-				|| b -> result -> class != OBERON_TYPE_BOOLEAN)
+			if(!oberon_is_boolean_type(a -> result) || !oberon_is_boolean_type(b -> result))
 			{
-				oberon_error(ctx, "used only with boolean type");
+				oberon_error(ctx, "invalid comparation");
 			}
 		}
+		else
+		{
+			oberon_error(ctx, "wat");
+		}
 
 		oberon_autocast_binary_op(ctx, &a, &b);
 		result = ctx -> bool_type;