DEADSOFTWARE

Добавлено расширение типа
authorDeaDDooMER <deaddoomer@deadsoftware.ru>
Tue, 1 Aug 2017 13:12:51 +0000 (16:12 +0300)
committerDeaDDooMER <deaddoomer@deadsoftware.ru>
Tue, 1 Aug 2017 13:12:51 +0000 (16:12 +0300)
notes
src/backends/jvm/generator-jvm.c
src/backends/jvm/generator-jvm.h
src/oberon-internals.h
src/oberon.c
src/test.c

diff --git a/notes b/notes
index 7092150dcbbcf53b3179614ba6ea19146adad7ac..b5807454b9f6849b23ed85054ec25bf24ce27f26 100644 (file)
--- a/notes
+++ b/notes
@@ -1,15 +1,11 @@
-- Какие-то проблемы с определением типов наперёд:
-  (*
-    TYPE
-    R2 = RECORD r : R1 END;
-    R1 = RECORD END;
-  *)
+- Нет оператора IS
+- Нет ручного каста записей
+- Нет автокаста записей
 - Нужно изменить передачу информации о вызываемой процедуре в MODE_CALL
    На данный момент конкретная процедура передаётся в поле var, вместо parent
    Что не позволяет делать процедуры-переменные в полях записей, массивах и т.д.
 
 - нет символов и строк
-- не реализовано расширение типа record
 - нету типа set
 
 - нету операторов if, while и т.д.
index 581faf92c302bab84ce601e5087eeb39e480d4ef..d99d1da62349514679fb9c298011c6c9fce099d1 100644 (file)
@@ -827,7 +827,16 @@ oberon_generate_record_class(gen_module_t * m, oberon_type_t * rec)
 
        fprintf(class -> fp, ".source %s\n", rec -> module -> name);
        fprintf(class -> fp, ".class  public %s\n", cname);
-       fprintf(class -> fp, ".super  java/lang/Object\n\n");
+
+       if(rec -> base == NULL)
+       {
+               fprintf(class -> fp, ".super  java/lang/Object\n\n");
+       }
+       else
+       {
+               class -> base = rec -> base -> gen_type -> class;
+               fprintf(class -> fp, ".super  %s\n\n", class -> base -> full_name);
+       }
 
        rec -> gen_type -> class = class;
 }
@@ -887,7 +896,14 @@ oberon_generator_init_record(oberon_context_t * ctx, oberon_type_t * rec)
        jvm_generate_function_header(p, "public", "<init>", "()V");
        jvm_alloc_register_untyped(p -> rf, false);
        jvm_generate(p, 0, 1, "aload_0");
-       jvm_generate(p, 1, 0, "invokespecial java/lang/Object/<init>()V");
+       if(class -> base)
+       {
+               jvm_generate(p, 1, 0, "invokespecial %s/<init>()V", class -> base -> full_name);
+       }
+       else
+       {
+               jvm_generate(p, 1, 0, "invokespecial java/lang/Object/<init>()V");
+       }
        num = rec -> num_decl;
        field = rec -> decl;
        for(int i = 0; i < num; i++)
index ad1b982a328113ba8a7a130db22c5a9389d6eaef..67abe236f652824352f3311ed9b27b50bbfe1fca 100644 (file)
@@ -22,6 +22,7 @@ struct gen_class
        char * full_name;
        FILE * fp;
        gen_proc_t * p;
+       struct gen_class * base;
 };
 
 enum gen_storage
index 5cfaa1313777e98eb45f8fac7a14406ac67cd6c5..1e92de1763923d410e342e0d21cb29ab68c2961e 100644 (file)
@@ -52,6 +52,7 @@ struct oberon_type_t
        int num_decl;
        oberon_type_t * base;
        oberon_object_t * decl;
+       oberon_scope_t * scope;
 
        oberon_module_t * module;
 
index 6a74f92c0aad16f6a3b13a6053e3e5b58e145fcc..0118ff9bfceded3989c464ed1a6f9fb59645a6be 100644 (file)
@@ -146,36 +146,6 @@ oberon_close_scope(oberon_scope_t * scope)
        ctx -> decl = scope -> up;
 }
 
-static oberon_object_t *
-oberon_define_object(oberon_scope_t * scope, char * name, int class, int export, int read_only)
-{
-       oberon_object_t * x = scope -> list;
-       while(x -> next && strcmp(x -> next -> name, name) != 0)
-       {
-               x = x -> next;
-       }
-
-       if(x -> next)
-       {
-               oberon_error(scope -> ctx, "already defined");
-       }
-
-       oberon_object_t * newvar = malloc(sizeof *newvar);
-       memset(newvar, 0, sizeof *newvar);
-       newvar -> name = name;
-       newvar -> class = class;
-       newvar -> export = export;
-       newvar -> read_only = read_only;
-       newvar -> local = scope -> local;
-       newvar -> parent = scope -> parent;
-       newvar -> parent_type = scope -> parent_type;
-       newvar -> module = scope -> ctx -> mod;
-
-       x -> next = newvar;
-
-       return newvar;
-}
-
 static oberon_object_t *
 oberon_find_object_in_list(oberon_object_t * list, char * name)
 {
@@ -188,7 +158,7 @@ oberon_find_object_in_list(oberon_object_t * list, char * name)
 }
 
 static oberon_object_t *
