[COMMITTED] libpoke: add services pk_set_debug_p and pk_get_debug_ast to libpoke

[Jose E. Marchesi]

This patch adds a debug_p flag to the Poke incremental compiler.  If
set, the compiler runs in "debug mode", which at the moment means it
builds a textual representation of the abstract syntax tree of the
last compiled program/expression/statement and to save it.  Services
are added to libpoke to set or clear the debug mode in the compiler,
and to fetch this AST textual representation.

2023-10-29  Jose E. Marchesi  <jemarch@gnu.org>

        * libpoke/pkl.h: Prototypes for pkl_debug_p, pkl_set_debug_p and
        pkl_get_last_ast_str.
        * libpoke/pkl.c (struct pkl_compiler): New fields debug_p and
        last_ast_str.
        (pkl_new): Initialize debug_p and last_ast_str.
        (pkl_debug_p): New function.
        (pkl_set_debug_p): Likewise.
        (pkl_get_last_ast_str): Likewise.
        (pkl_free): Free last_ast_str.
        (rest_of_compilation): Save printable representation of the ast if
        in debug mode.
        * libpoke/libpoke.h: New services pk_set_debug_p and
        pk_get_debug_ast.
        * libpoke/libpoke.c (pk_set_debug_p): New function.
        (pk_get_debug_ast): Likewise.
        * libpoke/pkl-ast.h: Add prototype of pkl_ast_format.
        * libpoke/pkl-ast.c (pkl_ast_format): New function.
        (pkl_ast_print): Rewrite in terms of pkl_ast_format.
        (pkl_ast_format_1): Rename from pkl_ast_print_1.
---
 ChangeLog         | 22 ++++++++++++++++++++++
 libpoke/libpoke.c | 13 +++++++++++++
 libpoke/libpoke.h | 16 ++++++++++++++++
 libpoke/pkl-ast.c | 37 ++++++++++++++++++++++++++++---------
 libpoke/pkl-ast.h |  1 +
 libpoke/pkl.c     | 31 +++++++++++++++++++++++++++++++
 libpoke/pkl.h     | 15 ++++++++++++++-
 7 files changed, 125 insertions(+), 10 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 302043d4..d733e59e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,25 @@
+2023-10-29  Jose E. Marchesi  <jemarch@gnu.org>
+
+       * libpoke/pkl.h: Prototypes for pkl_debug_p, pkl_set_debug_p and
+       pkl_get_last_ast_str.
+       * libpoke/pkl.c (struct pkl_compiler): New fields debug_p and
+       last_ast_str.
+       (pkl_new): Initialize debug_p and last_ast_str.
+       (pkl_debug_p): New function.
+       (pkl_set_debug_p): Likewise.
+       (pkl_get_last_ast_str): Likewise.
+       (pkl_free): Free last_ast_str.
+       (rest_of_compilation): Save printable representation of the ast if
+       in debug mode.
+       * libpoke/libpoke.h: New services pk_set_debug_p and
+       pk_get_debug_ast.
+       * libpoke/libpoke.c (pk_set_debug_p): New function.
+       (pk_get_debug_ast): Likewise.
+       * libpoke/pkl-ast.h: Add prototype of pkl_ast_format.
+       * libpoke/pkl-ast.c (pkl_ast_format): New function.
+       (pkl_ast_print): Rewrite in terms of pkl_ast_format.
+       (pkl_ast_format_1): Rename from pkl_ast_print_1.
+
 2023-10-28  Jose E. Marchesi  <jemarch@gnu.org>
 
        * poke/pk-cmd-ios.c (print_info_ios): Do not style `size' and
diff --git a/libpoke/libpoke.c b/libpoke/libpoke.c
index 9b463cc6..57d28828 100644
--- a/libpoke/libpoke.c
+++ b/libpoke/libpoke.c
@@ -245,6 +245,19 @@ pk_set_quiet_p (pk_compiler pkc, int quiet_p)
   pkc->status = PK_OK;
 }
 
+void
+pk_set_debug_p (pk_compiler pkc, int debug_p)
+{
+  pkl_set_debug_p (pkc->compiler, debug_p);
+  pkc->status = PK_OK;
+}
+
+const char *
+pk_get_debug_ast (pk_compiler pkc)
+{
+  return pkl_get_last_ast_str (pkc->compiler);
+}
+
 void
 pk_set_lexical_cuckolding_p (pk_compiler pkc, int lexical_cuckolding_p)
 {
diff --git a/libpoke/libpoke.h b/libpoke/libpoke.h
index e36fa48e..988df231 100644
--- a/libpoke/libpoke.h
+++ b/libpoke/libpoke.h
@@ -348,6 +348,22 @@ void pk_reset_profile (pk_compiler pkc) LIBPOKE_API;
 
 void pk_set_quiet_p (pk_compiler pkc, int quiet_p) LIBPOKE_API;
 
+/* Set the DEBUG_P flag in the compiler.  If this flag is set, the
+   incremental compiler:
+
+   - Creates and saves the abstract syntax tree (AST) intermediate
+     representation of the last compiled program, expression or
+     statement, whose textual representation is then available using
+     the pk_get_debug_ast service.  */
+
+void pk_set_debug_p (pk_compiler pkc, int debug_p) LIBPOKE_API;
+
+/* Get a printable representation of the last program, expression or
+   statement compiled in debug mode.  This function returns NULL if no
+   such program has been compiled.  */
+
+const char *pk_get_debug_ast (pk_compiler pkc) LIBPOKE_API;
+
 /* Install a handler for alien tokens in the incremental compiler.
    The handler gets a string with the token identifier (for $foo it
    would get `foo') and should return a pk_alien_token struct with the
