From: DeaDDooMER Date: Fri, 4 Aug 2017 15:09:26 +0000 (+0300) Subject: Добавлен тип SET X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=commitdiff_plain;h=9bcd389a97869b2ab6b1c6fdc35c0f09beab66c5 Добавлен тип SET --- diff --git a/notes b/notes index 23e0d23..29121d6 100644 --- a/notes +++ b/notes @@ -1,11 +1,12 @@ -- Нет типа SET +- Нет оператора IN - Нет конструкции CASE - Нет конструкции WITH + - Нет модуля SYSTEM - Нет функций ASH CAP CHR ENTIER LEN LONG ODD ORD SHORT - Нет процедур ASSERT COPY DEC EXCL HALT INC INCL +- Нет счёта строк / столбцов - Не реализована свёртка констант -- Не счёта строк / столбцов - JVM: Не реализованы VAR-параметры. - JVM: Не реализованы локальные процедуры. diff --git a/src/backends/jvm/generator-jvm-basic.c b/src/backends/jvm/generator-jvm-basic.c index 44046a1..bcd82a2 100644 --- a/src/backends/jvm/generator-jvm-basic.c +++ b/src/backends/jvm/generator-jvm-basic.c @@ -57,6 +57,7 @@ jvm_get_descriptor(oberon_type_t * type) return new_string("V"); break; case OBERON_TYPE_INTEGER: + case OBERON_TYPE_SET: switch(type -> size) { case 1: @@ -165,6 +166,7 @@ jvm_get_prefix(oberon_type_t * type) case OBERON_TYPE_BOOLEAN: case OBERON_TYPE_INTEGER: case OBERON_TYPE_CHAR: + case OBERON_TYPE_SET: return (size <= 4) ? ('i') : ('l'); break; case OBERON_TYPE_PROCEDURE: @@ -193,6 +195,7 @@ jvm_get_postfix(oberon_type_t * type) return 'b'; break; case OBERON_TYPE_INTEGER: + case OBERON_TYPE_SET: switch(size) { case 1: @@ -358,7 +361,9 @@ int jvm_cell_size_for_type(oberon_type_t * type) { if(type -> class == OBERON_TYPE_INTEGER - || type -> class == OBERON_TYPE_REAL) + || type -> class == OBERON_TYPE_REAL + || type -> class == OBERON_TYPE_CHAR + || type -> class == OBERON_TYPE_SET) { if(type -> size > 4) { diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c index e6a26bd..fe8bc00 100644 --- a/src/backends/jvm/generator-jvm.c +++ b/src/backends/jvm/generator-jvm.c @@ -885,6 +885,7 @@ oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type) case OBERON_TYPE_REAL: case OBERON_TYPE_CHAR: case OBERON_TYPE_STRING: + case OBERON_TYPE_SET: break; case OBERON_TYPE_RECORD: ; @@ -1472,6 +1473,7 @@ push_item(gen_proc_t * p, oberon_item_t * item) break; case MODE_INTEGER: case MODE_CHAR: + case MODE_SET: jvm_generate_push_int_size(p, item -> integer, item -> result -> size); break; case MODE_BOOLEAN: @@ -1613,16 +1615,17 @@ jvm_generate_compare_op(gen_proc_t * p, oberon_type_t * t, int op) } static void -jvm_generate_operator(gen_proc_t * p, oberon_type_t * t, char prefix, int op) +jvm_generate_operator(gen_proc_t * p, oberon_type_t * t, int op) { - int cell_size = jvm_cell_size_for_postfix(prefix); + char prefix = jvm_get_prefix(t); + int cell_size = jvm_cell_size_for_type(t); switch(op) { case OP_UNARY_MINUS: jvm_generate(p, cell_size, cell_size, "%cneg", prefix); break; - case OP_BITWISE_NOT: - jvm_generate_push_int(p, -1); + case OP_COMPLEMENTATION: + jvm_generate_push_int_size(p, -1, t -> size); jvm_generate(p, 2 * cell_size, cell_size, "%cxor", prefix); break; case OP_LOGIC_NOT: @@ -1647,14 +1650,19 @@ jvm_generate_operator(gen_proc_t * p, oberon_type_t * t, char prefix, int op) case OP_MOD: jvm_generate(p, 2 * cell_size, cell_size, "%crem", prefix); break; - case OP_BITWISE_AND: + case OP_UNION: + jvm_generate(p, 2 * cell_size, cell_size, "%cor", prefix); + break; + case OP_INTERSECTION: jvm_generate(p, 2 * cell_size, cell_size, "%cand", prefix); break; - case OP_BITWISE_XOR: + case OP_DIFFERENCE: + jvm_generate_push_int_size(p, -1, t -> size); jvm_generate(p, 2 * cell_size, cell_size, "%cxor", prefix); + jvm_generate(p, 2 * cell_size, cell_size, "%cand", prefix); break; - case OP_BITWISE_OR: - jvm_generate(p, 2 * cell_size, cell_size, "%cor", prefix); + case OP_SYM_DIFFERENCE: + jvm_generate(p, 2 * cell_size, cell_size, "%cxor", prefix); break; case OP_EQ: @@ -1709,11 +1717,71 @@ jvm_generate_logical_and(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b) jvm_generate_label(p, label_done); } +static void +jvm_generate_range(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b) +{ + /* { a } == 1 << a */ + /* { a..b } == (a <= b) ? ((2 << b) - (1 << a)) : (0); */ + + char prefix; + int cell_size; + oberon_type_t * t; + gen_var_t * ra; + gen_var_t * rb; + int label_else; + int label_end; + bool wide; + + t = a -> result; + cell_size = jvm_cell_size_for_type(t); + prefix = jvm_get_prefix(t); + + if(b == NULL) + { + jvm_generate_push_int_size(p, 1, t -> size); + push_expr(p, a); + jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix); + } + else + { + wide = jvm_is_wide_type(t); + ra = oberon_generator_new_var(); + rb = oberon_generator_new_var(); + jvm_generate_and_init_local_var(ra, p, wide); + jvm_generate_and_init_local_var(rb, p, wide); + label_else = jvm_new_label_id(p); + label_end = jvm_new_label_id(p); + + push_expr(p, a); + jvm_generate_store(p, t, ra); + push_expr(p, b); + jvm_generate_store(p, t, rb); + + jvm_generate_load(p, t, ra); + jvm_generate_load(p, t, rb); + jvm_generate(p, 2 * cell_size, 0, "if_%ccmpgt L%i", prefix, label_else); + + jvm_generate_push_int_size(p, 2, t -> size); + jvm_generate_load(p, t, rb); + jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix); + jvm_generate_push_int_size(p, 2, t -> size); + jvm_generate_load(p, t, ra); + jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix); + jvm_generate(p, 2 * cell_size, cell_size, "%csub", prefix); + jvm_generate(p, 0, 0, "goto L%i", label_end); + + jvm_generate_label(p, label_else); + jvm_generate_push_int_size(p, 0, t -> size); + jvm_generate_label(p, label_end); + } + + /* TODO free registers */ +} + static void push_operator(gen_proc_t * p, oberon_oper_t * oper) { oberon_type_t * preq = oper -> left -> result; - char prefix = jvm_get_prefix(oper -> result); int op = oper -> op; switch(op) { @@ -1721,12 +1789,12 @@ push_operator(gen_proc_t * p, oberon_oper_t * oper) push_expr(p, oper -> left); jvm_generate_cast_type(p, oper -> left -> result, oper -> result); break; + case OP_COMPLEMENTATION: case OP_UNARY_MINUS: - case OP_BITWISE_NOT: case OP_LOGIC_NOT: case OP_ABS: push_expr(p, oper -> left); - jvm_generate_operator(p, preq, prefix, op); + jvm_generate_operator(p, preq, op); break; case OP_ADD: @@ -1734,9 +1802,11 @@ push_operator(gen_proc_t * p, oberon_oper_t * oper) case OP_MUL: case OP_DIV: case OP_MOD: - case OP_BITWISE_AND: - case OP_BITWISE_XOR: - case OP_BITWISE_OR: + + case OP_UNION: + case OP_INTERSECTION: + case OP_DIFFERENCE: + case OP_SYM_DIFFERENCE: case OP_EQ: case OP_NEQ: @@ -1746,7 +1816,7 @@ push_operator(gen_proc_t * p, oberon_oper_t * oper) case OP_GEQ: push_expr(p, oper -> left); push_expr(p, oper -> right); - jvm_generate_operator(p, preq, prefix, op); + jvm_generate_operator(p, preq, op); break; case OP_LOGIC_OR: @@ -1762,6 +1832,9 @@ push_operator(gen_proc_t * p, oberon_oper_t * oper) push_expr(p, oper -> left); jvm_generate(p, 1, 1, "instanceof %s", cname); break; + case OP_RANGE: + jvm_generate_range(p, oper -> left, oper -> right); + break; default: gen_error("push_oper: unk op %i", op); break; diff --git a/src/oberon-internals.h b/src/oberon-internals.h index 5dd3582..96fd166 100644 --- a/src/oberon-internals.h +++ b/src/oberon-internals.h @@ -45,7 +45,8 @@ enum oberon_type_kind OBERON_TYPE_POINTER, OBERON_TYPE_REAL, OBERON_TYPE_CHAR, - OBERON_TYPE_STRING + OBERON_TYPE_STRING, + OBERON_TYPE_SET }; typedef oberon_expr_t * (*GenerateFuncCallback)(oberon_context_t *, int, oberon_expr_t *); @@ -155,6 +156,7 @@ struct oberon_context_t oberon_type_t * longreal_type; oberon_type_t * char_type; oberon_type_t * string_type; + oberon_type_t * set_type; oberon_scope_t * world_scope; oberon_module_t * module_list; @@ -176,13 +178,13 @@ enum oberon_mode_kind MODE_REAL, MODE_CHAR, MODE_STRING, - MODE_TYPE + MODE_TYPE, + MODE_SET }; enum oberon_operator_kind { OP_UNARY_MINUS, - OP_BITWISE_NOT, OP_LOGIC_NOT, OP_ABS, @@ -191,9 +193,6 @@ enum oberon_operator_kind OP_MUL, OP_DIV, OP_MOD, - OP_BITWISE_AND, - OP_BITWISE_XOR, - OP_BITWISE_OR, OP_LOGIC_AND, OP_LOGIC_OR, @@ -205,7 +204,14 @@ enum oberon_operator_kind OP_GEQ, OP_CAST, - OP_IS + OP_IS, + + OP_RANGE, + OP_UNION, + OP_INTERSECTION, + OP_DIFFERENCE, + OP_SYM_DIFFERENCE, + OP_COMPLEMENTATION }; struct oberon_item_t diff --git a/src/oberon.c b/src/oberon.c index e88ff79..5042964 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -52,8 +52,8 @@ enum { TYPE, ARRAY, OF, - LBRACE, - RBRACE, + LBRACK, + RBRACK, RECORD, POINTER, TO, @@ -74,7 +74,10 @@ enum { FOR, BY, LOOP, - EXIT + EXIT, + LBRACE, + RBRACE, + DOTDOT }; // ======================================================================= @@ -149,6 +152,15 @@ oberon_new_type_string(int size) return x; } +static oberon_type_t * +oberon_new_type_set(int size) +{ + oberon_type_t * x; + x = oberon_new_type_ptr(OBERON_TYPE_SET); + x -> size = size; + return x; +} + // ======================================================================= // TABLE // ======================================================================= @@ -505,37 +517,43 @@ oberon_read_number(oberon_context_t * ctx) } else if(ctx -> c == '.') { - mode = 2; oberon_get_char(ctx); - - while(isdigit(ctx -> c)) + if(ctx -> c == '.') { - oberon_get_char(ctx); + /* Чит: избегаем конфликта с DOTDOT */ + ctx -> code_index -= 1; } - - if(ctx -> c == 'E' || ctx -> c == 'D') + else { - exp_i = ctx -> code_index; - - if(ctx -> c == 'D') - { - mode = 3; - } - - oberon_get_char(ctx); + mode = 2; - if(ctx -> c == '+' || ctx -> c == '-') + while(isdigit(ctx -> c)) { oberon_get_char(ctx); } - while(isdigit(ctx -> c)) + if(ctx -> c == 'E' || ctx -> c == 'D') { + exp_i = ctx -> code_index; + + if(ctx -> c == 'D') + { + mode = 3; + } + oberon_get_char(ctx); - } - } + if(ctx -> c == '+' || ctx -> c == '-') + { + oberon_get_char(ctx); + } + while(isdigit(ctx -> c)) + { + oberon_get_char(ctx); + } + } + } end_i = ctx -> code_index; } @@ -699,6 +717,11 @@ oberon_read_symbol(oberon_context_t * ctx) case '.': ctx -> token = DOT; oberon_get_char(ctx); + if(ctx -> c == '.') + { + ctx -> token = DOTDOT; + oberon_get_char(ctx); + } break; case '(': ctx -> token = LPAREN; @@ -774,11 +797,11 @@ oberon_read_symbol(oberon_context_t * ctx) oberon_get_char(ctx); break; case '[': - ctx -> token = LBRACE; + ctx -> token = LBRACK; oberon_get_char(ctx); break; case ']': - ctx -> token = RBRACE; + ctx -> token = RBRACK; oberon_get_char(ctx); break; case '^': @@ -791,6 +814,14 @@ oberon_read_symbol(oberon_context_t * ctx) case '\'': oberon_read_string(ctx); break; + case '{': + ctx -> token = LBRACE; + oberon_get_char(ctx); + break; + case '}': + ctx -> token = RBRACE; + oberon_get_char(ctx); + break; default: oberon_error(ctx, "invalid char %c", ctx -> c); break; @@ -871,12 +902,18 @@ oberon_make_unary_op(oberon_context_t * ctx, int token, oberon_expr_t * a) if(token == MINUS) { - if(result -> class != OBERON_TYPE_INTEGER) + if(result -> class == OBERON_TYPE_SET) + { + expr = oberon_new_operator(OP_COMPLEMENTATION, result, a, NULL); + } + else if(result -> class == OBERON_TYPE_INTEGER) + { + expr = oberon_new_operator(OP_UNARY_MINUS, result, a, NULL); + } + else { oberon_error(ctx, "incompatible operator type"); } - - expr = oberon_new_operator(OP_UNARY_MINUS, result, a, NULL); } else if(token == NOT) { @@ -1394,7 +1431,7 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char * } #define ISSELECTOR(x) \ - (((x) == LBRACE) \ + (((x) == LBRACK) \ || ((x) == DOT) \ || ((x) == UPARROW) \ || ((x) == LPAREN)) @@ -1502,12 +1539,12 @@ oberon_designator(oberon_context_t * ctx) name = oberon_assert_ident(ctx); expr = oberon_make_record_selector(ctx, expr, name); break; - case LBRACE: - oberon_assert_token(ctx, LBRACE); + case LBRACK: + oberon_assert_token(ctx, LBRACK); int num_indexes = 0; oberon_expr_t * indexes = NULL; oberon_expr_list(ctx, &num_indexes, &indexes, 0); - oberon_assert_token(ctx, RBRACE); + oberon_assert_token(ctx, RBRACK); for(int i = 0; i < num_indexes; i++) { @@ -1619,6 +1656,59 @@ oberon_integer_item(oberon_context_t * ctx, int64_t i) return expr; } +static oberon_expr_t * +oberon_element(oberon_context_t * ctx) +{ + oberon_expr_t * e1; + oberon_expr_t * e2; + + e1 = oberon_expr(ctx); + if(e1 -> result -> class != OBERON_TYPE_INTEGER) + { + oberon_error(ctx, "expected integer"); + } + + e2 = NULL; + if(ctx -> token == DOTDOT) + { + oberon_assert_token(ctx, DOTDOT); + e2 = oberon_expr(ctx); + if(e2 -> result -> class != OBERON_TYPE_INTEGER) + { + oberon_error(ctx, "expected integer"); + } + } + + oberon_expr_t * set; + set = oberon_new_operator(OP_RANGE, ctx -> set_type, e1, e2); + return set; +} + +static oberon_expr_t * +oberon_set(oberon_context_t * ctx) +{ + oberon_expr_t * set; + oberon_expr_t * elements; + set = oberon_new_item(MODE_SET, ctx -> set_type, true); + set -> item.integer = 0; + + oberon_assert_token(ctx, LBRACE); + if(ISEXPR(ctx -> token)) + { + elements = oberon_element(ctx); + set = oberon_new_operator(OP_UNION, ctx -> set_type, set, elements); + while(ctx -> token == COMMA) + { + oberon_assert_token(ctx, COMMA); + elements = oberon_element(ctx); + set = oberon_new_operator(OP_UNION, ctx -> set_type, set, elements); + } + } + oberon_assert_token(ctx, RBRACE); + + return set; +} + static oberon_expr_t * oberon_factor(oberon_context_t * ctx) { @@ -1663,6 +1753,9 @@ oberon_factor(oberon_context_t * ctx) expr -> item.boolean = false; oberon_assert_token(ctx, FALSE); break; + case LBRACE: + expr = oberon_set(ctx); + break; case LPAREN: oberon_assert_token(ctx, LPAREN); expr = oberon_expr(ctx); @@ -1720,6 +1813,7 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_ oberon_expr_t * expr; oberon_type_t * result; + bool error = false; if(token == IS) { oberon_type_t * v = a -> result; @@ -1825,10 +1919,21 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_ } else if(token == SLASH) { - oberon_autocast_to_real(ctx, &a); - oberon_autocast_to_real(ctx, &b); - oberon_autocast_binary_op(ctx, &a, &b); - expr = oberon_new_operator(OP_DIV, a -> result, a, b); + if(a -> result -> class == OBERON_TYPE_SET + || b -> result -> class == OBERON_TYPE_SET) + { + oberon_autocast_binary_op(ctx, &a, &b); + result = a -> result; + expr = oberon_new_operator(OP_SYM_DIFFERENCE, result, a, b); + } + else + { + oberon_autocast_to_real(ctx, &a); + oberon_autocast_to_real(ctx, &b); + oberon_autocast_binary_op(ctx, &a, &b); + result = a -> result; + expr = oberon_new_operator(OP_DIV, result, a, b); + } } else if(token == DIV) { @@ -1844,29 +1949,58 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_ else { oberon_autocast_binary_op(ctx, &a, &b); - - if(token == PLUS) + result = a -> result; + if(result -> class == OBERON_TYPE_SET) { - expr = oberon_new_operator(OP_ADD, a -> result, a, b); - } - else if(token == MINUS) - { - expr = oberon_new_operator(OP_SUB, a -> result, a, b); - } - else if(token == STAR) - { - expr = oberon_new_operator(OP_MUL, a -> result, a, b); + switch(token) + { + case PLUS: + expr = oberon_new_operator(OP_UNION, result, a, b); + break; + case MINUS: + expr = oberon_new_operator(OP_DIFFERENCE, result, a, b); + break; + case STAR: + expr = oberon_new_operator(OP_INTERSECTION, result, a, b); + break; + default: + error = true; + break; + } } - else if(token == MOD) + else if(result -> class == OBERON_TYPE_INTEGER + || result -> class == OBERON_TYPE_REAL) { - expr = oberon_new_operator(OP_MOD, a -> result, a, b); + switch(token) + { + case PLUS: + expr = oberon_new_operator(OP_ADD, result, a, b); + break; + case MINUS: + expr = oberon_new_operator(OP_SUB, result, a, b); + break; + case STAR: + expr = oberon_new_operator(OP_MUL, result, a, b); + break; + case MOD: + expr = oberon_new_operator(OP_MOD, result, a, b); + break; + default: + error = true; + break; + } } else { - oberon_error(ctx, "oberon_make_bin_op: bin wat"); + error = true; } } + if(error) + { + oberon_error(ctx, "invalid operation"); + } + return expr; } @@ -3399,6 +3533,9 @@ register_default_types(oberon_context_t * ctx) ctx -> char_type = oberon_new_type_char(1); oberon_define_type(ctx -> world_scope, "CHAR", ctx -> char_type, 1); + + ctx -> set_type = oberon_new_type_set(4); + oberon_define_type(ctx -> world_scope, "SET", ctx -> set_type, 1); } static void @@ -3440,6 +3577,9 @@ oberon_make_min_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ case OBERON_TYPE_INTEGER: expr = oberon_integer_item(ctx, -powl(2, bits - 1)); break; + case OBERON_TYPE_SET: + expr = oberon_integer_item(ctx, 0); + break; default: oberon_error(ctx, "allowed only basic types"); break; @@ -3476,6 +3616,9 @@ oberon_make_max_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ case OBERON_TYPE_INTEGER: expr = oberon_integer_item(ctx, powl(2, bits - 1) - 1); break; + case OBERON_TYPE_SET: + expr = oberon_integer_item(ctx, bits); + break; default: oberon_error(ctx, "allowed only basic types"); break; @@ -3513,6 +3656,8 @@ oberon_make_size_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list case OBERON_TYPE_INTEGER: case OBERON_TYPE_BOOLEAN: case OBERON_TYPE_REAL: + case OBERON_TYPE_CHAR: + case OBERON_TYPE_SET: size = type -> size; break; default: diff --git a/src/test.c b/src/test.c index 024252a..9279c33 100644 --- a/src/test.c +++ b/src/test.c @@ -9,23 +9,11 @@ static char source_test[] = "MODULE Test;" "IMPORT Out;" "" - "TYPE" - " RecA = POINTER TO RecADesc;" - " RecADesc = RECORD END;" - "" - " RecB = POINTER TO RecBDesc;" - " RecBDesc = RECORD (RecADesc) END;" - "" "VAR" - " a : RecA;" - " b : RecB;" + " s0 : SET;" "" "BEGIN" - " NEW(a);" - " NEW(b);" - " Out.Open;" - " a := b;" - " IF a IS RecA THEN Out.String('Yes'); Out.Ln; END;" + " s0 := -{ 1, 3..6 } + { 3, 4, 10 };" "END Test." ;