-oberon_find_object(oberon_scope_t * scope, char * name, int check_it)
+oberon_find_object(oberon_scope_t * scope, char * name, bool check_it)
 {
        oberon_object_t * result = NULL;
 
@@ -208,28 +178,48 @@ oberon_find_object(oberon_scope_t * scope, char * name, int check_it)
 }
 
 static oberon_object_t *
-oberon_find_field(oberon_context_t * ctx, oberon_type_t * rec, char * name)
+oberon_define_object(oberon_scope_t * scope, char * name, int class, bool export, bool read_only, bool check_upscope)
 {
-       oberon_object_t * x = rec -> decl;
-       for(int i = 0; i < rec -> num_decl; i++)
+       if(check_upscope)
        {
-               if(strcmp(x -> name, name) == 0)
+               if(oberon_find_object(scope -> up, name, false))
                {
-                       return x;
+                       oberon_error(scope -> ctx, "already defined");
                }
+       }
+
+       oberon_object_t * x = scope -> list;
+       while(x -> next && strcmp(x -> next -> name, name) != 0)
+       {
                x = x -> next;
        }
 
-       oberon_error(ctx, "field not defined");
+       if(x -> next)
+       {
+               oberon_error(scope -> ctx, "already defined");
+       }
+
+       oberon_object_t * newvar = malloc(sizeof *newvar);
+       memset(newvar, 0, sizeof *newvar);
+       newvar -> name = name;
+       newvar -> class = class;
+       newvar -> export = export;
+       newvar -> read_only = read_only;
+       newvar -> local = scope -> local;
+       newvar -> parent = scope -> parent;
+       newvar -> parent_type = scope -> parent_type;
+       newvar -> module = scope -> ctx -> mod;
+
+       x -> next = newvar;
 
-       return NULL;
+       return newvar;
 }
 
 static oberon_object_t *
 oberon_define_type(oberon_scope_t * scope, char * name, oberon_type_t * type, int export)
 {
        oberon_object_t * id;
-       id = oberon_define_object(scope, name, OBERON_CLASS_TYPE, export, 0);
+       id = oberon_define_object(scope, name, OBERON_CLASS_TYPE, export, false, false);
        id -> type = type;
        oberon_generator_init_type(scope -> ctx, type);
        return id;
@@ -1139,7 +1129,7 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char *
        oberon_type_t * rec = expr -> result;
 
        oberon_object_t * field;
-       field = oberon_find_field(ctx, rec, name);
+       field = oberon_find_object(rec -> scope, name, true);
 
        if(field -> export == 0)
        {
@@ -1697,7 +1687,7 @@ oberon_def(oberon_context_t * ctx, int * export, int * read_only)
 }
 
 static oberon_object_t *
-oberon_ident_def(oberon_context_t * ctx, int class)
+oberon_ident_def(oberon_context_t * ctx, int class, bool check_upscope)
 {
        char * name;
        int export;
@@ -1707,19 +1697,19 @@ oberon_ident_def(oberon_context_t * ctx, int class)
        name = oberon_assert_ident(ctx);
        oberon_def(ctx, &export, &read_only);
 
-       x = oberon_define_object(ctx -> decl, name, class, export, read_only);
+       x = oberon_define_object(ctx -> decl, name, class, export, read_only, check_upscope);
        return x;
 }
 
 static void
-oberon_ident_list(oberon_context_t * ctx, int class, int * num, oberon_object_t ** list)
+oberon_ident_list(oberon_context_t * ctx, int class, bool check_upscope, int * num, oberon_object_t ** list)
 {
        *num = 1;
-       *list = oberon_ident_def(ctx, class);
+       *list = oberon_ident_def(ctx, class, check_upscope);
        while(ctx -> token == COMMA)
        {
                oberon_assert_token(ctx, COMMA);
-               oberon_ident_def(ctx, class);
+               oberon_ident_def(ctx, class, check_upscope);
                *num += 1;
        }
 }
@@ -1732,7 +1722,7 @@ oberon_var_decl(oberon_context_t * ctx)
        oberon_type_t * type;
        type = oberon_new_type_ptr(OBERON_TYPE_VOID);
 
-       oberon_ident_list(ctx, OBERON_CLASS_VAR, &num, &list);
+       oberon_ident_list(ctx, OBERON_CLASS_VAR, false, &num, &list);
        oberon_assert_token(ctx, COLON);
        oberon_type(ctx, &type);
 
@@ -1756,7 +1746,7 @@ oberon_fp_section(oberon_context_t * ctx, int * num_decl)
 
        int num;
        oberon_object_t * list;
-       oberon_ident_list(ctx, class, &num, &list);
+       oberon_ident_list(ctx, class, false, &num, &list);
 
        oberon_assert_token(ctx, COLON);
 
@@ -1976,7 +1966,7 @@ oberon_proc_decl(oberon_context_t * ctx)
        }
        else
        {
-               proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, export, read_only);
+               proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, export, read_only, false);
                proc -> type = signature;
                proc -> scope = proc_scope;
                oberon_generator_init_proc(ctx, proc);
