Добавлены процедуры INC DEC INCL EXCL

diff --git a/Test.obn b/Test.obn
index 03df037492a62bec8642dbd45bd9a5ec5f2cc689..da1f5453089ca918510c6b19e914ac2dbbf33d42 100644 (file)
--- a/Test.obn
+++ b/Test.obn
@@ -1,12 +1,19 @@
 MODULE Test;
 
 VAR
-  x : ARRAY 10 OF INTEGER;
-  p : POINTER TO ARRAY OF ARRAY OF INTEGER;
+  i : INTEGER;
+  s : SET;
 
 BEGIN
-  NEW(p, 20, 30);
-  ASSERT(LEN(x, 0) = 10);
-  ASSERT(LEN(p^, 0) = 20);
-  ASSERT(LEN(p^, 1) = 30);
+  INC(i);
+  ASSERT(i = 1);
+  DEC(i);
+  ASSERT(i = 0);
+
+  INCL(s, 3);
+  ASSERT(3 IN s);
+  EXCL(s, 3);
+  ASSERT(~(3 IN s));
 END Test.
+
+Проверка встроенных процедур.

diff --git a/Test16.obn b/Test16.obn
new file mode 100644 (file)
index 0000000..dbe58ee
--- /dev/null
+++ b/Test16.obn
@@ -0,0 +1,19 @@
+MODULE Test16;
+
+VAR
+  i : INTEGER;
+  s : SET;
+
+BEGIN
+  INC(i);
+  ASSERT(i = 1);
+  DEC(i);
+  ASSERT(i = 0);
+
+  INCL(s, 3);
+  ASSERT(3 IN s);
+  EXCL(s, 3);
+  ASSERT(~(3 IN s));
+END Test16.
+
+Проверка встроенных процедур.

diff --git a/notes b/notes
index 09e3bd0b3f1032a06ff27b4cf3d87c3b24560b47..21447a4e87dcc7a6acd4be42e6fa11d109fe989d 100644 (file)
--- a/notes
+++ b/notes
@@ -2,7 +2,6 @@
 - Сделать нормальную проверку наличия RETURN.
 
 - Нет функций LONG SHORT
-- Нет процедур DEC EXCL INC INCL
 - Нет счёта строк / столбцов
 - Нет процедур привязанных к типм
 

diff --git a/obn-run-tests.sh b/obn-run-tests.sh
index f36da1f47fac90c4c7c2a5a26acc3186b2aedc53..28971d1a35cb6a974b48267dc2153951ee92acf4 100755 (executable)
--- a/obn-run-tests.sh
+++ b/obn-run-tests.sh
@@ -44,3 +44,4 @@ maketest Test12
 maketest Test13
 maketest Test14
 maketest Test15
+maketest Test16

diff --git a/src/oberon.c b/src/oberon.c
index 53dd33eec2a711792adf5f3a0e9ed9b982fa5c74..1d00f22f5cf68f87e364a09fc60e984be5635d23 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -197,6 +197,16 @@ oberon_make_set(oberon_context_t * ctx, int64_t i)
        return expr;
 }
 
