[COMMITTED] pkl: support for struct field pretty-printers

[Jose E. Marchesi]

It is often useful to pretty-print just some particular field of a
struct.  This patch adds support for field pretty-printers, which look
like:

  type Switch =
    struct
    {
      int<32> state;

      method _print_state = void:
      {
        printf ("#<%s>", state ? "on" : "off");
      }
    };

And then:

  (poke) .set pretty-print yes
  (poke) Switch { state = 1 }
  Switch {
    state=#<on>
  }

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

        * libpoke/pkl-typify.c (pkl_typify1_ps_decl): Check field
        pretty-printers.
        * libpoke/pkl-rt.pk (_pkl_print_format_any): Use field
        pretty-printers whenever available.
        * testsuite/poke.pkl/struct-field-pretty-print-diag-1.pk: New
        test.
        * testsuite/poke.pkl/struct-field-pretty-print-diag-2.pk:
        Likewise.
        * testsuite/poke.pkl/struct-field-pretty-print-1.pk: Likewise.
        * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
        * doc/poke.texi (Struct Pretty Printers): New section.
---
 ChangeLog                                     | 14 ++++
 doc/poke.texi                                 | 77 +++++++++++++++++++
 libpoke/pkl-rt.pk                             | 11 ++-
 libpoke/pkl-typify.c                          |  8 +-
 testsuite/Makefile.am                         |  3 +
 .../poke.pkl/struct-field-pretty-print-1.pk   | 13 ++++
 .../struct-field-pretty-print-diag-1.pk       |  8 ++
 .../struct-field-pretty-print-diag-2.pk       |  8 ++
 8 files changed, 138 insertions(+), 4 deletions(-)
 create mode 100644 testsuite/poke.pkl/struct-field-pretty-print-1.pk
 create mode 100644 testsuite/poke.pkl/struct-field-pretty-print-diag-1.pk
 create mode 100644 testsuite/poke.pkl/struct-field-pretty-print-diag-2.pk

diff --git a/ChangeLog b/ChangeLog
index c9c4d2b4..845b31de 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2023-01-27  Jose E. Marchesi  <jemarch@gnu.org>
+
+       * libpoke/pkl-typify.c (pkl_typify1_ps_decl): Check field
+       pretty-printers.
+       * libpoke/pkl-rt.pk (_pkl_print_format_any): Use field
+       pretty-printers whenever available.
+       * testsuite/poke.pkl/struct-field-pretty-print-diag-1.pk: New
+       test.
+       * testsuite/poke.pkl/struct-field-pretty-print-diag-2.pk:
+       Likewise.
+       * testsuite/poke.pkl/struct-field-pretty-print-1.pk: Likewise.
+       * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
+       * doc/poke.texi (Struct Pretty Printers): New section.
+
 2023-01-26  Jose E. Marchesi  <jemarch@gnu.org>
 
        * doc/poke.texi: get_time is now gettime.
diff --git a/doc/poke.texi b/doc/poke.texi
index 9dd1f9c2..8b10b3b7 100644
--- a/doc/poke.texi
+++ b/doc/poke.texi
@@ -10963,6 +10963,7 @@ They contain heterogeneous collections of values.
 * Casting Structs::            Converting structs from one type to another.
 * Declarations in Structs::    Declaring stuff within a struct.
 * Methods::                    Declaring struct methods.
+* Struct Pretty Printers::      Pretty-printing structs and fields.
 * Computed Fields::             Simulating fields with methods.
 * Struct Attributes::          Accessing properties of struct values.
 @end menu
@@ -12207,6 +12208,82 @@ Additionally, the containing struct can be referred 
explicitly under
 the name @code{SELF} in the body of the method.  @code{SELF} has type
 @code{any}.
 
+@node Struct Pretty Printers
+@subsection Struct Pretty Printers
+@cindex pretty printers, structs
+@cindex pretty printers, fields
+
+By default the printing statements will print a very detailed written
+representation of struct and union values.  This implies printing out
+every detail of every field.
+
+However, it is possible to change the written representation of a
+struct value by defining @dfn{pretty-printing methods}, which have
+prototypes:
+
+@example
+method _print = void: @{ @var{method_body} @}
+@end example
+
+@noindent
+If a struct or union type has a method called @code{_print}, then it
+is invoked every time a printed representation of the value shall be
+printed on the terminal.
+
+For example a value of a struct type:
+
+@example
+type Switch =
+  struct
+  @{
+    int<32> state;
+
+    method _print = void:
+    @{
+      printf "#<switch:%i32d>", state;
+    @}
+  @};
+@end example
+
+@noindent
+When printed when pretty-printers are active, will result in:
+
+@example
+(poke) .set pretty-print yes
+(poke) Switch @{ state = 1 @}
+#<switch:1>
+@end example
+
+Struct or union fields can also have pretty-printers defined for them:
+just define a method called @code{_print_@var{field_name}} to
+pretty-print a particular field.
+
+For example a value of a struct type:
+
+@example
+type Switch =
+  struct
+  @{
+    int<32> state;
+
+    method _print_state = void:
+    @{
+      printf ("#<%s>", state ? "on" : "off");
+    @}
+  @};
+@end example
+
+@noindent
+This will result in:
+
+@example
+(poke) .set pretty-print yes
+(poke) Switch @{ state = 1 @}
+Switch @{
+  state=#<on>
+@}
+@end example
+
 @node Computed Fields
 @subsection Computed Fields
 @cindex fields, computed