@@ -1997,7 +1987,7 @@ oberon_const_decl(oberon_context_t * ctx)
        oberon_item_t * value;
        oberon_object_t * constant;
 
-       constant = oberon_ident_def(ctx, OBERON_CLASS_CONST);
+       constant = oberon_ident_def(ctx, OBERON_CLASS_CONST, false);
        oberon_assert_token(ctx, EQUAL);
        value = oberon_const_expr(ctx);
        constant -> value = value;
@@ -2023,31 +2013,6 @@ oberon_make_array_type(oberon_context_t * ctx, oberon_expr_t * size, oberon_type
        arr -> base = base;
 }
 
-static void
-oberon_field_list(oberon_context_t * ctx, oberon_type_t * rec)
-{
-       if(ctx -> token == IDENT)
-       {
-               int num;
-               oberon_object_t * list;
-               oberon_type_t * type;
-               type = oberon_new_type_ptr(OBERON_TYPE_VOID);
-
-               oberon_ident_list(ctx, OBERON_CLASS_FIELD, &num, &list);
-               oberon_assert_token(ctx, COLON);
-               oberon_type(ctx, &type);
-
-               oberon_object_t * field = list;
-               for(int i = 0; i < num; i++)
-               {
-                       field -> type = type;
-                       field = field -> next;
-               }
-
-               rec -> num_decl += num;
-       }
-}
-
 static void
 oberon_qualident_type(oberon_context_t * ctx, oberon_type_t ** type)
 {
@@ -2068,7 +2033,7 @@ oberon_qualident_type(oberon_context_t * ctx, oberon_type_t ** type)
        }
        else
        {
-               to = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, 0, 0);
+               to = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, false, false, false);
                to -> type = oberon_new_type_ptr(OBERON_TYPE_VOID);
        }
 
@@ -2106,6 +2071,87 @@ oberon_make_open_array(oberon_context_t * ctx, oberon_type_t * base, oberon_type
        type -> base = base;
 }
 
+static void
+oberon_field_list(oberon_context_t * ctx, oberon_type_t * rec, oberon_scope_t * modscope)
+{
+       if(ctx -> token == IDENT)
+       {
+               int num;
+               oberon_object_t * list;
+               oberon_type_t * type;
+               type = oberon_new_type_ptr(OBERON_TYPE_VOID);
+
+               oberon_ident_list(ctx, OBERON_CLASS_FIELD, true, &num, &list);
+               oberon_assert_token(ctx, COLON);
+
+               oberon_scope_t * current = ctx -> decl;
+               ctx -> decl = modscope;
+               oberon_type(ctx, &type);
+               ctx -> decl = current;
+
+               oberon_object_t * field = list;
+               for(int i = 0; i < num; i++)
+               {
+                       field -> type = type;
+                       field = field -> next;
+               }
+
+               rec -> num_decl += num;
+       }
+}
+
+static void
+oberon_type_record_body(oberon_context_t * ctx, oberon_type_t * rec)
+{
+       oberon_scope_t * modscope = ctx -> mod -> decl; 
+       oberon_scope_t * oldscope = ctx -> decl;
+       ctx -> decl = modscope;
+
+       if(ctx -> token == LPAREN)
+       {
+               oberon_assert_token(ctx, LPAREN);
+
+               oberon_object_t * typeobj;
+               typeobj = oberon_qualident(ctx, NULL, true);
+
+               if(typeobj -> class != OBERON_CLASS_TYPE)
+               {
+                       oberon_error(ctx, "base must be type");
+               }
+
+               if(typeobj -> type -> class != OBERON_TYPE_RECORD)
+               {
+                       oberon_error(ctx, "base must be record type");
+               }
+
+               rec -> base = typeobj -> type;
+               ctx -> decl = rec -> base -> scope;
+
+               oberon_assert_token(ctx, RPAREN);
+       }
+       else
+       {
+               ctx -> decl = NULL;
+       }
+
+       oberon_scope_t * this_scope;
+       this_scope = oberon_open_scope(ctx);
+       this_scope -> local = true;
+       this_scope -> parent = NULL;
+       this_scope -> parent_type = rec;
+
+       oberon_field_list(ctx, rec, modscope);
+       while(ctx -> token == SEMICOLON)
+       {
+               oberon_assert_token(ctx, SEMICOLON);
+               oberon_field_list(ctx, rec, modscope);
+       }
+
+       rec -> scope = this_scope;
+       rec -> decl = this_scope -> list -> next;
+       ctx -> decl = oldscope;
+}
+
 static void
 oberon_type(oberon_context_t * ctx, oberon_type_t ** type)
 {
@@ -2147,24 +2193,10 @@ oberon_type(oberon_context_t * ctx, oberon_type_t ** type)
                rec -> class = OBERON_TYPE_RECORD;
                rec -> module = ctx -> mod;
 
-               oberon_scope_t * record_scope;
-               record_scope = oberon_open_scope(ctx);
-               record_scope -> local = 1;
-               record_scope -> parent = NULL;
-               record_scope -> parent_type = rec;
-
                oberon_assert_token(ctx, RECORD);
-               oberon_field_list(ctx, rec);
-               while(ctx -> token == SEMICOLON)
-               {
-                       oberon_assert_token(ctx, SEMICOLON);
-                       oberon_field_list(ctx, rec);
-               }
+               oberon_type_record_body(ctx, rec);
                oberon_assert_token(ctx, END);
 
-               rec -> decl = record_scope -> list -> next;
-               oberon_close_scope(record_scope);
-
                *type = rec;
        }
        else if(ctx -> token == POINTER)
