[COMMITTED] pkl: do not expose EBOUND and SBOUN args in Pk_Type.mapper

[Jose E. Marchesi]

2023-01-22  Jose E. Marchesi  <jemarch@gnu.org>

        * libpoke/pkl-gen.pks (typifier_mapper_wrapper): New function.
        (array_typifier): Use typifier_mapper_wrapper.
        (struct_typifier): Likewise.
        * libpoke/pkl-rt.pk (Pk_type): Do not expose ebound and sbound in
        the mapper closure.
        * doc/poke.texi (typeof): Update accordingly.
        * testsuite/poke.pkl/typeof-27.pk: New test.
        * testsuite/Makefile.am (EXTRA_DIST): Add new test.
---
 ChangeLog                       | 11 ++++++
 doc/poke.texi                   |  6 +---
 libpoke/pkl-gen.pks             | 61 +++++++++++++++++++++++++++++++++
 libpoke/pkl-rt.pk               | 12 +++----
 testsuite/Makefile.am           |  1 +
 testsuite/poke.pkl/typeof-27.pk |  7 ++++
 6 files changed, 86 insertions(+), 12 deletions(-)
 create mode 100644 testsuite/poke.pkl/typeof-27.pk

diff --git a/ChangeLog b/ChangeLog
index 33016a89..989942bb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2023-01-22  Jose E. Marchesi  <jemarch@gnu.org>
+
+       * libpoke/pkl-gen.pks (typifier_mapper_wrapper): New function.
+       (array_typifier): Use typifier_mapper_wrapper.
+       (struct_typifier): Likewise.
+       * libpoke/pkl-rt.pk (Pk_type): Do not expose ebound and sbound in
+       the mapper closure.
+       * doc/poke.texi (typeof): Update accordingly.
+       * testsuite/poke.pkl/typeof-27.pk: New test.
+       * testsuite/Makefile.am (EXTRA_DIST): Add new test.
+
 2023-01-22  Jose E. Marchesi  <jemarch@gnu.org>
 
        * doc/poke.texi (typeof): New section.
diff --git a/doc/poke.texi b/doc/poke.texi
index 941728d8..7f495fc6 100644
--- a/doc/poke.texi
+++ b/doc/poke.texi
@@ -12588,15 +12588,11 @@ The following fields are provided in @code{Pk_Type} 
only for struct
 and array types:
 
 @table @code
-@item (int<32>,int<32>,uint<64>,uint<64>,uint<64>)any mapper
+@item (int<32>,int<32>,uint<64>)any mapper
 Closure that, when passed an integer predicate denoting whether to do
 a strict mapping, an IO space identifier, a bit-offset in the given IO
 space, map a value of the described type.
 
-The last two arguments of the closure are ignored by mappers of struct
-types.  Mappers of array types interpret the last two arguments as a
-number of elements bound and a size bound, respectively.
-
 @item (any)void writer
 Closure that, when passed a mapped value of the described type, writes
 the contents of the value to the corresponding IO space.
diff --git a/libpoke/pkl-gen.pks b/libpoke/pkl-gen.pks
index fd972317..21f52771 100644
--- a/libpoke/pkl-gen.pks
+++ b/libpoke/pkl-gen.pks
@@ -3029,6 +3029,55 @@
         return
         .end
 
