From: DeaDDooMER <deaddoomer@deadsoftware.ru>
Date: Mon, 24 Jul 2017 19:07:52 +0000 (+0300)
Subject: Добавлены процедуры и проверка результата в выражениях
X-Git-Url: https://deadsoftware.ru/gitweb?p=dsw-obn.git;a=commitdiff_plain;h=7f3e5aeb0348e6c0af28869bad6acc13fe483177

Добавлены процедуры и проверка результата в выражениях
---

diff --git a/oberon.c b/oberon.c
index ec4cab0..4403643 100644
--- a/oberon.c
+++ b/oberon.c
@@ -37,7 +37,8 @@ enum {
 	DIV,
 	MOD,
 	AND,
-	NOT
+	NOT,
+	PROCEDURE
 };
 
 // =======================================================================
@@ -59,46 +60,6 @@ oberon_error(oberon_context_t * ctx, const char * fmt, ...)
 	exit(1);
 }
 
-/*
-static int
-oberon_item_to_type_class(oberon_context_t * ctx, oberon_item_t * item)
-{
-	int class;
-
-	switch(item -> mode)
-	{
-		case MODE_INTEGER:
-			class = OBERON_TYPE_INTEGER;
-			break;
-		case MODE_BOOLEAN:
-			class = OBERON_TYPE_BOOLEAN;
-			break;
-		case MODE_VAR:
-			class = item -> var -> type -> class;
-			break;
-		default:
-			oberon_error(ctx, "oberon_item_to_type_class: wat");
-			break;
-	}
-
-	return class;
-}
-*/
-
-/*
-static void
-oberon_autocast_to(oberon_context_t * ctx, oberon_item_t * from, oberon_item_t * to)
-{
-	int from_class = oberon_item_to_type_class(ctx, from);
-	int to_class = oberon_item_to_type_class(ctx, to);
-
-	if(from_class != to_class)
-	{
-		oberon_error(ctx, "oberon_autocast_to: types not matched %i -> %i", from_class, to_class);
-	}
-}
-*/
-
 // =======================================================================
 //   TABLE
 // ======================================================================= 
@@ -228,6 +189,10 @@ oberon_read_ident(oberon_context_t * ctx)
 	{
 		ctx -> token = MOD;
 	}
+	else if(strcmp(ident, "PROCEDURE") == 0)
+	{
+		ctx -> token = PROCEDURE;
+	}
 }
 
 static void
@@ -414,9 +379,37 @@ oberon_new_item(int mode, oberon_type_t * result)
 }
 
 static oberon_expr_t *
-oberon_make_not(oberon_context_t * ctx, oberon_expr_t * expr)
+oberon_make_unary_op(oberon_context_t * ctx, int token, oberon_expr_t * a)
 {
-	return oberon_new_operator(OP_LOGIC_NOT, expr -> result, expr, NULL);
+	oberon_expr_t * expr;
+	oberon_type_t * result;
+
+	result = a -> result;
+
+	if(token == MINUS)
+	{
+		if(result -> class != OBERON_TYPE_INTEGER)
+		{
+			oberon_error(ctx, "incompatible operator type");
+		}
+
+		expr = oberon_new_operator(OP_UNARY_MINUS, result, a, NULL);
+	}
+	else if(token == NOT)
+	{
+		if(result -> class != OBERON_TYPE_BOOLEAN)
+		{
+			oberon_error(ctx, "incompatible operator type");
+		}
+
+		expr = oberon_new_operator(OP_LOGIC_NOT, result, a, NULL);
+	}
+	else
+	{
+		oberon_error(ctx, "oberon_make_unary_op: wat");
+	}
+
+	return expr;
 }
 
 static oberon_expr_t *
@@ -461,7 +454,7 @@ oberon_factor(oberon_context_t * ctx)
 		case NOT:
 			oberon_assert_token(ctx, NOT);
 			expr = oberon_factor(ctx);
-			expr = oberon_make_not(ctx, expr);
+			expr = oberon_make_unary_op(ctx, NOT, expr);
 			break;
 		default:
 			oberon_error(ctx, "invalid expression");
@@ -470,37 +463,144 @@ oberon_factor(oberon_context_t * ctx)
 	return expr;
 }
 
