diff --git a/oberon.c b/oberon.c
index 65803c0d7eaf5924fdc96b42858b0eb3834c016d..2b4e09f5e8a3ca7e95e4923a6d4773fa9e5202bf 100644 (file)
--- a/oberon.c
+++ b/oberon.c
OF,
LBRACE,
RBRACE,
+ RECORD
};
// =======================================================================
return newvar;
}
+static void
+oberon_define_field(oberon_context_t * ctx, oberon_type_t * rec, char * name, oberon_type_t * type)
+{
+ oberon_object_t * x = rec -> decl;
+ while(x -> next && strcmp(x -> next -> name, name) != 0)
+ {
+ x = x -> next;
+ }
+
+ if(x -> next)
+ {
+ oberon_error(ctx, "multiple definition");
+ }
+
+ oberon_object_t * field = malloc(sizeof *field);
+ memset(field, 0, sizeof *field);
+ field -> name = name;
+ field -> class = OBERON_CLASS_FIELD;
+ field -> type = type;
+
+ rec -> num_decl += 1;
+ oberon_generator_init_var(ctx, field);
+
+ x -> next = field;
+}
+
static oberon_object_t *
oberon_find_object_in_list(oberon_object_t * list, char * name)
{
return result;
}
+static oberon_object_t *
+oberon_find_field(oberon_context_t * ctx, oberon_type_t * rec, char * name)
+{
+ oberon_object_t * x = rec -> decl;
+ for(int i = 0; i < rec -> num_decl; i++)
+ {
+ if(strcmp(x -> name, name) == 0)
+ {
+ return x;
+ }
+ x = x -> next;
+ }
+
+ oberon_error(ctx, "field not defined");
+
+ return NULL;
+}
+
static oberon_object_t *
oberon_define_type(oberon_scope_t * scope, char * name, oberon_type_t * type)
{
{
ctx -> token = OF;
}
+ else if(strcmp(ident, "RECORD") == 0)
+ {
+ ctx -> token = RECORD;
+ }
}
static void
@@ -591,11 +640,12 @@ oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first)
static oberon_expr_t *
oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref)
{
- if(expr -> result -> class != pref -> class)
+ if(pref -> class != expr -> result -> class)
{
oberon_error(ctx, "incompatible types");
}
+
if(pref -> class == OBERON_TYPE_INTEGER)
{
if(expr -> result -> class > pref -> class)
|| ((x) == TRUE) \
|| ((x) == FALSE))
+#define ISSELECTOR(x) \
+ (((x) == LBRACE) \
+ || ((x) == DOT))
+
+static oberon_expr_t *
+oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, int num_indexes, oberon_expr_t * indexes)
+{
+ assert(desig -> is_item == 1);
+
+ if(desig -> item.mode != MODE_VAR)
+ {
+ oberon_error(ctx, "not MODE_VAR");
+ }
+
+ int class = desig -> item.var -> class;
+ switch(class)
+ {
+ case OBERON_CLASS_VAR:
+ case OBERON_CLASS_VAR_PARAM:
+ case OBERON_CLASS_PARAM:
+ break;
+ default:
+ oberon_error(ctx, "not variable");
+ break;
+ }
+
+ oberon_type_t * type = desig -> item.var -> type;
+ if(type -> class != OBERON_TYPE_ARRAY)
+ {
+ oberon_error(ctx, "not array");
+ }
+
+ int dim = desig -> item.var -> type -> dim;
+ if(num_indexes != dim)
+ {
+ oberon_error(ctx, "dimesions not matched");
+ }
+
+ oberon_type_t * base = desig -> item.var -> type -> base;
+
+ 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;
+
+ return selector;
+}
+
+static oberon_expr_t *
+oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char * name)
+{
+ assert(expr -> is_item == 1);
+
+ int class = expr -> result -> class;
+ if(class != OBERON_TYPE_RECORD)
+ {
+ oberon_error(ctx, "not record");
+ }
+
+ oberon_type_t * rec = expr -> result;
+
+ oberon_object_t * field;
+ field = oberon_find_field(ctx, rec, name);
+
+ oberon_expr_t * selector;
+ selector = oberon_new_item(MODE_FIELD, field -> type);
+ selector -> item.var = field;
+ selector -> item.parent = (oberon_item_t *) expr;
+
+ return selector;
+}
+
static oberon_expr_t *
oberon_designator(oberon_context_t * ctx)
{
oberon_error(ctx, "invalid designator");
break;
}
-
expr -> item.var = var;
+
+ while(ISSELECTOR(ctx -> token))
+ {
+ switch(ctx -> token)
+ {
+ case DOT:
+ oberon_assert_token(ctx, DOT);
+ name = oberon_assert_ident(ctx);
+ expr = oberon_make_record_selector(ctx, expr, name);
+ break;
+ case LBRACE:
+ oberon_assert_token(ctx, LBRACE);
+ int num_indexes = 0;
+ oberon_expr_t * indexes = NULL;
+ oberon_expr_list(ctx, &num_indexes, &indexes);
+ oberon_assert_token(ctx, RBRACE);
+ expr = oberon_make_array_selector(ctx, expr, num_indexes, indexes);
+ break;
+ default:
+ oberon_error(ctx, "oberon_designator: wat");
+ break;
+ }
+ }
return expr;
}
oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr)
{
assert(expr -> is_item == 1);
+
if(ctx -> token == LPAREN)
{
+ if(expr -> result -> class != OBERON_TYPE_PROCEDURE)
+ {
+ oberon_error(ctx, "not a procedure");
+ }
+
oberon_assert_token(ctx, LPAREN);
int num_args = 0;
@@ -1054,6 +1205,22 @@ oberon_make_array_type(oberon_context_t * ctx, int dim, oberon_item_t * size, ob
return newtype;
}
+static void
+oberon_field_list(oberon_context_t * ctx, oberon_type_t * rec)
+{
+ if(ctx -> token == IDENT)
+ {
+ char * name;
+ oberon_type_t * type;
+ name = oberon_assert_ident(ctx);
+ oberon_assert_token(ctx, COLON);
+ type = oberon_type(ctx);
+ oberon_define_field(ctx, rec, name, type);
+ }
+}
+
+static oberon_type_t * oberon_opt_formal_pars(oberon_context_t * ctx, int class);
+
static oberon_type_t *
oberon_type(oberon_context_t * ctx)
{
oberon_type_t * base = oberon_type(ctx);
type = oberon_make_array_type(ctx, 1, size, base);
}
+ else if(ctx -> token == RECORD)
+ {
+ type = oberon_new_type_ptr(OBERON_TYPE_RECORD);
+ oberon_object_t * list = malloc(sizeof *list);
+ memset(list, 0, sizeof *list);
+ type -> num_decl = 0;
+ type -> base = NULL;
+ type -> decl = list;
+
+ oberon_assert_token(ctx, RECORD);
+ oberon_field_list(ctx, type);
+ while(ctx -> token == SEMICOLON)
+ {
+ oberon_assert_token(ctx, SEMICOLON);
+ oberon_field_list(ctx, type);
+ }
+ oberon_assert_token(ctx, END);
+
+ type -> decl = type -> decl -> next;
+ oberon_generator_init_type(ctx, type);
+ }
+ else if(ctx -> token == PROCEDURE)
+ {
+ oberon_assert_token(ctx, PROCEDURE);
+ type = oberon_opt_formal_pars(ctx, OBERON_TYPE_PROCEDURE);
+ }
else
{
oberon_error(ctx, "invalid type declaration");
return tp;
}
+static oberon_type_t *
+oberon_opt_formal_pars(oberon_context_t * ctx, int class)
+{
+ oberon_type_t * signature;
+
+ if(ctx -> token == LPAREN)
+ {
+ signature = oberon_formal_pars(ctx);
+ }
+ else
+ {
+ signature = oberon_new_type_ptr(class);
+ signature -> num_decl = 0;
+ signature -> base = ctx -> void_type;
+ signature -> decl = NULL;
+ oberon_generator_init_type(ctx, signature);
+ }
+
+ return signature;
+}
+
static void
oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr)
{
oberon_open_scope(ctx);
oberon_type_t * signature;
- if(ctx -> token == LPAREN)
- {
- signature = oberon_formal_pars(ctx);
- }
- else
- {
- signature = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
- signature -> num_decl = 0;
- signature -> base = ctx -> void_type;
- signature -> decl = NULL;
- oberon_generator_init_type(ctx, signature);
- }
+ signature = oberon_opt_formal_pars(ctx, OBERON_TYPE_PROCEDURE);
oberon_object_t * proc;
proc = oberon_define_proc(this_proc_def_scope, name, signature);