diff --git a/src/oberon.c b/src/oberon.c
index cefd46928194b60c17099c25211692000f067ff4..570db39df1417efe4ffde397dc3f600ab2cc9e22 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
LEQ,
GREAT,
GEQ,
+ IN,
+ IS,
PLUS,
MINUS,
OR,
{
ctx -> token = IMPORT;
}
+ else if(strcmp(ident, "IN") == 0)
+ {
+ ctx -> token = IN;
+ }
+ else if(strcmp(ident, "IS") == 0)
+ {
+ ctx -> token = IS;
+ }
}
static void
@@ -760,11 +770,7 @@ oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first,
static oberon_expr_t *
oberon_cast_expr(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref)
{
- oberon_expr_t * cast;
- cast = oberon_new_item(MODE_CAST, pref, expr -> read_only);
- cast -> item.parent = expr;
- cast -> next = expr -> next;
- return cast;
+ return oberon_new_operator(OP_CAST, pref, expr, NULL);
}
static oberon_expr_t *
@@ -893,25 +899,15 @@ oberon_autocast_binary_op(oberon_context_t * ctx, oberon_expr_t ** ea, oberon_ex
}
static void
-oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig)
+oberon_autocast_call(oberon_context_t * ctx, oberon_item_t * desig)
{
- if(desig -> is_item == 0)
- {
- oberon_error(ctx, "expected item");
- }
-
- if(desig -> item.mode != MODE_CALL)
+ if(desig -> mode != MODE_CALL)
{
oberon_error(ctx, "expected mode CALL");
}
- if(desig -> item.var -> type -> class != OBERON_TYPE_PROCEDURE)
- {
- oberon_error(ctx, "only procedures can be called");
- }
-
- oberon_type_t * fn = desig -> item.var -> type;
- int num_args = desig -> item.num_args;
+ oberon_type_t * fn = desig -> parent -> result;
+ int num_args = desig -> num_args;
int num_decl = fn -> num_decl;
if(num_args < num_decl)
/* Делаем проверку на запись и делаем автокаст */
oberon_expr_t * casted[num_args];
- oberon_expr_t * arg = desig -> item.args;
+ oberon_expr_t * arg = desig -> args;
oberon_object_t * param = fn -> decl;
for(int i = 0; i < num_args; i++)
{
{
casted[i] -> next = casted[i + 1];
}
- desig -> item.args = arg;
+ desig -> args = arg;
}
}
static oberon_expr_t *
-oberon_make_call_func(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args)
+oberon_make_call_func(oberon_context_t * ctx, oberon_item_t * item, int num_args, oberon_expr_t * list_args)
{
- switch(proc -> class)
+ oberon_type_t * signature = item -> result;
+ if(signature -> class != OBERON_TYPE_PROCEDURE)
{
- case OBERON_CLASS_PROC:
- if(proc -> class != OBERON_CLASS_PROC)
- {
- oberon_error(ctx, "not a procedure");
- }
- break;
- case OBERON_CLASS_VAR:
- case OBERON_CLASS_VAR_PARAM:
- case OBERON_CLASS_PARAM:
- if(proc -> type -> class != OBERON_TYPE_PROCEDURE)
- {
- oberon_error(ctx, "not a procedure");
- }
- break;
- default:
- oberon_error(ctx, "not a procedure");
- break;
+ oberon_error(ctx, "not a procedure");
}
oberon_expr_t * call;
- if(proc -> sysproc)
+ if(signature -> sysproc)
{
- if(proc -> genfunc == NULL)
+ if(signature -> genfunc == NULL)
{
oberon_error(ctx, "not a function-procedure");
}
- call = proc -> genfunc(ctx, num_args, list_args);
+ call = signature -> genfunc(ctx, num_args, list_args);
}
else
{
- if(proc -> type -> base -> class == OBERON_TYPE_VOID)
+ if(signature -> base -> class == OBERON_TYPE_VOID)
{
oberon_error(ctx, "attempt to call procedure in expression");
}
- call = oberon_new_item(MODE_CALL, proc -> type -> base, 1);
- call -> item.var = proc;
+ call = oberon_new_item(MODE_CALL, signature -> base, true);
+ call -> item.parent = item;
call -> item.num_args = num_args;
call -> item.args = list_args;
- oberon_autocast_call(ctx, call);
+ oberon_autocast_call(ctx, (oberon_item_t *) call);
}
return call;
}
+static void
+oberon_make_call_proc(oberon_context_t * ctx, oberon_item_t * item, int num_args, oberon_expr_t * list_args)
+{
+ oberon_type_t * signature = item -> result;
+ if(signature -> class != OBERON_TYPE_PROCEDURE)
+ {
+ oberon_error(ctx, "not a procedure");
+ }
+
+ oberon_expr_t * call;
+
+ if(signature -> sysproc)
+ {
+ if(signature -> genproc == NULL)
+ {
+ oberon_error(ctx, "not a procedure");
+ }
+
+ signature -> genproc(ctx, num_args, list_args);
+ }
+ else
+ {
+ if(signature -> base -> class != OBERON_TYPE_VOID)
+ {
+ oberon_error(ctx, "attempt to call function as non-typed procedure");
+ }
+
+ call = oberon_new_item(MODE_CALL, signature -> base, true);
+ call -> item.parent = item;
+ call -> item.num_args = num_args;
+ call -> item.args = list_args;
+ oberon_autocast_call(ctx, (oberon_item_t *) call);
+ oberon_generate_call_proc(ctx, call);
+ }
+}
+
+/*
static void
oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args)
{
@@ -1055,6 +1073,7 @@ oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_ar
oberon_generate_call_proc(ctx, call);
}
}
+*/
#define ISEXPR(x) \
(((x) == PLUS) \
oberon_expr_t * selector;
selector = oberon_new_item(MODE_DEREF, expr -> result -> base, expr -> read_only);
- selector -> item.parent = expr;
+ selector -> item.parent = (oberon_item_t *) expr;
return selector;
}
@@ -1125,7 +1144,7 @@ oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, oberon
oberon_expr_t * selector;
selector = oberon_new_item(MODE_INDEX, base, desig -> read_only);
- selector -> item.parent = desig;
+ selector -> item.parent = (oberon_item_t *) desig;
selector -> item.num_args = 1;
selector -> item.args = index;
@@ -1140,7 +1159,7 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char *
expr = oberno_make_dereferencing(ctx, expr);
}
- assert(expr -> is_item == 1);
+ assert(expr -> is_item);
if(expr -> result -> class != OBERON_TYPE_RECORD)
{
@@ -1172,7 +1191,7 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char *
oberon_expr_t * selector;
selector = oberon_new_item(MODE_FIELD, field -> type, read_only);
selector -> item.var = field;
- selector -> item.parent = expr;
+ selector -> item.parent = (oberon_item_t *) expr;
return selector;
}
}
expr -> item.var = var;
- while(ISSELECTOR(ctx -> token))
+ bool brk = false;
+ while(brk == false && ISSELECTOR(ctx -> token))
{
switch(ctx -> token)
{
expr = oberno_make_dereferencing(ctx, expr);
break;
case LPAREN:
+ if(expr -> result -> class == OBERON_TYPE_PROCEDURE)
+ {
+ brk = true;
+ break;
+ }
oberon_assert_token(ctx, LPAREN);
oberon_object_t * objtype = oberon_qualident(ctx, NULL, 1);
if(objtype -> class != OBERON_CLASS_TYPE)
oberon_expr_list(ctx, &num_args, &arguments, 0);
}
- expr = oberon_make_call_func(ctx, expr -> item.var, num_args, arguments);
+ expr = oberon_make_call_func(ctx, (oberon_item_t *) expr, num_args, arguments);
oberon_assert_token(ctx, RPAREN);
}
}
/* Вызов происходит даже без скобок */
- oberon_make_call_proc(ctx, expr -> item.var, num_args, arguments);
+ oberon_make_call_proc(ctx, (oberon_item_t *) expr, num_args, arguments);
}
static oberon_type_t *
}
#define ISRELATION(x) \
- ((x) >= EQUAL && (x) <= GEQ)
+ ((x) >= EQUAL && (x) <= IS)
static oberon_expr_t *
oberon_expr(oberon_context_t * ctx)
@@ -2870,10 +2895,10 @@ oberon_new_intrinsic(oberon_context_t * ctx, char * name, GenerateFuncCallback f
{
oberon_object_t * proc;
proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, true, false, false);
- proc -> sysproc = 1;
- proc -> genfunc = f;
- proc -> genproc = p;
proc -> type = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
+ proc -> type -> sysproc = true;
+ proc -> type -> genfunc = f;
+ proc -> type -> genproc = p;
}
static oberon_expr_t *