-static oberon_expr_t *
-oberon_make_mul_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_expr_t * b)
-{
-	oberon_expr_t * expr;
-	oberon_type_t * result;
-
-	result = a -> result;
+/*
+ * oberon_autocast_binary_op автоматически переобразовывеат тип по след. правилам:
+ *   1. Классы обоих типов должны быть одинаковы
+ *   2. В качестве результата должен быть выбран больший тип.
+ *   3. Если размер результат не должен быть меньше чем базовый int
+ */
 
-	if(token == STAR)
+static void
+oberon_autocast_binary_op(oberon_context_t * ctx, oberon_type_t * a, oberon_type_t * b, oberon_type_t ** result)
+{
+	if((a -> class) != (b -> class))
 	{
-		expr = oberon_new_operator(OP_MUL, result, a, b);
+		oberon_error(ctx, "incompatible types");
 	}
-	else if(token == SLASH)
+
+	if((a -> size) > (b -> size))
 	{
-		expr = oberon_new_operator(OP_DIV, result, a, b);
+		*result = a;
 	}
-	else if(token == DIV)
+	else
 	{
-		expr = oberon_new_operator(OP_DIV, result, a, b);
+		*result = b;
 	}
-	else if(token == MOD)
+
+	if(((*result) -> class) == OBERON_TYPE_INTEGER)
 	{
-		expr = oberon_new_operator(OP_MOD, result, a, b);
+		if(((*result) -> size) < (ctx -> int_type -> size))
+		{
+			*result = ctx -> int_type;
+		}
 	}
-	else if(token == AND)
+
+	/* TODO: cast types */
+}
+
+#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 oberon_expr_t *
+oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_expr_t * b)
+{
+	oberon_expr_t * expr;
+	oberon_type_t * result;
+
+	oberon_autocast_binary_op(ctx, a -> result, b -> result, &result);
+
+	if(ITMAKESBOOLEAN(token))
 	{
-		expr = oberon_new_operator(OP_LOGIC_AND, result, a, b);
+		if(ITUSEONLYINTEGER(token))
+		{
+			if(a -> result -> class != OBERON_TYPE_INTEGER
+				&& b -> result -> class != OBERON_TYPE_INTEGER)
+			{
+				oberon_error(ctx, "used only with integer types");
+			}
+		}
+		else if(ITUSEONLYBOOLEAN(token))
+		{
+			if(a -> result -> class != OBERON_TYPE_BOOLEAN
+				&& b -> result -> class != OBERON_TYPE_BOOLEAN)
+			{
+				oberon_error(ctx, "used only with boolean type");
+			}
+		}
+
+		if(token == EQUAL)
+		{
+			expr = oberon_new_operator(OP_EQ, result, a, b);
+		}
+		else if(token == NEQ)
+		{
+			expr = oberon_new_operator(OP_NEQ, result, a, b);
+		}
+		else if(token == LESS)
+		{
+			expr = oberon_new_operator(OP_LSS, result, a, b);
+		}
+		else if(token == LEQ)
+		{
+			expr = oberon_new_operator(OP_LEQ, result, a, b);
+		}
+		else if(token == GREAT)
+		{
+			expr = oberon_new_operator(OP_GRT, result, a, b);
+		}
+		else if(token == GEQ)
+		{
+			expr = oberon_new_operator(OP_GEQ, result, a, b);
+		}
+		else if(token == OR)
+		{
+			expr = oberon_new_operator(OP_LOGIC_OR, result, a, b);
+		}
+		else if(token == AND)
+		{
+			expr = oberon_new_operator(OP_LOGIC_AND, result, a, b);
+		}
+		else
+		{
+			oberon_error(ctx, "oberon_make_bin_op: bool wat");
+		}
 	}
 	else
 	{
-		oberon_error(ctx, "oberon_make_mul_op: wat");
+		if(token == PLUS)
+		{
+			expr = oberon_new_operator(OP_ADD, result, a, b);
+		}
+		else if(token == MINUS)
+		{
+			expr = oberon_new_operator(OP_SUB, result, a, b);
+		}
+		else if(token == STAR)
+		{
+			expr = oberon_new_operator(OP_MUL, result, a, b);
+		}
+		else if(token == SLASH)
+		{
+			expr = oberon_new_operator(OP_DIV, result, a, b);
+		}
+		else if(token == DIV)
+		{
+			expr = oberon_new_operator(OP_DIV, result, a, b);
+		}
+		else if(token == MOD)
+		{
+			expr = oberon_new_operator(OP_MOD, result, a, b);
+		}
+		else
+		{
+			oberon_error(ctx, "oberon_make_bin_op: bin wat");
+		}
 	}
 
 	return expr;
@@ -521,46 +621,12 @@ oberon_term_expr(oberon_context_t * ctx)
 		oberon_read_token(ctx);
 
 		oberon_expr_t * inter = oberon_factor(ctx);
-		expr = oberon_make_mul_op(ctx, token, expr, inter);
-	}
-
-	return expr;
-}
-
-static oberon_expr_t *
-oberon_make_add_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_expr_t * b)
-{
-	oberon_expr_t * expr;
-	oberon_type_t * result;
-
-	result = a -> result;
-
-	if(token == PLUS)
-	{
-		expr = oberon_new_operator(OP_ADD, result, a, b);
-	}
-	else if(token == MINUS)
-	{
-		expr = oberon_new_operator(OP_SUB, result, a, b);
-	}
-	else if(token == OR)
-	{
-		expr = oberon_new_operator(OP_LOGIC_OR, result, a, b);
-	}
-	else
-	{
-		oberon_error(ctx, "oberon_make_add_op: wat");
+		expr = oberon_make_bin_op(ctx, token, expr, inter);
 	}
 
 	return expr;
 }
 
