Subject: 31.0.50; Issue with define-peg-ruleset?

From: Stefan Monnier <[email-masked]>
Date: Fri, 25 Oct 2024 16:30:30 -0400

Package: Emacs
Version: 31.0.50

Augusto pointed out a bug in `peg.el` when you have code like:

    (define-peg-ruleset myrules
      (sign  () (or "+" "-" ""))
      (digit () [0-9])
      (nat   () digit (* digit))
      (int   () sign digit (* digit))
      (float () int "." nat))

    (with-peg-rules
        (myrules
         (complex float "+i" float))
      (peg-parse nat "," nat "," complex) )

where the macroexpanded code is wrong and leads to errors like:

    Debugger entered--Lisp error: (void-function peg-rule\ nat)

I was about to install the bugfix below to `master` but noticed that it
probably belongs to `emacs-30` instead since the bug makes
`define-peg-ruleset` basically unusable and PEG is new in Emacs-30.

Any objection?

        Stefan
diff --git a/lisp/progmodes/peg.el b/lisp/progmodes/peg.el
index 96334162195..b18d68c69c5 100644
--- a/lisp/progmodes/peg.el
+++ b/lisp/progmodes/peg.el
@@ -412,6 +412,7 @@ define-peg-ruleset
              (full-rname (format "%s %s" name rname)))
         (push `(define-peg-rule ,full-rname . ,(cdr rule)) defs)
         (push `(,(peg--rule-id rname) #',(peg--rule-id full-rname)) aliases)))
+    (require 'cl-lib)
     `(cl-flet ,aliases
        ,@defs
        (eval-and-compile (put ',name 'peg--rules ',aliases)))))
@@ -432,7 +432,8 @@
                               (progn (push rule rulesets) nil)
                             (cons (car rule) (peg-normalize `(and . ,(cdr rule))))))
                         rules)))
-        (ctx (assq :peg-rules macroexpand-all-environment)))
+         (ctx (assq :peg-rules macroexpand-all-environment))
+         (body
     (macroexpand-all
      `(cl-labels
           ,(mapcar (lambda (rule)
@@ -444,6 +445,15 @@
         ,@body)
      `((:peg-rules ,@(append rules (cdr ctx)))
        ,@macroexpand-all-environment))))
+    (if (null rulesets)
+        body
+      `(cl-flet ,(mapcan (lambda (ruleset)
+                           (let ((aliases (get ruleset 'peg--rules)))
+                             (unless aliases
+                               (message "Unknown PEG ruleset: %S" ruleset))
+                             (copy-sequence aliases)))
+                         rulesets)
+         ,body))))
 
 ;;;;; Old entry points