[PATCH v3] poke: add new dot-command .bases

[Mohammad-Reza Nabipoor]

2024-09-27  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>

        * poke/pk-cmd-misc.c ("pk-repl.h"): New include for
        `poke_completion_function'.
        (pk_cmd_bases): New function to implement
        `.bases' dot-command.
        (bases_cmd): New variable.
        * poke/pk-cmd-misc.pk (pk_cmd_bases): New Poke function.
        * poke/pk-cmd.c (dot_cmds): Register the new dot-command.
        * testsuite/poke.cmd/bases-1.pk: New test.
        * testsuite/poke.cmd/bases-2.pk: Likewise.
        * testsuite/poke.cmd/bases-3.pk: Likewise.
        * testsuite/poke.cmd/bases-4.pk: Likewise.
        * testsuite/Makefile.am (EXTRA_DIST): Update.
        * doc/poke.texi (Dot-Commands): Add doc for new dot-command.
        * poke/pk-cmd-help.pk: Document new dot-command.
---

Hi Jose.

On Fri, Sep 27, 2024 at 10:15:59AM GMT, Jose E. Marchesi wrote:
> >    {"doc", "?s", "", 0, NULL, NULL, pk_cmd_doc, ".doc [section]", 
> > doc_completion_function};
> > +
> > +const struct pk_cmd bases_cmd =
> > +  {"bases", "s", "", 0, NULL, NULL, pk_cmd_bases, ".bases EXPR", NULL};
> 
> You want to auto-complete in the Poke expression using
> poke_completion_function.
> 

Fixed :)
Thanks.



 ChangeLog                     | 17 +++++++++++
 doc/poke.texi                 | 16 ++++++++++
 poke/pk-cmd-help.pk           |  9 ++++++
 poke/pk-cmd-misc.c            | 55 +++++++++++++++++++++++++++++++++++
 poke/pk-cmd-misc.pk           | 27 +++++++++++++++++
 poke/pk-cmd.c                 |  2 ++
 testsuite/Makefile.am         |  4 +++
 testsuite/poke.cmd/bases-1.pk |  4 +++
 testsuite/poke.cmd/bases-2.pk |  4 +++
 testsuite/poke.cmd/bases-3.pk |  5 ++++
 testsuite/poke.cmd/bases-4.pk |  5 ++++
 11 files changed, 148 insertions(+)
 create mode 100644 testsuite/poke.cmd/bases-1.pk
 create mode 100644 testsuite/poke.cmd/bases-2.pk
 create mode 100644 testsuite/poke.cmd/bases-3.pk
 create mode 100644 testsuite/poke.cmd/bases-4.pk

diff --git a/ChangeLog b/ChangeLog
index e8f99c49..a0094177 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,20 @@
+2024-09-27  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
+
+       * poke/pk-cmd-misc.c ("pk-repl.h"): New include for
+       `poke_completion_function'.
+       (pk_cmd_bases): New function to implement
+       `.bases' dot-command.
+       (bases_cmd): New variable.
+       * poke/pk-cmd-misc.pk (pk_cmd_bases): New Poke function.
+       * poke/pk-cmd.c (dot_cmds): Register the new dot-command.
+       * testsuite/poke.cmd/bases-1.pk: New test.
+       * testsuite/poke.cmd/bases-2.pk: Likewise.
+       * testsuite/poke.cmd/bases-3.pk: Likewise.
+       * testsuite/poke.cmd/bases-4.pk: Likewise.
+       * testsuite/Makefile.am (EXTRA_DIST): Update.
+       * doc/poke.texi (Dot-Commands): Add doc for new dot-command.
+       * poke/pk-cmd-help.pk: Document new dot-command.
+
 2024-09-25  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
 
        * doc/learn-poke-language-in-y-minutes.pk: Update and add a few
diff --git a/doc/poke.texi b/doc/poke.texi
index 98143ea3..26db0fda 100644
--- a/doc/poke.texi
+++ b/doc/poke.texi
@@ -8381,6 +8381,7 @@ au BufRead,BufNewFile *.pk set filetype=poke
 * set command::                        Querying and setting global options.
 * vm command::                 Poke Virtual Machine services.
 * compiler command::            Poke incremental compiler services.