-static oberon_expr_t *
-oberon_make_unary_minus(oberon_context_t * ctx, oberon_expr_t * expr)
-{
-	return oberon_new_operator(OP_UNARY_MINUS, expr -> result, expr, NULL);
-}
-
 #define ISADDOP(x) \
 	((x) >= PLUS && (x) <= OR)
 
@@ -588,57 +654,17 @@ oberon_simple_expr(oberon_context_t * ctx)
 		oberon_read_token(ctx);
 
 		oberon_expr_t * inter = oberon_term_expr(ctx);
-		expr = oberon_make_add_op(ctx, token, expr, inter);
+		expr = oberon_make_bin_op(ctx, token, expr, inter);
 	}
 
 	if(minus)
 	{
-		expr = oberon_make_unary_minus(ctx, expr);
+		expr = oberon_make_unary_op(ctx, MINUS, expr);
 	}
 
 	return expr;
 }
 
-static oberon_expr_t *
-oberon_make_relation(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_expr_t * b)
-{
-	oberon_expr_t * expr;
-	oberon_type_t * result;
-
-	result = a -> result;
-
-	if(token == EQUAL)
-	{
-		expr = oberon_new_operator(OP_EQ, result, a, b);
-	}
-	else if(token == NEQ)
-	{
-		expr = oberon_new_operator(OP_NEQ, result, a, b);
-	}
-	else if(token == LESS)
-	{
-		expr = oberon_new_operator(OP_LSS, result, a, b);
-	}
-	else if(token == LEQ)
-	{
-		expr = oberon_new_operator(OP_LEQ, result, a, b);
-	}
-	else if(token == GREAT)
-	{
-		expr = oberon_new_operator(OP_GRT, result, a, b);
-	}
-	else if(token == GEQ)
-	{
-		expr = oberon_new_operator(OP_GEQ, result, a, b);
-	}
-	else
-	{
-		oberon_error(ctx, "oberon_make_relation: wat");
-	}	
-
-	return expr;
-}
-
 #define ISRELATION(x) \
 	((x) >= EQUAL && (x) <= GEQ)
 
@@ -654,7 +680,7 @@ oberon_expr(oberon_context_t * ctx)
 		oberon_read_token(ctx);
 
 		oberon_expr_t * inter = oberon_simple_expr(ctx);
-		expr = oberon_make_relation(ctx, token, expr, inter);
+		expr = oberon_make_bin_op(ctx, token, expr, inter);
 	}
 
 	return expr;
@@ -664,6 +690,8 @@ oberon_expr(oberon_context_t * ctx)
 //   PARSER
 // =======================================================================
 