diff --git a/libpoke/pkl-rt.pk b/libpoke/pkl-rt.pk
index cdee3fd1..859a4550 100644
--- a/libpoke/pkl-rt.pk
+++ b/libpoke/pkl-rt.pk
@@ -1276,7 +1276,16 @@ immutable fun _pkl_print_format_any = (any val,
                 ctx.emit ("=");
               }
 
-            _pkl_print_format_any (field, ctx, depth + 1);
+            if (ctx.pretty_print_p
+                && vm_opprint
+                && field_name != ""
+                && asm int<32>: ("srefmnt; nn; nip3" : val, "_print_" + 
field_name))
+              {
+                /* Call the field pretty-printer.  */
+                asm ("srefmnt; nip; call; drop" :: val, "_print_" + 
field_name);
+              }
+            else
+              _pkl_print_format_any (field, ctx, depth + 1);
 
             /* Print field offset if required.  */
             if (vm_omaps)
diff --git a/libpoke/pkl-typify.c b/libpoke/pkl-typify.c
index 7df71a63..d0cc76c7 100644
--- a/libpoke/pkl-typify.c
+++ b/libpoke/pkl-typify.c
@@ -2710,7 +2710,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_decl)
   pkl_ast_node decl = PKL_PASS_NODE;
 
   /* If this is a declaration in a struct type, it is a function
-     declaration, and its name is _print, then its type should be
+     declaration, and its name is _print*, then its type should be
      ()void: */
   if (PKL_PASS_PARENT
       && PKL_AST_CODE (PKL_PASS_PARENT) == PKL_AST_TYPE
@@ -2718,8 +2718,9 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_decl)
       && PKL_AST_DECL_KIND (decl) == PKL_AST_DECL_KIND_FUNC)
     {
       pkl_ast_node decl_name = PKL_AST_DECL_NAME (decl);
+      const char *decl_name_str = PKL_AST_IDENTIFIER_POINTER (decl_name);
 
-      if (STREQ (PKL_AST_IDENTIFIER_POINTER (decl_name), "_print"))
+      if (strncmp (decl_name_str, "_print", 6) == 0)
         {
           pkl_ast_node initial = PKL_AST_DECL_INITIAL (decl);
           pkl_ast_node initial_type = PKL_AST_TYPE (initial);
@@ -2729,7 +2730,8 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_decl)
               || PKL_AST_TYPE_F_NARG (initial_type) != 0)
             {
               PKL_ERROR (PKL_AST_LOC (decl_name),
-                         "_print should be of type ()void");
+                         "%s should be of type ()void",
+                         decl_name_str);
               PKL_TYPIFY_PAYLOAD->errors++;
               PKL_PASS_ERROR;
             }
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index 96831b68..92bd58f6 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -2395,6 +2395,9 @@ EXTRA_DIST = \
   poke.pkl/strings-index-diag-1.pk \
   poke.pkl/strings-index-diag-2.pk \
   poke.pkl/strings-index-diag-3.pk \
+  poke.pkl/struct-field-pretty-print-1.pk \
+  poke.pkl/struct-field-pretty-print-diag-1.pk \
+  poke.pkl/struct-field-pretty-print-diag-2.pk \
   poke.pkl/struct-method-1.pk \
   poke.pkl/struct-method-2.pk \
   poke.pkl/struct-method-3.pk \
diff --git a/testsuite/poke.pkl/struct-field-pretty-print-1.pk 
b/testsuite/poke.pkl/struct-field-pretty-print-1.pk
new file mode 100644
index 00000000..c1c94092
--- /dev/null
+++ b/testsuite/poke.pkl/struct-field-pretty-print-1.pk
@@ -0,0 +1,13 @@
+/* { dg-do run } */
+
+type Foo =
+  struct
+  {
+    int i;
+    int j;
+    method _print_i = void: { print "#<lala>"; }
+  };
+
+/* { dg-command { .set pretty-print yes } } */
+/* { dg-command { Foo {} } } */
+/* { dg-output {Foo {i=#<lala>,j=0}} } */
diff --git a/testsuite/poke.pkl/struct-field-pretty-print-diag-1.pk 
b/testsuite/poke.pkl/struct-field-pretty-print-diag-1.pk
new file mode 100644
index 00000000..7ae50756
--- /dev/null
+++ b/testsuite/poke.pkl/struct-field-pretty-print-diag-1.pk
@@ -0,0 +1,8 @@
+/* { dg-do compile } */
+
+type Foo =
+  struct
+  {
+    int lala;
+    fun _print_lala = int: { return 0; } /* { dg-error "should be of type" } */
+  };
diff --git a/testsuite/poke.pkl/struct-field-pretty-print-diag-2.pk 
b/testsuite/poke.pkl/struct-field-pretty-print-diag-2.pk
new file mode 100644
index 00000000..9ed1fe51
--- /dev/null
+++ b/testsuite/poke.pkl/struct-field-pretty-print-diag-2.pk
@@ -0,0 +1,8 @@
+/* { dg-do compile } */
+
+type Foo =
+  struct
+  {
+    int lala;
+    fun _print_lala = (int a) void: { print "foo"; } /* { dg-error "should be 
of type" } */
+  };
-- 
2.30.2