[PATCH] pkl: make apush/apop applicable to unbounded arrays

[Mohammad-Reza Nabipoor]

2023-01-23  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>

        * libpoke/pkl-anal.c (pkl_anal2_ps_op_apush_apop): New phase for
        compile-time check of `apush' and `apop' operations on arrays;
        emit compile-time error unless the array is unbounded.
        (pkl_phase_anal2): Add new phases for `PKL_AST_OP_A{PUSH,POP}'.
        * testsuite/poke.pkl/apush-diag-4.pk: New test.
        * testsuite/poke.pkl/apush-diag-5.pk: Likewise.
        * testsuite/poke.pkl/apop-diag-2.pk: Likewise.
        * testsuite/poke.pkl/apop-diag-3.pk: Likewise.
        * testsuite/poke.pkl/apop-1.pk: Adapt.
        * testsuite/poke.pkl/apush-1.pk: Likewise.
        * testsuite/poke.pkl/apush-2.pk: Likewise.
        * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
---

Hi Jose.

I think this is the safest thing to do.
Compiler will reject anything bounded.

And also I think we don't need any runtime check, do we?


Regards,
Mohammad-Reza


 ChangeLog                          | 15 +++++++++++++++
 libpoke/pkl-anal.c                 | 26 ++++++++++++++++++++++++++
 testsuite/Makefile.am              |  4 ++++
 testsuite/poke.pkl/apop-1.pk       |  2 +-
 testsuite/poke.pkl/apop-diag-2.pk  |  5 +++++
 testsuite/poke.pkl/apop-diag-3.pk  |  5 +++++
 testsuite/poke.pkl/apush-1.pk      |  2 +-
 testsuite/poke.pkl/apush-2.pk      |  2 +-
 testsuite/poke.pkl/apush-diag-4.pk |  5 +++++
 testsuite/poke.pkl/apush-diag-5.pk |  5 +++++
 10 files changed, 68 insertions(+), 3 deletions(-)
 create mode 100644 testsuite/poke.pkl/apop-diag-2.pk
 create mode 100644 testsuite/poke.pkl/apop-diag-3.pk
 create mode 100644 testsuite/poke.pkl/apush-diag-4.pk
 create mode 100644 testsuite/poke.pkl/apush-diag-5.pk

diff --git a/ChangeLog b/ChangeLog
index d40ffc62..afebf003 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2023-01-23  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
+
+       * libpoke/pkl-anal.c (pkl_anal2_ps_op_apush_apop): New phase for
+       compile-time check of `apush' and `apop' operations on arrays;
+       emit compile-time error unless the array is unbounded.
+       (pkl_phase_anal2): Add new phases for `PKL_AST_OP_A{PUSH,POP}'.
+       * testsuite/poke.pkl/apush-diag-4.pk: New test.
+       * testsuite/poke.pkl/apush-diag-5.pk: Likewise.
+       * testsuite/poke.pkl/apop-diag-2.pk: Likewise.
+       * testsuite/poke.pkl/apop-diag-3.pk: Likewise.
+       * testsuite/poke.pkl/apop-1.pk: Adapt.
+       * testsuite/poke.pkl/apush-1.pk: Likewise.
+       * testsuite/poke.pkl/apush-2.pk: Likewise.
+       * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
+
 2023-01-23  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
 
        * libpoke/pvm.jitter (time): Change the instruction to push
diff --git a/libpoke/pkl-anal.c b/libpoke/pkl-anal.c
index dac71b31..180c7453 100644
--- a/libpoke/pkl-anal.c
+++ b/libpoke/pkl-anal.c
@@ -1109,6 +1109,30 @@ PKL_PHASE_BEGIN_HANDLER (pkl_anal2_ps_ass_stmt)
 }
 PKL_PHASE_END_HANDLER
 
+/* Make sure that apush/apop is not applied to an array with
+   fixed size boundary.  */
+
+PKL_PHASE_BEGIN_HANDLER (pkl_anal2_ps_op_apush_apop)
+{
+  pkl_ast_node exp = PKL_PASS_NODE;
+  pkl_ast_node arr = PKL_AST_EXP_OPERAND (exp, 0);
+  pkl_ast_node arr_type = PKL_AST_TYPE (arr);
+  pkl_ast_node arr_type_bound = PKL_AST_TYPE_A_BOUND (arr_type);
+
+  if (arr_type_bound)
+    {
+      if (PKL_AST_EXP_CODE (exp) == PKL_AST_OP_APUSH)
+        PKL_ERROR (PKL_AST_LOC (exp),
+                   "apush operation is not allowed on a bounded array");
+      else if (PKL_AST_EXP_CODE (exp) == PKL_AST_OP_APOP)
+        PKL_ERROR (PKL_AST_LOC (exp),
+                   "apop operation is not allowed on a bounded array");
+      PKL_ANAL_PAYLOAD->errors++;
+      PKL_PASS_ERROR;
+    }
+}
+PKL_PHASE_END_HANDLER
+
 struct pkl_phase pkl_phase_anal2 =
   {
    PKL_PHASE_PS_HANDLER (PKL_AST_SRC, pkl_anal_ps_src),
@@ -1126,6 +1150,8 @@ struct pkl_phase pkl_phase_anal2 =
    PKL_PHASE_PS_HANDLER (PKL_AST_STRUCT_REF, pkl_anal2_ps_struct_ref),
    PKL_PHASE_PS_HANDLER (PKL_AST_ASS_STMT, pkl_anal2_ps_ass_stmt),
    PKL_PHASE_PS_TYPE_HANDLER (PKL_TYPE_STRUCT, pkl_anal2_ps_type_struct),
+   PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_APUSH, pkl_anal2_ps_op_apush_apop),
+   PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_APOP, pkl_anal2_ps_op_apush_apop),
   };
 
 
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index 35ab2bd4..4165849d 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -735,11 +735,15 @@ EXTRA_DIST = \
   poke.pkl/apop-1.pk \
   poke.pkl/apop-2.pk \
   poke.pkl/apop-diag-1.pk \
+  poke.pkl/apop-diag-2.pk \
+  poke.pkl/apop-diag-3.pk \
   poke.pkl/apush-1.pk \
   poke.pkl/apush-2.pk \
   poke.pkl/apush-diag-1.pk \
   poke.pkl/apush-diag-2.pk \
   poke.pkl/apush-diag-3.pk \
+  poke.pkl/apush-diag-4.pk \
+  poke.pkl/apush-diag-5.pk \
   poke.pkl/array-1.pk \
   poke.pkl/array-2.pk \
   poke.pkl/array-bound-1.pk \
diff --git a/testsuite/poke.pkl/apop-1.pk b/testsuite/poke.pkl/apop-1.pk
index fbb54bb5..878acdc3 100644
--- a/testsuite/poke.pkl/apop-1.pk
+++ b/testsuite/poke.pkl/apop-1.pk
@@ -1,6 +1,6 @@
 /* { dg-do run } */
 
-/* { dg-command {var a = [1,2,3] } } */
+/* { dg-command {var a = [1,2,3] as int[]} } */
 /* { dg-command {apop (a)} } */
 /* { dg-output "3" } */
 /* { dg-command {a} } */
diff --git a/testsuite/poke.pkl/apop-diag-2.pk 
b/testsuite/poke.pkl/apop-diag-2.pk
new file mode 100644
index 00000000..336d92dd
--- /dev/null
+++ b/testsuite/poke.pkl/apop-diag-2.pk
@@ -0,0 +1,5 @@
+/* { dg-do compile } */
+
+var a = int[2] ();
+
+apop (a); /* { dg-error "apop operation is not allowed" } */
diff --git a/testsuite/poke.pkl/apop-diag-3.pk 
b/testsuite/poke.pkl/apop-diag-3.pk
new file mode 100644
index 00000000..9c915d99
--- /dev/null
+++ b/testsuite/poke.pkl/apop-diag-3.pk
@@ -0,0 +1,5 @@
+/* { dg-do compile } */
+
+var a = int[12#B] ();
+
+apop (a); /* { dg-error "apop operation is not allowed" } */
diff --git a/testsuite/poke.pkl/apush-1.pk b/testsuite/poke.pkl/apush-1.pk
index 66723ab6..e35af5a4 100644
--- a/testsuite/poke.pkl/apush-1.pk
+++ b/testsuite/poke.pkl/apush-1.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command {apush (apush ([1,2,3], 4), 5)} } */
+/* { dg-command {apush (apush ([1,2,3] as int[], 4), 5)} } */
 /* { dg-output "\\\[1,2,3,4,5\\\]" } */
diff --git a/testsuite/poke.pkl/apush-2.pk b/testsuite/poke.pkl/apush-2.pk
index 51268c3a..19a52733 100644
--- a/testsuite/poke.pkl/apush-2.pk
+++ b/testsuite/poke.pkl/apush-2.pk
@@ -1,4 +1,4 @@
 /* { dg-do run } */
 
-/* { dg-command {apush (apush ([[1],[2],[3]], [4]), [5])} } */
+/* { dg-command {apush (apush ([[1],[2],[3]] as int[1][], [4]), [5])} } */
 /* { dg-output "\\\[\\\[1\\\],\\\[2\\\],\\\[3\\\],\\\[4\\\],\\\[5\\\]\\\]" } */
diff --git a/testsuite/poke.pkl/apush-diag-4.pk 
b/testsuite/poke.pkl/apush-diag-4.pk
new file mode 100644
index 00000000..d172429c
--- /dev/null
+++ b/testsuite/poke.pkl/apush-diag-4.pk
@@ -0,0 +1,5 @@
+/* { dg-do compile } */
+
+var a = int[3] ();
+
+apush (a, 1); /* { dg-error "apush operation is not allowed" } */
diff --git a/testsuite/poke.pkl/apush-diag-5.pk 
b/testsuite/poke.pkl/apush-diag-5.pk
new file mode 100644
index 00000000..d748e77b
--- /dev/null
+++ b/testsuite/poke.pkl/apush-diag-5.pk
@@ -0,0 +1,5 @@
+/* { dg-do compile } */
+
+var a = int[8#B] ();
+
+apush (a, 0); /* { dg-error "apush operation is not allowed" } */
-- 
2.39.1