+* bases command::               Printing an integer in all bases (2, 6, 8 and 
16).
 * exit command::               Exiting poke :(
 * quit command::                Likewise.
 @end menu
@@ -8891,6 +8892,21 @@ then dumps a printable representation of the 
corresponding abstract
 syntax tree (AST).  This command is useful when debugging the Poke
 compiler.
 
+@node bases command
+@section @code{.bases}
+@cindex @code{.bases}
+@cindex bases
+The @code{.bases EXPR} prints the value of @code{EXPR} in base 16, 10,
+8 and 2.  This is useful for debugging without changing the global
+output base.
+
+@example
+(poke) .bases 1
+0x1, 1, 0o1, 0b1
+(poke) .bases -1
+0xffffffff, -1, 0o37777777777, 0b11111111111111111111111111111111
+@end example
+
 @node exit command
 @section @code{.exit}
 @cindex @code{.exit}
diff --git a/poke/pk-cmd-help.pk b/poke/pk-cmd-help.pk
index bc54709d..01148644 100644
--- a/poke/pk-cmd-help.pk
+++ b/poke/pk-cmd-help.pk
@@ -390,3 +390,12 @@ pk_help_add_topic
       summary = "display the poke version",
       description = "Print the version of poke and copyright information."
   };
+
+pk_help_add_topic
+  :entry Poke_HelpEntry {
+      category = "dot-commands",
+      topic = ".bases",
+      synopsis = ".bases EXPR",
+      summary = "print the given integral expression in base 16, 10, 8 and 2",
+      description = "Print the given integer (EXPR) in base 16, 10, 8 and 2"
+  };
diff --git a/poke/pk-cmd-misc.c b/poke/pk-cmd-misc.c
index d8de3b30..349d8cb8 100644
--- a/poke/pk-cmd-misc.c
+++ b/poke/pk-cmd-misc.c
@@ -28,6 +28,7 @@
 #include "poke.h"
 #include "pk-cmd.h"
 #include "pk-utils.h"
+#include "pk-repl.h" /* For poke_completion_function */
 
 static int
 pk_cmd_exit (int argc, struct pk_cmd_arg argv[], uint64_t uflags)
@@ -197,6 +198,57 @@ doc_completion_function (const char *x, int state)
   return NULL;
 }
 
+static int
+pk_cmd_bases (int argc, struct pk_cmd_arg argv[], uint64_t uflags)
+{
+  /* bases EXPR */
+
+  pk_val printer = PK_NULL;
+  pk_val retval = PK_NULL;
+  pk_val val = PK_NULL;
+  pk_val exit_exception = PK_NULL;
+  const char *expr;
+  int ret;
+
+  assert (argc == 2);
+  assert (PK_CMD_ARG_TYPE (argv[1]) == PK_CMD_ARG_STR);
+  expr = PK_CMD_ARG_STR (argv[1]);
+
+  if (*expr == '\0')
+    return 1;
+
+  ret = pk_compile_expression (poke_compiler, expr, NULL, &val,
+                               &exit_exception);
+
+  if (ret != PK_OK || exit_exception != PK_NULL)
+    {
+      /* The compiler has already printed diagnostics in the
+         terminal.  */
+      if (exit_exception != PK_NULL)
+        poke_handle_exception (exit_exception);
+      return 0;
+    }
+
+  if (pk_type_code (pk_typeof (val)) == PK_TYPE_INT
+      || pk_type_code (pk_typeof (val)) == PK_TYPE_UINT)
+    {
+      printer = pk_decl_val (poke_compiler, "pk_cmd_bases");
+      assert(printer != PK_NULL);
+      if (pk_call (poke_compiler, printer, &retval, &exit_exception,
+                   1, val) == PK_ERROR
+          || exit_exception != PK_NULL)
+        PK_UNREACHABLE ();
+    }
+  else
+    {
+      pk_term_class ("error");
+      pk_puts (_("error:"));
+      pk_term_end_class ("error");
+      pk_puts (" expression should evaluate to an integer\n");
+      return 0;
+    }
+  return 1;
+}
 
 const struct pk_cmd quit_cmd =
   {"quit", "?i", "", 0, NULL, NULL, pk_cmd_exit, ".quit [CODE]", NULL};
