emacs-30 cc6a11f4832: (with-peg-rules): Fix references to rulesets (bug#74018)

[Stefan Monnier]

branch: emacs-30
commit cc6a11f4832076acb7c0b5301eb1add026fabe4b
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    (with-peg-rules): Fix references to rulesets (bug#74018)
    
    PEG rules get "compiled" to functions with name `peg-rule <RULE>`.
    `define-peg-ruleset` instead defines it PEG rules with name
    `peg-rule <RULESET> <RULE>`, so that they can be made visible
    by `with-peg-rules` simply by adding local aliases from
    `peg-rule <RULE>` to `peg-rule <RULESET> <RULE>`.
    
    Apparently when I added `define-peg-ruleset` I somehow failed to
    install some of the corresponding code in `with-peg-rules`, so
    the aliases were not installed, making it "impossible" to use
    rulesets.
    [ I still have no idea how this happened and/or where
      the missing code went, so I "recreated" it.  ]
    
    * lisp/progmodes/peg.el (with-peg-rules): Install the aliases
    for the rulesets.
    (peg--translate-rule-body): Try and preserve
    location info when emitting a warning.
    
    * test/lisp/progmodes/peg-tests.el (peg-test-myrules): New ruleset.
    (peg-test-ruleset): New test.
---
 lisp/progmodes/peg.el            | 15 +++++++++++++--
 test/lisp/progmodes/peg-tests.el | 14 ++++++++++++++
 2 files changed, 27 insertions(+), 2 deletions(-)

diff --git a/lisp/progmodes/peg.el b/lisp/progmodes/peg.el
index 96334162195..0b069e95563 100644
--- a/lisp/progmodes/peg.el
+++ b/lisp/progmodes/peg.el
@@ -412,6 +412,7 @@ sequencing `and' operator of PEG grammars."
              (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 +433,8 @@ rulesets defined previously with `define-peg-ruleset'."
                               (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 +446,15 @@ rulesets defined previously with `define-peg-ruleset'."
         ,@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
 
@@ -645,7 +656,7 @@ rulesets defined previously with `define-peg-ruleset'."
         (code (peg-translate-exp exp)))
     (cond
      ((null msg) code)
-     (t (macroexp-warn-and-return msg code)))))
+     (t (macroexp-warn-and-return msg code 'peg nil exp)))))
 
 ;; This is the main translation function.
 (defun peg-translate-exp (exp)
diff --git a/test/lisp/progmodes/peg-tests.el b/test/lisp/progmodes/peg-tests.el
index 8fab549bcab..b9e9c47ab7c 100644
--- a/test/lisp/progmodes/peg-tests.el
+++ b/test/lisp/progmodes/peg-tests.el
@@ -180,6 +180,20 @@ resp. succeeded instead of signaling an error."
     (should (eobp)))
   )
 
+(define-peg-ruleset peg-test-myrules
+  (sign  () (or "+" "-" ""))
+  (digit () [0-9])
+  (nat   () digit (* digit))
+  (int   () sign digit (* digit))
+  (float () int "." nat))
+
+(ert-deftest peg-test-ruleset ()
+  (with-peg-rules
+      (peg-test-myrules
+       (complex float "+i" float))
+    (should (peg-parse-string nat "123" t))
+    (should (not (peg-parse-string nat "home" t)))))
+
 ;;; Examples:
 
 ;; peg-ex-recognize-int recognizes integers.  An integer begins with a