X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=blobdiff_plain;f=oberon.c;h=b7ffd0ea73ab2b9cd366a04d96a2b1e16a80a94d;hp=dfed94a274ad3991d56ab8adf5223fabac446e38;hb=060a955ff58efde6cb51ab18eaed8f479e2550f3;hpb=338eeae16495bbdcbd8c4f3dad4996346e26139b

diff --git a/oberon.c b/oberon.c
index dfed94a..b7ffd0e 100644
--- a/oberon.c
+++ b/oberon.c
@@ -572,6 +572,7 @@ static oberon_expr_t * oberon_expr(oberon_context_t * ctx);
 static void oberon_assert_token(oberon_context_t * ctx, int token);
 static char * oberon_assert_ident(oberon_context_t * ctx);
 static void oberon_type(oberon_context_t * ctx, oberon_type_t ** type);
+static oberon_item_t * oberon_const_expr(oberon_context_t * ctx);
 
 static oberon_expr_t *
 oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon_expr_t * right)
@@ -638,7 +639,7 @@ oberon_make_unary_op(oberon_context_t * ctx, int token, oberon_expr_t * a)
 }
 
 static void
-oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first)
+oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first, int const_expr)
 {
 	oberon_expr_t * last;
 
@@ -648,7 +649,16 @@ oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first)
 	{
 		oberon_assert_token(ctx, COMMA);
 		oberon_expr_t * current;
-		current = oberon_expr(ctx);
+
+		if(const_expr)
+		{
+			current = (oberon_expr_t *) oberon_const_expr(ctx);
+		}
+		else
+		{
+			current = oberon_expr(ctx);
+		}
+
 		last -> next = current;
 		last = current;
 		*num_expr += 1;
@@ -663,7 +673,6 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t *
 		oberon_error(ctx, "incompatible types");
 	}
 
-
 	if(pref -> class == OBERON_TYPE_INTEGER)
 	{
 		if(expr -> result -> class > pref -> class)
@@ -679,6 +688,16 @@ oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t *
 			oberon_error(ctx, "incompatible record types");
 		}
 	}
+	else if(pref -> class == OBERON_TYPE_POINTER)
+	{
+		if(expr -> result -> base != pref -> base)
+		{
+			if(expr -> result -> base -> class != OBERON_TYPE_VOID)
+			{
+				oberon_error(ctx, "incompatible pointer types");
+			}
+		}
+	}
 
 	// TODO cast
 
@@ -754,7 +773,7 @@ oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr)
 }
 
 static oberon_expr_t *
-oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, int num_indexes, oberon_expr_t * indexes)
+oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, oberon_expr_t * index)
 {
 	if(desig -> result -> class == OBERON_TYPE_POINTER)
 	{
@@ -773,11 +792,30 @@ oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, int nu
 
 	// TODO check ranges
 
+	printf("oberon_make_array_selector: index class %i\n", index -> result -> class);
+	if(index -> result -> class != OBERON_TYPE_INTEGER)
+	{
+		oberon_error(ctx, "index must be integer");
+	}
+
+	if(index -> is_item)
+	{
+		if(index -> item.mode == MODE_INTEGER)
+		{
+			int arr_size = desig -> result -> size;
+			int index_int = index -> item.integer;
+			if(index_int < 0 || index_int > arr_size - 1)
+			{
+				oberon_error(ctx, "not in range (dimension size 0..%i)", arr_size - 1);
+			}
+		}
+	}
+
 	oberon_expr_t * selector;
 	selector = oberon_new_item(MODE_INDEX, base);
 	selector -> item.parent = (oberon_item_t *) desig;
-	selector -> item.num_args = num_indexes;
-	selector -> item.args = indexes;
+	selector -> item.num_args = 1;
+	selector -> item.args = index;
 
 	return selector;
 }
@@ -858,9 +896,14 @@ oberon_designator(oberon_context_t * ctx)
 				oberon_assert_token(ctx, LBRACE);
 				int num_indexes = 0;
 				oberon_expr_t * indexes = NULL;
-				oberon_expr_list(ctx, &num_indexes, &indexes);
+				oberon_expr_list(ctx, &num_indexes, &indexes, 0);
 				oberon_assert_token(ctx, RBRACE);
-				expr = oberon_make_array_selector(ctx, expr, num_indexes, indexes);
+
+				for(int i = 0; i < num_indexes; i++)
+				{
+					expr = oberon_make_array_selector(ctx, expr, indexes);
+					indexes = indexes -> next;
+				}
 				break;
 			case UPARROW:
 				oberon_assert_token(ctx, UPARROW);
@@ -893,7 +936,7 @@ oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr)
 
 		if(ISEXPR(ctx -> token))
 		{
-			oberon_expr_list(ctx, &num_args, &arguments);
+			oberon_expr_list(ctx, &num_args, &arguments, 0);
 		}
 
 		expr -> result = expr -> item.var -> type -> base;