diff --git a/libpoke/pkl-ast.c b/libpoke/pkl-ast.c
index 17191879..e6dca852 100644
--- a/libpoke/pkl-ast.c
+++ b/libpoke/pkl-ast.c
@@ -3150,10 +3150,10 @@ pkl_ast_handle_bconc_ass_stmt (pkl_ast ast, 
pkl_ast_node ass_stmt)
       int i;                                    \
       for (i = 0; i < indent; i++)              \
         if (indent >= 2 && i % 2 == 0)          \
-          fprintf (fp, "|");                    \
+          sb_append (buffer, "|");              \
         else                                    \
-          fprintf (fp, " ");                    \
-      fprintf (fp, __VA_ARGS__);                \
+          sb_append (buffer, " ");              \
+      sb_appendf (buffer, __VA_ARGS__);         \
     } while (0)
 
 #define PRINT_AST_IMM(NAME,MACRO,FMT)                    \
@@ -3168,7 +3168,7 @@ pkl_ast_handle_bconc_ass_stmt (pkl_ast ast, pkl_ast_node 
ass_stmt)
   do                                                            \
     {                                                           \
       IPRINTF (#NAME ":\n");                                    \
-      pkl_ast_print_1 (fp, PKL_AST_##MACRO (ast), indent + 2);  \
+      pkl_ast_format_1 (buffer, PKL_AST_##MACRO (ast), indent + 2); \
     }                                                           \
   while (0)
 
@@ -3189,13 +3189,14 @@ pkl_ast_handle_bconc_ass_stmt (pkl_ast ast, 
pkl_ast_node ass_stmt)
        child;                                   \
        child = PKL_AST_CHAIN (child))           \
     {                                           \
-      pkl_ast_print_1 (fp, child, indent + 2);  \
+      pkl_ast_format_1 (buffer, child, indent + 2); \
     }
 
 /* Auxiliary function used by `pkl_ast_print', defined below.  */
 
 static void
-pkl_ast_print_1 (FILE *fp, pkl_ast_node ast, int indent)
+pkl_ast_format_1 (struct string_buffer *buffer,
+                  pkl_ast_node ast, int indent)
 {
   pkl_ast_node child;
   size_t i;
@@ -3285,8 +3286,8 @@ pkl_ast_print_1 (FILE *fp, pkl_ast_node ast, int indent)
         PRINT_AST_IMM (numops, EXP_NUMOPS, "%d");
         IPRINTF ("operands:\n");
         for (i = 0; i < PKL_AST_EXP_NUMOPS (ast); i++)
-          pkl_ast_print_1 (fp, PKL_AST_EXP_OPERAND (ast, i),
-                         indent + 2);
+          pkl_ast_format_1 (buffer, PKL_AST_EXP_OPERAND (ast, i),
+                            indent + 2);
         break;
       }
 
@@ -3755,6 +3756,18 @@ pkl_ast_print_1 (FILE *fp, pkl_ast_node ast, int indent)
     }
 }
 
+/* Allocate a string with the printable representation of AST.  If
+   there is an error such as out of memory, return NULL.  */
+
+char *
+pkl_ast_format (pkl_ast_node ast)
+{
+  struct string_buffer buffer;
+
+  pkl_ast_format_1 (&buffer, ast, 0);
+  return sb_dupfree (&buffer);
+}
+
 /* Dump a printable representation of AST to the file descriptor FD.
    This function is intended to be useful to debug the PKL
    compiler.  */