+static oberon_expr_t *
+oberon_make_set_index(oberon_context_t * ctx, int64_t i)
+{
+       oberon_expr_t * expr;
+       expr = oberon_new_item(MODE_SET, ctx -> set_type, true);
+       expr -> item.integer = 1 << i;
+       expr -> item.real = 1 << i;
+       return expr;
+}
+
 static oberon_expr_t *
 oberon_make_set_range(oberon_context_t * ctx, int64_t x, int64_t y)
 {
@@ -1569,7 +1579,7 @@ oberon_element(oberon_context_t * ctx)
        oberon_expr_t * set;
        if(e2 == NULL && oberon_is_const(e1))
        {
-               set = oberon_make_set(ctx, e1 -> item.integer);
+               set = oberon_make_set_index(ctx, e1 -> item.integer);
        }
        else if(e2 != NULL && oberon_is_const(e1) && oberon_is_const(e2))
        {
@@ -3845,6 +3855,132 @@ oberon_make_abs_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
        return expr;
 }
 
+static void
+oberon_make_inc_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
+{
+       if(num_args < 1)
+       {
+               oberon_error(ctx, "too few arguments");
+       }
+
+       if(num_args > 1)
+       {
+               oberon_error(ctx, "too mach arguments");
+       }
+
+       oberon_expr_t * dst;
+       dst = list_args;
+       oberon_check_dst(ctx, dst);
+
+       if(!oberon_is_integer_type(dst -> result))
+       {
+               oberon_error(ctx, "expect integer");
+       }
+
+       oberon_expr_t * expr;
+       expr = oberon_make_bin_op(ctx, PLUS, dst, oberon_make_integer(ctx, 1));
+       oberon_assign(ctx, expr, dst);
+}
+
+static void
+oberon_make_incl_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
+{
+       if(num_args < 2)
+       {
+               oberon_error(ctx, "too few arguments");
+       }
+
+       if(num_args > 2)
+       {
+               oberon_error(ctx, "too mach arguments");
+       }
+
+       oberon_expr_t * dst;
+       dst = list_args;
+       oberon_check_dst(ctx, dst);
+
+       if(!oberon_is_set_type(dst -> result))
+       {
+               oberon_error(ctx, "expect integer");
+       }
+
+       oberon_expr_t * x;
+       x = list_args -> next;
+       oberon_check_src(ctx, x);
+       
+       if(!oberon_is_integer_type(x -> result))
+       {
+               oberon_error(ctx, "expect integer");
+       }
+
+       oberon_expr_t * expr;
+       expr = oberon_make_bin_op(ctx, PLUS, dst, oberon_new_operator(OP_RANGE, dst -> result, x, NULL));
+       oberon_assign(ctx, expr, dst);
+}
+
+static void
+oberon_make_excl_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
+{
+       if(num_args < 2)
+       {
+               oberon_error(ctx, "too few arguments");
+       }
+
+       if(num_args > 2)
+       {
+               oberon_error(ctx, "too mach arguments");
+       }
+
+       oberon_expr_t * dst;
+       dst = list_args;
+       oberon_check_dst(ctx, dst);
+
+       if(!oberon_is_set_type(dst -> result))
+       {
+               oberon_error(ctx, "expect integer");
+       }
+
+       oberon_expr_t * x;
+       x = list_args -> next;
+       oberon_check_src(ctx, x);
+       
+       if(!oberon_is_integer_type(x -> result))
+       {
+               oberon_error(ctx, "expect integer");
+       }
+
+       oberon_expr_t * expr;
+       expr = oberon_make_bin_op(ctx, MINUS, dst, oberon_new_operator(OP_RANGE, dst -> result, x, NULL));
+       oberon_assign(ctx, expr, dst);
+}
+
+static void
+oberon_make_dec_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
+{
+       if(num_args < 1)
+       {
+               oberon_error(ctx, "too few arguments");
+       }
+
+       if(num_args > 1)
+       {
+               oberon_error(ctx, "too mach arguments");
+       }
+
+       oberon_expr_t * dst;
+       dst = list_args;
+       oberon_check_dst(ctx, dst);
+
+       if(!oberon_is_integer_type(dst -> result))
+       {
+               oberon_error(ctx, "expect integer");
+       }
+
+       oberon_expr_t * expr;
+       expr = oberon_make_bin_op(ctx, MINUS, dst, oberon_make_integer(ctx, 1));
+       oberon_assign(ctx, expr, dst);
+}
+
 static void
 oberon_make_new_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
 {
@@ -4336,17 +4472,23 @@ oberon_create_context(ModuleImportCallback import_module)
        oberon_new_intrinsic(ctx, "CHR", oberon_make_chr_call, NULL);
        oberon_new_intrinsic(ctx, "ENTIER", oberon_make_entier_call, NULL);
        oberon_new_intrinsic(ctx, "LEN", oberon_make_len_call, NULL);
-       oberon_new_intrinsic(ctx, "MIN", oberon_make_min_call, NULL);
+       //oberon_new_intrinsic(ctx, "LONG", oberon_make_long_call, NULL);
        oberon_new_intrinsic(ctx, "MAX", oberon_make_max_call, NULL);
+       oberon_new_intrinsic(ctx, "MIN", oberon_make_min_call, NULL);
        oberon_new_intrinsic(ctx, "ODD", oberon_make_odd_call, NULL);
        oberon_new_intrinsic(ctx, "ORD", oberon_make_ord_call, NULL);
+       //oberon_new_intrinsic(ctx, "SHORT", oberon_make_short_call, NULL);
        oberon_new_intrinsic(ctx, "SIZE", oberon_make_size_call, NULL);
 
        /* Procedures */
-       oberon_new_intrinsic(ctx, "NEW", NULL, oberon_make_new_call);
-       oberon_new_intrinsic(ctx, "COPY", NULL, oberon_make_copy_call);
        oberon_new_intrinsic(ctx, "ASSERT", NULL, oberon_make_assert_call);
+       oberon_new_intrinsic(ctx, "COPY", NULL, oberon_make_copy_call);
+       oberon_new_intrinsic(ctx, "DEC", NULL, oberon_make_dec_call);
+       oberon_new_intrinsic(ctx, "EXCL", NULL, oberon_make_excl_call);
        oberon_new_intrinsic(ctx, "HALT", NULL, oberon_make_halt_call);
+       oberon_new_intrinsic(ctx, "INC", NULL, oberon_make_inc_call);
+       oberon_new_intrinsic(ctx, "INCL", NULL, oberon_make_incl_call);
+       oberon_new_intrinsic(ctx, "NEW", NULL, oberon_make_new_call);
 
        return ctx;
 }