+;;; RAS_FUNCTION_TYPIFIER_MAPPER_WRAPPER @type #mapper
+;;; ( STRICT_P IOS BOFFSET -- ANY )
+;;;
+;;; Assemble a function that calls the mapper of the given type
+;;; using the provided arguments, plus the right ebound and sbound
+;;; arguments extracted from the given type.
+;;;
+;;; This is to hide ebound and sbound from the mapper field in
+;;; the Pk_Type struct, which are not useful at the Poke level.
+;;;
+;;; Macro arguments:
+;;; @type is an AST node with the type of the entity to be
+;;; mapped, which can be either an array or a struct.
+;;;
+;;; #mapper is a closure with the mapper function to invoke.
+
+        .function typifier_mapper_wrapper @type #mapper
+        prolog
+        ;; Expand the argument list with EBOUND and SBOUND
+        ;; from the given type.
+   .c if (PKL_AST_TYPE_CODE (@type) == PKL_TYPE_STRUCT)
+   .c {
+        push null               ; ... EBOUND
+        push null               ; ... EBOUND SBOUND
+   .c }
+   .c else
+   .c {
+   .c    assert (PKL_AST_TYPE_CODE (@type) == PKL_TYPE_ARRAY);
+        .let @type_bound = PKL_AST_TYPE_A_BOUND (@type)
+        .let #ebound =                                                       \
+          (@type_bound && PKL_AST_TYPE_CODE (PKL_AST_TYPE (@type_bound)) == 
PKL_TYPE_INTEGRAL) \
+          ? PKL_AST_TYPE_A_BOUNDER (@type) : PVM_NULL
+        .let #sbound =                                                       \
+          (@type_bound && PKL_AST_TYPE_CODE (PKL_AST_TYPE (@type_bound)) == 
PKL_TYPE_OFFSET) \
+          ? PKL_AST_TYPE_A_BOUNDER (@type) : PVM_NULL
+        push #ebound
+   .c if (#ebound != PVM_NULL)
+        call
+        push #sbound
+   .c if (#sbound != PVM_NULL)
+        call
+   .c }
+        ;; Call the mapper.
+                                ; STRICT_P IOS BOFFSET EBOUND SBOUND
+        push #mapper
+        call
+        return
+        .end
+
 ;;; RAS_FUNCTION_TYPIFIER_ANY_ANY_INT_WRAPPER @type
 ;;; ( VAL VAL -- INT )
 ;;;
@@ -3090,8 +3139,14 @@
         .let #mapper = PKL_AST_TYPE_A_MAPPER (@type)
  .c if (#mapper != PVM_NULL)
  .c {
+ .c     pvm_val mapper_closure;
+        .let #function = PKL_AST_TYPE_A_MAPPER (@type)
+  .c    RAS_FUNCTION_TYPIFIER_MAPPER_WRAPPER (mapper_closure,
+  .c                                          @type, #function);
+        .let #mapper = mapper_closure
         push "mapper"
         push #mapper
+        pec
         sset
   .c }
   .c if (PKL_AST_TYPE_A_WRITER (@type) != PVM_NULL)
@@ -3158,8 +3213,14 @@
         .let #mapper = PKL_AST_TYPE_S_MAPPER (@type)
  .c if (#mapper != PVM_NULL)
  .c {
+ .c     pvm_val mapper_closure;
+        .let #function = PKL_AST_TYPE_S_MAPPER (@type)
+  .c    RAS_FUNCTION_TYPIFIER_MAPPER_WRAPPER (mapper_closure,
+  .c                                          @type, #function);
+        .let #mapper = mapper_closure
         push "mapper"
         push #mapper
+        pec
         sset
   .c }
   .c if (PKL_AST_TYPE_S_WRITER (@type) != PVM_NULL)
diff --git a/libpoke/pkl-rt.pk b/libpoke/pkl-rt.pk
index f81b17f6..35fb1b58 100644
--- a/libpoke/pkl-rt.pk
+++ b/libpoke/pkl-rt.pk
@@ -647,13 +647,11 @@ immutable type Pk_Type =
     string[] mnames     if code == PK_TYPE_STRUCT;
     string[] mtypes     if code == PK_TYPE_STRUCT;
 
-    type Mapper_Fn = (int<32>,int<32>,uint<64>,uint<64>,uint<64>)any;
-
-    Mapper_Fn mapper             if code in [PK_TYPE_ARRAY, PK_TYPE_STRUCT];
-    (any)void writer             if code in [PK_TYPE_ARRAY, PK_TYPE_STRUCT];
-    (any)any integrator          if code in [PK_TYPE_ARRAY, PK_TYPE_STRUCT];
-    (any)any deintegrator        if code == PK_TYPE_STRUCT;
-    (any,any)int<32> comparator  if code == PK_TYPE_STRUCT;
+    (int<32>,int<32>,uint<64>)any mapper if code in [PK_TYPE_ARRAY, 
PK_TYPE_STRUCT];
+    (any)void writer                     if code in [PK_TYPE_ARRAY, 
PK_TYPE_STRUCT];
+    (any)any integrator                  if code in [PK_TYPE_ARRAY, 
PK_TYPE_STRUCT];
+    (any)any deintegrator                if code == PK_TYPE_STRUCT;
+    (any,any)int<32> comparator          if code == PK_TYPE_STRUCT;
   };
 
 /* Tracing.
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index 813a1e35..7afd92e2 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -2567,6 +2567,7 @@ EXTRA_DIST = \
   poke.pkl/typeof-24.pk \
   poke.pkl/typeof-25.pk \
   poke.pkl/typeof-26.pk \
+  poke.pkl/typeof-27.pk \
   poke.pkl/typeof-array-1.pk \
   poke.pkl/typeof-array-2.pk \
   poke.pkl/typeof-int-1.pk \
diff --git a/testsuite/poke.pkl/typeof-27.pk b/testsuite/poke.pkl/typeof-27.pk
new file mode 100644
index 00000000..f45f59ea
--- /dev/null
+++ b/testsuite/poke.pkl/typeof-27.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+
+type Foo = int[12#B][3];
+
+/* { dg-command {.mem} } */
+/* { dg-command { typeof (Foo).mapper (1, 0, 0) } } */
+/* { dg-output {\[\[0,0,0\],\[0,0,0\],\[0,0,0\]\]} } */
-- 
2.30.2