@@ -1423,9 +1466,14 @@ oberon_const_decl(oberon_context_t * ctx)
 }
 
 static void
-oberon_make_array_type(oberon_context_t * ctx, oberon_item_t * size, oberon_type_t * base, oberon_type_t ** type)
+oberon_make_array_type(oberon_context_t * ctx, oberon_expr_t * size, oberon_type_t * base, oberon_type_t ** type)
 {
-	if(size -> mode != MODE_INTEGER)
+	if(size -> is_item == 0)
+	{
+		oberon_error(ctx, "requires constant");
+	}
+
+	if(size -> item.mode != MODE_INTEGER)
 	{
 		oberon_error(ctx, "requires integer constant");
 	}
@@ -1433,7 +1481,7 @@ oberon_make_array_type(oberon_context_t * ctx, oberon_item_t * size, oberon_type
 	oberon_type_t * arr;
 	arr = *type;
 	arr -> class = OBERON_TYPE_ARRAY;
-	arr -> size = size -> integer;
+	arr -> size = size -> item.integer;
 	arr -> base = base;
 }
 
@@ -1484,6 +1532,23 @@ static void oberon_opt_formal_pars(oberon_context_t * ctx, oberon_type_t ** type
  * Правило граматики "type". Указатель type должен указывать на существующий объект!
  */
 
+static void
+oberon_make_multiarray(oberon_context_t * ctx, oberon_expr_t * sizes, oberon_type_t * base, oberon_type_t ** type)
+{
+	if(sizes == NULL)
+	{
+		*type = base;
+		return;
+	}
+
+	oberon_type_t * dim;
+	dim = oberon_new_type_ptr(OBERON_TYPE_VOID);
+
+	oberon_make_multiarray(ctx, sizes -> next, base, &dim);
+
+	oberon_make_array_type(ctx, sizes, dim, type);
+}
+
 static void
 oberon_type(oberon_context_t * ctx, oberon_type_t ** type)
 {
@@ -1495,8 +1560,9 @@ oberon_type(oberon_context_t * ctx, oberon_type_t ** type)
 	{
 		oberon_assert_token(ctx, ARRAY);
 
-		oberon_item_t * size;
-		size = oberon_const_expr(ctx);
+		int num_sizes = 0;
+		oberon_expr_t * sizes;
+		oberon_expr_list(ctx, &num_sizes, &sizes, 1);
 
 		oberon_assert_token(ctx, OF);
 
@@ -1504,7 +1570,7 @@ oberon_type(oberon_context_t * ctx, oberon_type_t ** type)
 		base = oberon_new_type_ptr(OBERON_TYPE_VOID);
 		oberon_type(ctx, &base);
 
-		oberon_make_array_type(ctx, size, base, type);
+		oberon_make_multiarray(ctx, sizes, base, type);
 	}
 	else if(ctx -> token == RECORD)
 	{