diff --git a/oberon.c b/oberon.c
index dfed94a274ad3991d56ab8adf5223fabac446e38..b7ffd0ea73ab2b9cd366a04d96a2b1e16a80a94d 100644 (file)
--- a/oberon.c
+++ b/oberon.c
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)
}
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
}
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;
}
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);
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;
}
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)
{
{
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);
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)
{