From 3d4021b9a2dd52aaf4b97859a8a58b74903ebac9 Mon Sep 17 00:00:00 2001 From: DeaDDooMER Date: Sun, 13 Aug 2017 00:12:12 +0300 Subject: [PATCH] =?utf8?q?=D0=94=D0=BE=D0=B1=D0=B0=D0=B2=D0=BB=D0=B5=D0=BD?= =?utf8?q?=D0=B0=20=D1=81=D0=B2=D1=91=D1=80=D1=82=D0=BA=D0=B0=20=D0=BA?= =?utf8?q?=D0=BE=D0=BD=D1=81=D1=82=D0=B0=D0=BD=D1=82?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- Test.obn | 31 +- Test10.obn | 3 + Test11.obn | 39 +++ Test7.obn | 6 + obn-run-tests.sh | 1 + rtl/SYSTEM.java | 13 +- src/backends/jvm/generator-jvm.c | 2 + src/oberon.c | 564 ++++++++++++++++++++----------- 8 files changed, 454 insertions(+), 205 deletions(-) create mode 100644 Test11.obn diff --git a/Test.obn b/Test.obn index 4bde081..8371d40 100644 --- a/Test.obn +++ b/Test.obn @@ -2,22 +2,31 @@ MODULE Test; IMPORT Out; +CONST + im1 = -1; + bol = ~FALSE; + set = { 1, 2, 3..6 }; + fm1 = -1.0; + dm1 = -1.0D0; + BEGIN - IF "abc" = "abc" THEN - Out.String("Equal abc = abc"); Out.Ln; - ELSE - Out.String("WAT: MUST BE abc = abc"); Out.Ln; - END; + Out.Open; + + Out.Int(im1, 0); Out.Ln; + Out.Real(fm1, 0); Out.Ln; + Out.LongReal(dm1, 0); Out.Ln; - IF "cba" > "abc" THEN - Out.String("Great cba > abc"); Out.Ln; + IF 5 IN set THEN + Out.String("SET: Ok"); Out.Ln; ELSE - Out.String("WAT: MUST BE cba = abc"); Out.Ln; + Out.String("INVALID SET"); Out.Ln; + HALT(1); END; - IF "abc" < "bc" THEN - Out.String("Less abc < bc"); Out.Ln; + IF bol THEN + Out.String("BOOLEAN: Ok"); Out.Ln; ELSE - Out.String("WAT: MUST BE abc < bc"); Out.Ln; + Out.String("INVALID BOOLEAN"); Out.Ln; + HALT(1); END; END Test. diff --git a/Test10.obn b/Test10.obn index 7b4b811..89dbcfd 100644 --- a/Test10.obn +++ b/Test10.obn @@ -7,18 +7,21 @@ BEGIN Out.String("Equal abc = abc"); Out.Ln; ELSE Out.String("WAT: MUST BE abc = abc"); Out.Ln; + HALT(1); END; IF "cba" > "abc" THEN Out.String("Great cba > abc"); Out.Ln; ELSE Out.String("WAT: MUST BE cba = abc"); Out.Ln; + HALT(1); END; IF "abc" < "bc" THEN Out.String("Less abc < bc"); Out.Ln; ELSE Out.String("WAT: MUST BE abc < bc"); Out.Ln; + HALT(1); END; END Test10. diff --git a/Test11.obn b/Test11.obn new file mode 100644 index 0000000..847fddf --- /dev/null +++ b/Test11.obn @@ -0,0 +1,39 @@ +MODULE Test11; + +IMPORT Out; + +CONST + im1 = -1; + bol = ~FALSE; + set = { 1, 2, 3..6 }; + fm1 = -1.0; + dm1 = -1.0D0; + inf = 4 IN set; + rel = 10 = 100; + pi = 4 / 1 - 4 / 3 + 4 / 5 - 4 / 7 + 4 / 9 - 4 / 11 + 4 / 13 - 4 / 15 + 4 / 17 - 4 / 19 + 4 / 21; + +BEGIN + Out.Open; + + Out.Int(im1, 0); Out.Ln; + Out.Real(fm1, 0); Out.Ln; + Out.LongReal(dm1, 0); Out.Ln; + + Out.Real(pi, 0); Out.Ln; + + IF 5 IN set THEN + Out.String("SET: Ok"); Out.Ln; + ELSE + Out.String("INVALID SET"); Out.Ln; + HALT(1); + END; + + IF bol THEN + Out.String("BOOLEAN: Ok"); Out.Ln; + ELSE + Out.String("INVALID BOOLEAN"); Out.Ln; + HALT(1); + END; +END Test11. + +Проверка свёртки констант. diff --git a/Test7.obn b/Test7.obn index 739ec97..7579867 100644 --- a/Test7.obn +++ b/Test7.obn @@ -4,14 +4,20 @@ IMPORT Out; VAR i : INTEGER; + ok : BOOLEAN; BEGIN Out.Open; i := 48; FOR i := 32 TO i DO Out.Int(i, 0); Out.Char(' '); + ok := TRUE; END; Out.Ln; + + IF ok = FALSE THEN + HALT(1); + END; END Test7. Проверка корректности FOR. diff --git a/obn-run-tests.sh b/obn-run-tests.sh index f9c6897..f483e01 100755 --- a/obn-run-tests.sh +++ b/obn-run-tests.sh @@ -39,3 +39,4 @@ maketest Test7 maketest Test8 maketest Test9 maketest Test10 +maketest Test11 diff --git a/rtl/SYSTEM.java b/rtl/SYSTEM.java index 68f82bd..28d8c46 100644 --- a/rtl/SYSTEM.java +++ b/rtl/SYSTEM.java @@ -19,16 +19,17 @@ public class SYSTEM public static void COPY(byte[] x, byte[] v) { - int len_x = LEN(x); - int len_v = v.length - 1; + int ix = LEN(x); + int iv = v.length - 1; - int len = (len_x < len_v) ? (len_x) : (len_v); - for(int i = 0; i < len; i++) + int i = 0; + int len = (ix < iv) ? (ix) : (iv); + while(i < len) { v[i] = x[i]; + i += 1; } - - v[len] = 0; + v[i] = 0; } public static int STRCMP(byte[] a, byte[] b) diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c index 189d8d2..ee4bc67 100644 --- a/src/backends/jvm/generator-jvm.c +++ b/src/backends/jvm/generator-jvm.c @@ -1372,6 +1372,7 @@ jvm_generate_operator(gen_proc_t * p, oberon_type_t * t, int op) jvm_generate(p, 2 * cell_size, cell_size, "%cand", prefix); break; case OP_DIFFERENCE: + /* (a - b) == a & ~b */ 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); @@ -1498,6 +1499,7 @@ jvm_generate_in(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b) int label_else = jvm_new_label_id(p); int label_end = jvm_new_label_id(p); + /* (a IN b) == (1 << a) & b */ jvm_generate_push_int_size(p, 1, t -> size); push_expr(p, a); jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix); diff --git a/src/oberon.c b/src/oberon.c index 6f9395c..30f10ec 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -83,6 +83,119 @@ oberon_new_type_set(int size) return x; } +static oberon_expr_t * +oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon_expr_t * right) +{ + oberon_oper_t * operator; + operator = malloc(sizeof *operator); + memset(operator, 0, sizeof *operator); + + operator -> is_item = 0; + operator -> result = result; + operator -> read_only = 1; + operator -> op = op; + operator -> left = left; + operator -> right = right; + + return (oberon_expr_t *) operator; +} + +static oberon_expr_t * +oberon_new_item(int mode, oberon_type_t * result, int read_only) +{ + oberon_item_t * item; + item = malloc(sizeof *item); + memset(item, 0, sizeof *item); + + item -> is_item = 1; + item -> result = result; + item -> read_only = read_only; + item -> mode = mode; + + return (oberon_expr_t *)item; +} + +static oberon_type_t * +oberon_get_type_of_int_value(oberon_context_t * ctx, int64_t i) +{ + if(i >= -128 && i <= 127) + { + return ctx -> byte_type; + } + else if(i >= -32768 && i <= 32767) + { + return ctx -> shortint_type; + } + else if(i >= -2147483648 && i <= 2147483647) + { + return ctx -> int_type; + } + else + { + return ctx -> longint_type; + } +} + +static oberon_expr_t * +oberon_make_integer(oberon_context_t * ctx, int64_t i) +{ + oberon_expr_t * expr; + oberon_type_t * result; + result = oberon_get_type_of_int_value(ctx, i); + expr = oberon_new_item(MODE_INTEGER, result, true); + expr -> item.integer = i; + expr -> item.real = i; + return expr; +} + +static oberon_expr_t * +oberon_make_real_typed(oberon_context_t * ctx, double r, oberon_type_t * result) +{ + oberon_expr_t * expr; + expr = oberon_new_item(MODE_REAL, result, true); + expr -> item.integer = r; + expr -> item.real = r; + return expr; +} + +static oberon_expr_t * +oberon_make_real(oberon_context_t * ctx, double r, bool longmode) +{ + oberon_type_t * result; + result = (longmode) ? (ctx -> longreal_type) : (ctx -> real_type); + return oberon_make_real_typed(ctx, r, result); +} + +static oberon_expr_t * +oberon_make_boolean(oberon_context_t * ctx, bool cond) +{ + oberon_expr_t * expr; + expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, true); + expr -> item.integer = cond; + expr -> item.real = cond; + return expr; +} + +static oberon_expr_t * +oberon_make_set(oberon_context_t * ctx, int64_t i) +{ + oberon_expr_t * expr; + expr = oberon_new_item(MODE_SET, ctx -> set_type, true); + expr -> item.integer = i; + expr -> item.real = i; + return expr; +} + +static oberon_expr_t * +oberon_make_set_range(oberon_context_t * ctx, int64_t x, int64_t y) +{ + oberon_expr_t * expr; + expr = oberon_new_item(MODE_SET, ctx -> set_type, true); + expr -> item.integer = (x <= y) ? ((2 << y) - (1 << x)) : (0); + expr -> item.real = expr -> item.integer; + return expr; +} + // ======================================================================= // TABLE // ======================================================================= @@ -524,6 +637,7 @@ oberon_read_number(oberon_context_t * ctx) case 2: case 3: sscanf(ident, "%lf", &real); + integer = real; ctx -> token = REAL; break; case 4: @@ -787,38 +901,7 @@ 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 * oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr); - -static oberon_expr_t * -oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon_expr_t * right) -{ - oberon_oper_t * operator; - operator = malloc(sizeof *operator); - memset(operator, 0, sizeof *operator); - - operator -> is_item = 0; - operator -> result = result; - operator -> read_only = 1; - operator -> op = op; - operator -> left = left; - operator -> right = right; - - return (oberon_expr_t *) operator; -} - -static oberon_expr_t * -oberon_new_item(int mode, oberon_type_t * result, int read_only) -{ - oberon_item_t * item; - item = malloc(sizeof *item); - memset(item, 0, sizeof *item); - - item -> is_item = 1; - item -> result = result; - item -> read_only = read_only; - item -> mode = mode; - - return (oberon_expr_t *)item; -} +static bool oberon_is_const(oberon_expr_t * expr); static oberon_expr_t * oberon_make_unary_op(oberon_context_t * ctx, int token, oberon_expr_t * a) @@ -832,11 +915,36 @@ oberon_make_unary_op(oberon_context_t * ctx, int token, oberon_expr_t * a) { if(result -> class == OBERON_TYPE_SET) { - expr = oberon_new_operator(OP_COMPLEMENTATION, result, a, NULL); + if(oberon_is_const(a)) + { + expr = oberon_make_set(ctx, ~(a -> item.integer)); + } + else + { + 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); + if(oberon_is_const(a)) + { + expr = oberon_make_integer(ctx, -(a -> item.integer)); + } + else + { + expr = oberon_new_operator(OP_UNARY_MINUS, result, a, NULL); + } + } + else if(result -> class == OBERON_TYPE_REAL) + { + if(oberon_is_const(a)) + { + expr = oberon_make_real_typed(ctx, -(a -> item.real), result); + } + else + { + expr = oberon_new_operator(OP_UNARY_MINUS, result, a, NULL); + } } else { @@ -850,7 +958,14 @@ oberon_make_unary_op(oberon_context_t * ctx, int token, oberon_expr_t * a) oberon_error(ctx, "incompatible operator type"); } - expr = oberon_new_operator(OP_LOGIC_NOT, result, a, NULL); + if(oberon_is_const(a)) + { + expr = oberon_make_boolean(ctx, !(a -> item.integer)); + } + else + { + expr = oberon_new_operator(OP_LOGIC_NOT, result, a, NULL); + } } else { @@ -1415,38 +1530,6 @@ oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr) oberon_make_call_proc(ctx, (oberon_item_t *) expr, num_args, arguments); } -static oberon_type_t * -oberon_get_type_of_int_value(oberon_context_t * ctx, int64_t i) -{ - if(i >= -128 && i <= 127) - { - return ctx -> byte_type; - } - else if(i >= -32768 && i <= 32767) - { - return ctx -> shortint_type; - } - else if(i >= -2147483648 && i <= 2147483647) - { - return ctx -> int_type; - } - else - { - return ctx -> longint_type; - } -} - -static oberon_expr_t * -oberon_integer_item(oberon_context_t * ctx, int64_t i) -{ - oberon_expr_t * expr; - oberon_type_t * result; - result = oberon_get_type_of_int_value(ctx, i); - expr = oberon_new_item(MODE_INTEGER, result, true); - expr -> item.integer = i; - return expr; -} - static oberon_expr_t * oberon_element(oberon_context_t * ctx) { @@ -1473,28 +1556,51 @@ oberon_element(oberon_context_t * ctx) } oberon_expr_t * set; - set = oberon_new_operator(OP_RANGE, ctx -> set_type, e1, e2); + if(e2 == NULL && oberon_is_const(e1)) + { + set = oberon_make_set(ctx, e1 -> item.integer); + } + else if(e2 != NULL && oberon_is_const(e1) && oberon_is_const(e2)) + { + set = oberon_make_set_range(ctx, e1 -> item.integer, e2 -> item.integer); + } + else + { + set = oberon_new_operator(OP_RANGE, ctx -> set_type, e1, e2); + } return set; } +static oberon_expr_t * +oberon_make_set_union(oberon_context_t * ctx, oberon_expr_t * a, oberon_expr_t * b) +{ + if(oberon_is_const(a) && oberon_is_const(b)) + { + return oberon_make_set(ctx, (a -> item.integer | b -> item.integer)); + } + else + { + return oberon_new_operator(OP_UNION, ctx -> set_type, a, b); + } +} + 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; + set = oberon_make_set(ctx, 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); + set = oberon_make_set_union(ctx, 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); + set = oberon_make_set_union(ctx, set, elements); } } oberon_assert_token(ctx, RBRACE); @@ -1502,15 +1608,6 @@ oberon_set(oberon_context_t * ctx) return set; } -static oberon_expr_t * -oberon_make_boolean(oberon_context_t * ctx, bool cond) -{ - oberon_expr_t * expr; - expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, true); - expr -> item.integer = cond; - return expr; -} - static oberon_expr_t * oberon_factor(oberon_context_t * ctx) { @@ -1524,7 +1621,7 @@ oberon_factor(oberon_context_t * ctx) expr = oberon_opt_func_parens(ctx, expr); break; case INTEGER: - expr = oberon_integer_item(ctx, ctx -> integer); + expr = oberon_make_integer(ctx, ctx -> integer); oberon_assert_token(ctx, INTEGER); break; case CHAR: @@ -1540,9 +1637,7 @@ oberon_factor(oberon_context_t * ctx) oberon_assert_token(ctx, STRING); break; case REAL: - result = (ctx -> longmode) ? (ctx -> longreal_type) : (ctx -> real_type); - expr = oberon_new_item(MODE_REAL, result, 1); - expr -> item.real = ctx -> real; + expr = oberon_make_real(ctx, ctx -> real, ctx -> longmode); oberon_assert_token(ctx, REAL); break; case LBRACE: @@ -1582,10 +1677,16 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_ oberon_check_src(ctx, b); } - bool error = false; if(token == IN) { - expr = oberon_new_operator(OP_IN, ctx -> bool_type, a, b); + if(oberon_is_const(a) && oberon_is_const(b)) + { + expr = oberon_make_boolean(ctx, (1 << a -> item.integer) & b -> item.integer); + } + else + { + expr = oberon_new_operator(OP_IN, ctx -> bool_type, a, b); + } } else if(token == IS) { @@ -1595,126 +1696,201 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_ else if((token >= EQUAL && token <= GEQ) || token == OR || token == AND) { result = oberon_get_longer_type(ctx, a -> result, b -> result); - a = oberon_cast_expr(ctx, a, result); - b = oberon_cast_expr(ctx, b, result); - result = ctx -> bool_type; - if(token == EQUAL) - { - expr = oberon_new_operator(OP_EQ, result, a, b); - } - else if(token == NEQ) - { - expr = oberon_new_operator(OP_NEQ, result, a, b); - } - else if(token == LESS) - { - expr = oberon_new_operator(OP_LSS, result, a, b); - } - else if(token == LEQ) - { - expr = oberon_new_operator(OP_LEQ, result, a, b); - } - else if(token == GREAT) - { - expr = oberon_new_operator(OP_GRT, result, a, b); - } - else if(token == GEQ) - { - expr = oberon_new_operator(OP_GEQ, result, a, b); - } - else if(token == OR) - { - expr = oberon_new_operator(OP_LOGIC_OR, result, a, b); - } - else if(token == AND) + if(oberon_is_const(a) && oberon_is_const(b) + && (oberon_is_real_type(result) || oberon_is_integer_type(result))) { - expr = oberon_new_operator(OP_LOGIC_AND, result, a, b); + if(oberon_is_real_type(result)) + { + double x = a -> item.real; + double y = b -> item.real; + switch(token) + { + case EQUAL: expr = oberon_make_boolean(ctx, x == y); break; + case NEQ: expr = oberon_make_boolean(ctx, x != y); break; + case LESS: expr = oberon_make_boolean(ctx, x < y); break; + case LEQ: expr = oberon_make_boolean(ctx, x <= y); break; + case GREAT: expr = oberon_make_boolean(ctx, x > y); break; + case GEQ: expr = oberon_make_boolean(ctx, x >= y); break; + case OR: expr = oberon_make_boolean(ctx, x || y); break; + case AND: expr = oberon_make_boolean(ctx, x && y); break; + default: assert(0); break; + } + } + else if(oberon_is_integer_type(result)) + { + int64_t x = a -> item.integer; + int64_t y = b -> item.integer; + switch(token) + { + case EQUAL: expr = oberon_make_boolean(ctx, x == y); break; + case NEQ: expr = oberon_make_boolean(ctx, x != y); break; + case LESS: expr = oberon_make_boolean(ctx, x < y); break; + case LEQ: expr = oberon_make_boolean(ctx, x <= y); break; + case GREAT: expr = oberon_make_boolean(ctx, x > y); break; + case GEQ: expr = oberon_make_boolean(ctx, x >= y); break; + case OR: expr = oberon_make_boolean(ctx, x || y); break; + case AND: expr = oberon_make_boolean(ctx, x && y); break; + default: assert(0); break; + } + } + else + { + assert(0); + } } else { - oberon_error(ctx, "oberon_make_bin_op: bool wat"); + a = oberon_cast_expr(ctx, a, result); + b = oberon_cast_expr(ctx, b, result); + result = ctx -> bool_type; + switch(token) + { + case EQUAL: expr = oberon_new_operator(OP_EQ, result, a, b); break; + case NEQ: expr = oberon_new_operator(OP_NEQ, result, a, b); break; + case LESS: expr = oberon_new_operator(OP_LSS, result, a, b); break; + case LEQ: expr = oberon_new_operator(OP_LEQ, result, a, b); break; + case GREAT: expr = oberon_new_operator(OP_GRT, result, a, b); break; + case GEQ: expr = oberon_new_operator(OP_GEQ, result, a, b); break; + case OR: expr = oberon_new_operator(OP_LOGIC_OR, result, a, b); break; + case AND: expr = oberon_new_operator(OP_LOGIC_AND, result, a, b); break; + default: assert(0); break; + } } } else if(token == SLASH) { if(oberon_is_set_type(a -> result) && oberon_is_set_type(b -> result)) { - result = oberon_get_longer_type(ctx, a -> result, b -> result); - a = oberon_cast_expr(ctx, a, result); - b = oberon_cast_expr(ctx, b, result); - expr = oberon_new_operator(OP_SYM_DIFFERENCE, result, a, b); + if(oberon_is_const(a) && oberon_is_const(b)) + { + int64_t x = a -> item.integer; + int64_t y = b -> item.integer; + expr = oberon_make_set(ctx, x ^ y); + } + else + { + result = oberon_get_longer_type(ctx, a -> result, b -> result); + a = oberon_cast_expr(ctx, a, result); + b = oberon_cast_expr(ctx, b, result); + expr = oberon_new_operator(OP_SYM_DIFFERENCE, result, a, b); + } } else { result = oberon_get_longer_real_type(ctx, a -> result, b -> result); - a = oberon_cast_expr(ctx, a, result); - b = oberon_cast_expr(ctx, b, result); - expr = oberon_new_operator(OP_DIV, result, a, b); + if(oberon_is_const(a) && oberon_is_const(b)) + { + double x = a -> item.real; + double y = b -> item.real; + expr = oberon_make_real_typed(ctx, x / y, result); + } + else + { + a = oberon_cast_expr(ctx, a, result); + b = oberon_cast_expr(ctx, b, result); + expr = oberon_new_operator(OP_DIV, result, a, b); + } } } - else if(token == DIV) - { - result = oberon_get_longer_type(ctx, a -> result, b -> result); - a = oberon_cast_expr(ctx, a, result); - b = oberon_cast_expr(ctx, b, result); - expr = oberon_new_operator(OP_DIV, result, a, b); - } else { result = oberon_get_longer_type(ctx, a -> result, b -> result); - a = oberon_cast_expr(ctx, a, result); - b = oberon_cast_expr(ctx, b, result); - if(oberon_is_set_type(result)) + + if(oberon_is_const(a) && oberon_is_const(b)) { - switch(token) + if(oberon_is_set_type(result)) { - 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; + int64_t x = a -> item.integer; + int64_t y = b -> item.integer; + switch(token) + { + case PLUS: expr = oberon_make_set(ctx, x | y); break; + case MINUS: expr = oberon_make_set(ctx, x & ~y); break; + case STAR: expr = oberon_make_set(ctx, x & y); break; + default: assert(0); break; + } } - } - else if(oberon_is_number_type(result)) - { - switch(token) + if(oberon_is_real_type(result)) { - 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; + double x = a -> item.real; + double y = b -> item.real; + switch(token) + { + case PLUS: expr = oberon_make_real_typed(ctx, x + y, result); break; + case MINUS: expr = oberon_make_real_typed(ctx, x - y, result); break; + case STAR: expr = oberon_make_real_typed(ctx, x * y, result); break; + default: assert(0); break; + } + } + else if(oberon_is_integer_type(result)) + { + int64_t x = a -> item.integer; + int64_t y = b -> item.integer; + switch(token) + { + case PLUS: expr = oberon_make_integer(ctx, x + y); break; + case MINUS: expr = oberon_make_integer(ctx, x - y); break; + case STAR: expr = oberon_make_integer(ctx, x * y); break; + case DIV: expr = oberon_make_integer(ctx, x / y); break; + case MOD: expr = oberon_make_integer(ctx, x % y); break; + default: assert(0); break; + } + } + else + { + assert(0); } } else { - error = true; + a = oberon_cast_expr(ctx, a, result); + b = oberon_cast_expr(ctx, b, result); + + + if(oberon_is_set_type(result)) + { + 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: + assert(0); + break; + } + } + else if(oberon_is_number_type(result)) + { + 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; + default: + assert(0); + break; + } + } + else + { + assert(0); + } } } - if(error) - { - oberon_error(ctx, "invalid operation"); - } - return expr; } @@ -1799,12 +1975,12 @@ oberon_expr(oberon_context_t * ctx) return expr; } -static void -oberon_check_const(oberon_context_t * ctx, oberon_expr_t * expr) +static bool +oberon_is_const(oberon_expr_t * expr) { - if(expr -> is_item == 0) + if(expr -> is_item == false) { - oberon_error(ctx, "const expression are required"); + return false; } switch(expr -> item.mode) @@ -1815,13 +1991,25 @@ oberon_check_const(oberon_context_t * ctx, oberon_expr_t * expr) case MODE_REAL: case MODE_CHAR: case MODE_STRING: + case MODE_SET: case MODE_TYPE: - /* accept */ + return true; break; default: - oberon_error(ctx, "const expression are required"); + return false; break; } + + return false; +} + +static void +oberon_check_const(oberon_context_t * ctx, oberon_expr_t * expr) +{ + if(!oberon_is_const(expr)) + { + oberon_error(ctx, "const expression are required"); + } } static oberon_item_t * @@ -3212,7 +3400,7 @@ oberon_statement(oberon_context_t * ctx) } else { - by = oberon_integer_item(ctx, 1); + by = oberon_make_integer(ctx, 1); } if(by -> result -> class != OBERON_TYPE_INTEGER) @@ -3491,10 +3679,10 @@ oberon_make_min_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ switch(arg -> result -> class) { case OBERON_TYPE_INTEGER: - expr = oberon_integer_item(ctx, -powl(2, bits - 1)); + expr = oberon_make_integer(ctx, -powl(2, bits - 1)); break; case OBERON_TYPE_SET: - expr = oberon_integer_item(ctx, 0); + expr = oberon_make_integer(ctx, 0); break; default: oberon_error(ctx, "allowed only basic types"); @@ -3530,10 +3718,10 @@ oberon_make_max_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ switch(arg -> result -> class) { case OBERON_TYPE_INTEGER: - expr = oberon_integer_item(ctx, powl(2, bits - 1) - 1); + expr = oberon_make_integer(ctx, powl(2, bits - 1) - 1); break; case OBERON_TYPE_SET: - expr = oberon_integer_item(ctx, bits); + expr = oberon_make_integer(ctx, bits); break; default: oberon_error(ctx, "allowed only basic types"); @@ -3581,7 +3769,7 @@ oberon_make_size_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list break; } - expr = oberon_integer_item(ctx, size); + expr = oberon_make_integer(ctx, size); return expr; } -- 2.29.2