@@ -3762,7 +3775,13 @@ pkl_ast_print_1 (FILE *fp, pkl_ast_node ast, int indent)
 void
 pkl_ast_print (FILE *fp, pkl_ast_node ast)
 {
-  pkl_ast_print_1 (fp, ast, 0);
+  char *str = pkl_ast_format (ast);
+
+  if (str == NULL)
+    /* The only possible error here is out-of-memory.  */
+    xalloc_die ();
+  fprintf (fp, str);
+  free (str);
 }
 
 #undef IPRINTF
diff --git a/libpoke/pkl-ast.h b/libpoke/pkl-ast.h
index f982ab19..e7f4794e 100644
--- a/libpoke/pkl-ast.h
+++ b/libpoke/pkl-ast.h
@@ -2193,6 +2193,7 @@ void pkl_ast_node_free_chain (pkl_ast_node ast);
 
 pkl_ast_node pkl_ast_reverse (pkl_ast_node ast);
 
+char *pkl_ast_format (pkl_ast_node ast);
 void pkl_ast_print (FILE *fp, pkl_ast_node ast);
 
 char *pkl_ast_format_loc (pkl_ast ast, pkl_ast_loc loc);
diff --git a/libpoke/pkl.c b/libpoke/pkl.c
index ce789212..1f15c464 100644
--- a/libpoke/pkl.c
+++ b/libpoke/pkl.c
@@ -71,6 +71,8 @@ struct pkl_compiler
   int compiling;
   int error_on_warning;
   int quiet_p;
+  int debug_p;
+  char *last_ast_str;
 #define PKL_MODULES_STEP 8
   int lexical_cuckolding_p;
   pkl_alien_token_handler_fn alien_token_fn;
@@ -125,6 +127,10 @@ pkl_new (pvm vm, const char *rt_path,
   /* Be verbose by default :) */
   compiler->quiet_p = 0;
 
+  /* No debug by default.  */
+  compiler->debug_p = 0;
+  compiler->last_ast_str = NULL;
+
   /* Bootstrap the compiler.  An error bootstraping is an internal
      error and should be reported as such.  */
   {
@@ -185,6 +191,7 @@ void
 pkl_free (pkl_compiler compiler)
 {
   pkl_env_free (compiler->env);
+  free (compiler->last_ast_str);
   free (compiler);
 }
 
@@ -298,6 +305,12 @@ rest_of_compilation (pkl_compiler compiler,
   if (analf_payload.errors > 0)
     goto error;
 
+  if (compiler->debug_p)
+    {
+      free (compiler->last_ast_str);
+      compiler->last_ast_str = pkl_ast_format (ast->ast);
+    }
+
   pkl_ast_free (ast);
   return gen_payload.program;
 
@@ -635,6 +648,24 @@ pkl_set_quiet_p (pkl_compiler compiler, int quiet_p)
   compiler->quiet_p = quiet_p;
 }
 
+int
+pkl_debug_p (pkl_compiler compiler)
+{
+  return compiler->debug_p;
+}
+
+void
+pkl_set_debug_p (pkl_compiler compiler, int debug_p)
+{
+  compiler->debug_p = debug_p;
+}
+
+char *
+pkl_get_last_ast_str (pkl_compiler compiler)
+{
+  return compiler->last_ast_str;
+}
+
 int
 pkl_lexical_cuckolding_p (pkl_compiler compiler)
 {
diff --git a/libpoke/pkl.h b/libpoke/pkl.h
index 205f0132..3a650f6f 100644
--- a/libpoke/pkl.h
+++ b/libpoke/pkl.h
@@ -219,9 +219,22 @@ int pkl_tracer_p (pkl_compiler compiler);
    set, the compiler emits as few output as possible.  */
 
 int pkl_quiet_p (pkl_compiler compiler);
-
 void pkl_set_quiet_p (pkl_compiler compiler, int quiet_p);
 
+/* Set/get the debug_p flag in/from the compiler.  */
+
+int pkl_debug_p (pkl_compiler compiler);
+void pkl_set_debug_p (pkl_compiler compiler, int debug_p);
+
+/* Get the printable representation of the AST corresponding to the
+   last compiled program, expression or statement.  If nothing has
+   been compiled yet then return NULL.
+
+   Note that this printable representation is only recorded when the
+   compiler compiles in debug mode, i.e. when debug_p is true.  */
+
+char *pkl_get_last_ast_str (pkl_compiler compiler);
+
 /* Get/install a handler for alien tokens.  */
 
 #define PKL_ALIEN_TOKEN_IDENTIFIER 0
-- 
2.30.2