@@ -2209,7 +2241,7 @@ oberon_type_decl(oberon_context_t * ctx)
        newtype = oberon_find_object(ctx -> decl, name, 0);
        if(newtype == NULL)
        {
-               newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, export, read_only);
+               newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, export, read_only, false);
                newtype -> type = oberon_new_type_ptr(OBERON_TYPE_VOID);
                assert(newtype -> type);
        }
@@ -2689,7 +2721,7 @@ oberon_import_module(oberon_context_t * ctx, char * alias, char * name)
        }
 
        oberon_object_t * ident;
-       ident = oberon_define_object(ctx -> decl, alias, OBERON_CLASS_MODULE, 0, 0);
+       ident = oberon_define_object(ctx -> decl, alias, OBERON_CLASS_MODULE, false, false, false);
        ident -> module = m;
 }
 
@@ -2805,7 +2837,7 @@ static void
 oberon_new_intrinsic(oberon_context_t * ctx, char * name, GenerateFuncCallback f, GenerateProcCallback p)
 {
        oberon_object_t * proc;
-       proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, 1, 0);
+       proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, true, false, false);
        proc -> sysproc = 1;
        proc -> genfunc = f;
        proc -> genproc = p;
index 9fad93d4461223fcc752d5a79e48261711e9709d..6a08bce11b82d1454ec2538a53e6e63d426debfa 100644 (file)
@@ -8,26 +8,21 @@ static char source_test[] =
        "(* Main module *)"
        "MODULE Test;"
        "IMPORT Out;"
+       "TYPE"
+       "  Baser = RECORD a : INTEGER; END;"
+       "  R1 = RECORD (Baser)"
+       "    b : R2;"
+       "  END;"
+       "  "
+       "  R2 = RECORD"
+       "    a : POINTER TO R1;"
+       "  END;"
        ""
        "VAR"
-       "  byte     : BYTE;"
-       "  short    : SHORTINT;"
-       "  int      : INTEGER;"
-       "  long     : LONGINT;"
-       "  real     : REAL;"
-       "  longreal : LONGREAL;"
+       "  r : R1;"
        ""
        "BEGIN"
-       "  Out.Open;"
-       "  byte := 127;"
-       "  int := 666 DIV 2;"
-       "  long := int;"
-       "  real := (4 / 1) - (4 / 3) + (4 / 5) - (4 / 7) + (4 / 9) - (4 / 11) + (4 / 13) - (4 / 15) + (4 / 17);"
-       "  longreal := (4 / 1) - (4 / 3) + (4 / 5) - (4 / 7) + (4 / 9) - (4 / 11) + (4 / 13) - (4 / 15) + (4 / 17);"
-       "  Out.Int(666, 0); Out.Ln;"
-       "  Out.Int(byte, 0); Out.Ln;"
-       "  Out.Real(real, 0); Out.Ln;"
-       "  Out.LongReal(longreal, 0); Out.Ln;"
+       "  r.a := 1;"
        "END Test."
 ;