@@ -212,3 +264,6 @@ const struct pk_cmd jmd_cmd =
 
 const struct pk_cmd doc_cmd =
   {"doc", "?s", "", 0, NULL, NULL, pk_cmd_doc, ".doc [section]", 
doc_completion_function};
+
+const struct pk_cmd bases_cmd =
+  {"bases", "s", "", 0, NULL, NULL, pk_cmd_bases, ".bases EXPR", 
poke_completion_function};
diff --git a/poke/pk-cmd-misc.pk b/poke/pk-cmd-misc.pk
index 41f0b042..1835e9ae 100644
--- a/poke/pk-cmd-misc.pk
+++ b/poke/pk-cmd-misc.pk
@@ -45,3 +45,30 @@ fun pk_cmd_jmd = void:
 {
   printf ("%s\n", pk_jmd_cookies[rand (gettime[1]) % pk_jmd_cookies'length]);
 }
+
+fun pk_cmd_bases = (any val) void:
+{
+  var ob = vm_obase;
+  var s = "";
+
+  try
+    {
+      vm_set_obase (16);
+      printf ("0x%s, ", ltrim (format ("%v", val)[2:], "0"));
+
+      vm_set_obase (10);
+      printf ("%v, ", val);
+
+      vm_set_obase (8);
+      printf ("0o%s, ", ltrim (format ("%v", val)[2:], "0"));
+
+      vm_set_obase (2);
+      printf ("0b%s\n", ltrim (format ("%v", val)[2:], "0"));
+    }
+  catch (Exception ex)
+    {
+      vm_set_obase (ob);
+      raise ex;
+    }
+  vm_set_obase (ob);
+}
diff --git a/poke/pk-cmd.c b/poke/pk-cmd.c
index b2c30143..699f9975 100644
--- a/poke/pk-cmd.c
+++ b/poke/pk-cmd.c
@@ -60,6 +60,7 @@ extern const struct pk_cmd quit_cmd; /* pk-cmd-misc.c  */
 extern const struct pk_cmd version_cmd; /* pk-cmd-misc.c */
 extern const struct pk_cmd doc_cmd; /* pk-cmd-misc.c */
 extern const struct pk_cmd jmd_cmd; /* pk-cmd-misc.c */
+extern const struct pk_cmd bases_cmd; /* pk-cmd-misc.c */
 extern const struct pk_cmd help_cmd; /* pk-cmd-help.c */
 extern const struct pk_cmd vm_cmd; /* pk-cmd-vm.c  */
 extern const struct pk_cmd compiler_cmd; /* pk-cmd-compiler.c */
@@ -79,6 +80,7 @@ static const struct pk_cmd *dot_cmds[] =
     &version_cmd,
     &doc_cmd,
     &jmd_cmd,
+    &bases_cmd,
     &info_cmd,
     &close_cmd,
     &load_cmd,
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index 8799dd32..c2935207 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -60,6 +60,10 @@ EXTRA_DIST = \
   lib/poke.exp \
   lib/poke-unit.h \
   poke.cmd/cmd.exp \
+  poke.cmd/bases-1.pk \
+  poke.cmd/bases-2.pk \
+  poke.cmd/bases-3.pk \
+  poke.cmd/bases-4.pk \
   poke.cmd/close-sub-1.pk \
   poke.cmd/copy-1.pk \
   poke.cmd/copy-2.pk \
diff --git a/testsuite/poke.cmd/bases-1.pk b/testsuite/poke.cmd/bases-1.pk
new file mode 100644
index 00000000..a8c65cd4
--- /dev/null
+++ b/testsuite/poke.cmd/bases-1.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command { .bases } } */
+/* { dg-output "" } */
diff --git a/testsuite/poke.cmd/bases-2.pk b/testsuite/poke.cmd/bases-2.pk
new file mode 100644
index 00000000..52e3a003
--- /dev/null
+++ b/testsuite/poke.cmd/bases-2.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command { .bases 1 } } */
+/* { dg-output "0x1, 1, 0o1, 0b1" } */
diff --git a/testsuite/poke.cmd/bases-3.pk b/testsuite/poke.cmd/bases-3.pk
new file mode 100644
index 00000000..5059313a
--- /dev/null
+++ b/testsuite/poke.cmd/bases-3.pk
@@ -0,0 +1,5 @@
+/* { dg-do run } */
+
+/* { dg-command { .set obase 16 } } */
+/* { dg-command { .bases -1 } } */
+/* { dg-output "0xffffffff, -1, 0o37777777777, 
0b11111111111111111111111111111111" } */
diff --git a/testsuite/poke.cmd/bases-4.pk b/testsuite/poke.cmd/bases-4.pk
new file mode 100644
index 00000000..de01ea9b
--- /dev/null
+++ b/testsuite/poke.cmd/bases-4.pk
@@ -0,0 +1,5 @@
+/* { dg-do run } */
+
+/* { dg-command { .set obase 10 } } */
+/* { dg-command { .bases -1L } } */
+/* { dg-output "0xffffffffffffffffL, -1L, 0o1777777777777777777777L, 
0b1111111111111111111111111111111111111111111111111111111111111111L" } */
-- 
2.46.2