+static void oberon_statement_seq(oberon_context_t * ctx);
+
 static void
 oberon_expect_token(oberon_context_t * ctx, int token)
 {
@@ -712,6 +740,45 @@ oberon_var_decl(oberon_context_t * ctx)
 	oberon_define_var(ctx, name, type);
 }
 
+static void
+oberon_make_procedure_begin(oberon_context_t * ctx, char * name)
+{
+	
+}
+
+static void
+oberon_make_procedure_end(oberon_context_t * ctx)
+{
+
+}
+
+static void
+oberon_proc_decl(oberon_context_t * ctx)
+{
+	oberon_assert_token(ctx, PROCEDURE);
+
+	char * name;
+	name = oberon_assert_ident(ctx);
+
+	oberon_assert_token(ctx, SEMICOLON);
+
+	oberon_make_procedure_begin(ctx, name);
+	if(ctx -> token == BEGIN)
+	{
+		oberon_assert_token(ctx, BEGIN);
+		oberon_statement_seq(ctx);
+	}
+	oberon_make_procedure_end(ctx);
+
+	oberon_assert_token(ctx, END);
+	char * name2 = oberon_assert_ident(ctx);
+
+	if(strcmp(name2, name) != 0)
+	{
+		oberon_error(ctx, "procedure name not matched");
+	}
+}
+
 static void
 oberon_decl_seq(oberon_context_t * ctx)
 {
@@ -724,17 +791,29 @@ oberon_decl_seq(oberon_context_t * ctx)
 			oberon_assert_token(ctx, SEMICOLON);
 		}
 	}
+
+	if(ctx -> token == PROCEDURE)
+	{
+		oberon_proc_decl(ctx);
+		oberon_assert_token(ctx, SEMICOLON);
+	}
 }
 
 static void
 oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
 {
-//	if(dst -> mode == MODE_INTEGER)
-//	{
-//		oberon_error(ctx, "invalid assignment");
-//	}
-//
-//	oberon_autocast_to(ctx, src, dst);
+	if(src -> result -> class != dst -> result -> class)
+	{
+		oberon_error(ctx, "incompatible assignment types");
+	}
+
+	if(dst -> result -> class == OBERON_TYPE_INTEGER)
+	{
+		if((dst -> result -> size) < (src -> result -> size))
+		{
+			oberon_error(ctx, "incompatible assignment type size");
+		}
+	}
 
 	oberon_generate_assign(ctx, src, dst);
 }
diff --git a/oberon.h b/oberon.h
index 7ed1629..b2f0965 100644
--- a/oberon.h
+++ b/oberon.h
@@ -3,6 +3,7 @@
 
 typedef struct oberon_var_s oberon_var_t;
 typedef struct oberon_type_s oberon_type_t;
+typedef struct oberon_proc_s oberon_proc_t;
 typedef struct oberon_module_s oberon_module_t;
 typedef struct oberon_context_s oberon_context_t;
 
@@ -30,10 +31,21 @@ struct oberon_var_s
 	void * gen_var;
 };
 
+struct oberon_proc_s
+{
+	char * name;
+
+	oberon_proc_t * next;
+
+	void * gen_proc;
+};
+
 struct oberon_module_s
 {
 	char * name;
+
 	oberon_var_t * vars;
+	oberon_proc_t * procs;
 
 	void (* begin)();
 };
diff --git a/test.c b/test.c
index 0837de4..2bea391 100644
--- a/test.c
+++ b/test.c
@@ -7,10 +7,16 @@ static const char source[] =
 	"	k : INTEGER;"
 	"	i : INTEGER;"
 	"	b : BOOLEAN;"
+	""
+	"PROCEDURE Tier;"
 	"BEGIN"
-	"	k := -10 + 1;"
+	"	"
+	"END Tier;"
+	""
+	"BEGIN"
+	"	k := 1;"
 	"	i := k;"
-	"	b := ~TRUE OR FALSE;"
+	"	b := TRUE;"
 	"END Test."
 ;
 
@@ -22,6 +28,7 @@ main(int argc, char ** argv)
 {
 	ctx = oberon_create_context();
 	mod = oberon_compile_module(ctx, source);
+	//mod -> begin();
 	oberon_destroy_context(ctx);
 	return 0;
 }