From 112cb9c4e7375f3ea4044c929f854f968deed78b Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Tue, 4 Nov 2025 15:13:01 +0000
Subject: [PATCH] parser debugging output: strip token name prefixes

Some of the names of parser (perly.y) tokens have a common prefix, such
as

    PERLY_SEMICOLON
    PERLY_AMPERSAND
    KW_PACKAGE
    KW_CLASS

Perl's -Dpv switch produces debugging output that also displays the top
few items on the parse stack. The token names are truncated for
compactness' sake. This currently leads to a display where its mostly
just the token name's prefix that is displayed, e.g.

$ perl -Dpv -e'package Foo'

...

index:        1        2        3        4        5        6        7        8
state:        1        9       17      149       91      263      412      503
token: GRAMPROG       @1 remember  stmtseq KW_PACKA BAREWORD BAREWORD PERLY_SE
value:        0        0       63 (Nullop)        0 (Nullop)    const 735909768

After this commit, PERLY_, KW_ etc prefixes are stripped, allowing more
of the actual token name is displayed:

index:        1        2        3        4        5        6        7        8
state:        1        9       17      149       91      263      412      503
token: GRAMPROG       @1 remember  stmtseq  PACKAGE BAREWORD BAREWORD SEMICOLO
value:        0        0       63 (Nullop)        0 (Nullop)    const 227539304
---
 perly.c | 26 ++++++++++++++++++++++++--
 1 file changed, 24 insertions(+), 2 deletions(-)

diff --git a/perly.c b/perly.c
index a81618146d5a..5be29ec938c7 100644
--- a/perly.c
+++ b/perly.c
@@ -128,6 +128,15 @@ yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyva
 }
 
 
+/* common prefixes of token names to strip when displaying in compact form
+ */
+static const char *name_prefixes[] = {
+    "PERLY_",
+    "KW_",
+    "bare_statement_",
+    NULL,
+};
+
 /*  yy_stack_print()
  *  print the top 8 items on the parse stack.
  */
@@ -150,8 +159,21 @@ yy_stack_print (pTHX_ const yy_parser *parser)
         PerlIO_printf(Perl_debug_log, " %8d", ps->state);
 
     PerlIO_printf(Perl_debug_log, "\ntoken:");
-    for (ps = min; ps <= parser->ps; ps++)
-        PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
+    for (ps = min; ps <= parser->ps; ps++) {
+        const char *name = ps->name;
+        const char **p = name_prefixes;
+        /* strip some common prefixes off the name to better display
+         * truncated names */
+        for (; *p; p++) {
+            const char *prefix = *p;
+            STRLEN l = strlen(prefix);
+            if (strnEQ(name, prefix, l)) {
+                name += l;
+                break;
+            }
+        }
+        PerlIO_printf(Perl_debug_log, " %8.8s", name);
+    }
 
     PerlIO_printf(Perl_debug_log, "\nvalue:");
     for (ps = min; ps <= parser->ps; ps++) {