* lisp/emacs-lisp/pcase.el: Fix bug#46786

Revert commit a218c9861573b5ec4979ff2662f5c0343397e3ff, but in order
to avoid the spurious warnings that this commit tried to squash,
keep track of the vars used during the match so as to add
corresponding annotations to explicitly silence the spurious warnings.

To do this, we change the VARS used in `pcase-u` (and throughout
the pcase code): they used to hold elements of the form (NAME . VAL)
and now they hold elements of the form (NAME VAL . USED).

(pcase--expand): Bind all vars instead of only those found via fgrep.
(pcase-codegen): Silence "unused var" warnings for those vars that have
already been referenced during the match itself.
(pcase--funcall, pcase--eval): Record the vars that are used.
(pcase--u1): Record the vars that are used via non-linear patterns.

* lisp/textmodes/mhtml-mode.el (mhtml-forward):
* lisp/vc/diff-mode.el (diff-goto-source): Silence newly
discovered warnings.

* test/lisp/emacs-lisp/pcase-tests.el (pcase-tests-bug46786): New test.

1 files changed, 36 insertions, 24 deletions

diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index b1e1305edfe..0fa1b980a0f 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -328,8 +328,7 @@ of the elements of LIST is performed as if by `pcase-let'.
            (seen '())
            (codegen
             (lambda (code vars)
-              (let ((vars (macroexp--fgrep vars code))
-                    (prev (assq code seen)))
+              (let ((prev (assq code seen)))
                 (if (not prev)
                     (let ((res (pcase-codegen code vars)))
                       (push (list code vars res) seen)
@@ -354,14 +353,14 @@ of the elements of LIST is performed as if by `pcase-let'.
                         (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code))
                               defs)
                         (setcar res 'funcall)
-                        (setcdr res (cons bsym (mapcar #'cdr prevvars)))
+                        (setcdr res (cons bsym (mapcar #'cadr prevvars)))
                         (setcar (cddr prev) bsym)
                         (setq res bsym)))
                     (setq vars (copy-sequence vars))
                     (let ((args (mapcar (lambda (pa)
                                           (let ((v (assq (car pa) vars)))
                                             (setq vars (delq v vars))
-                                            (cdr v)))
+                                            (cadr v)))
                                         prevvars)))
                       ;; If some of `vars' were not found in `prevvars', that's
                       ;; OK it just means those vars aren't present in all
@@ -383,9 +382,7 @@ of the elements of LIST is performed as if by `pcase-let'.
                              (if (pcase--small-branch-p (cdr case))
                                  ;; Don't bother sharing multiple
                                  ;; occurrences of this leaf since it's small.
-                                 (lambda (code vars)
-                                   (pcase-codegen code
-                                                  (macroexp--fgrep vars code)))
+                                 #'pcase-codegen
                                codegen)
                              (cdr case)
                              vars))))
@@ -452,10 +449,15 @@ for the result of evaluating EXP (first arg to `pcase').
   ;; Don't use let*, otherwise macroexp-let* may merge it with some surrounding
   ;; let* which might prevent the setcar/setcdr in pcase--expand's fancy
   ;; codegen from later metamorphosing this let into a funcall.
-  (if vars
-      `(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars)
-         ,@code)
-    `(progn ,@code)))
+  (if (null vars)
+      `(progn ,@code)
+    `(let ,(mapcar (lambda (b) (list (car b) (cadr b))) vars)
+       ;; Try and silence some of the most common spurious "unused
+       ;; var" warnings.
+       ,@(delq nil (mapcar (lambda (var)
+                             (if (cddr var) `(ignore ,(car var))))
+                           vars))
+       ,@code)))
 
 (defun pcase--small-branch-p (code)
   (and (= 1 (length code))
@@ -497,11 +499,14 @@ for the result of evaluating EXP (first arg to `pcase').
   "Expand matcher for rules BRANCHES.
 Each BRANCH has the form (MATCH CODE . VARS) where
 CODE is the code generator for that branch.
-VARS is the set of vars already bound by earlier matches.
 MATCH is the pattern that needs to be matched, of the form:
   (match VAR . PAT)
   (and MATCH ...)
-  (or MATCH ...)"
+  (or MATCH ...)
+VARS is the set of vars already bound by earlier matches.
+It is a list of (NAME VAL . USED) where NAME is the variable's symbol,
+VAL is the expression to which it should be bound and USED is a boolean
+recording whether the var has been referenced by earlier parts of the match."
   (when (setq branches (delq nil branches))
     (let* ((carbranch (car branches))
            (match (car carbranch)) (cdarbranch (cdr carbranch))
@@ -748,8 +753,11 @@ A and B can be one of:
    ((symbolp fun) `(,fun ,arg))
    ((eq 'not (car-safe fun)) `(not ,(pcase--funcall (cadr fun) arg vars)))
    (t
-    (let* (;; `env' is an upper bound on the bindings we need.
-           (env (mapcar (lambda (x) (list (car x) (cdr x)))
+    (let* (;; `env' is hopefully an upper bound on the bindings we need,
+           ;; FIXME: See bug#46786 for a counter example :-(
+           (env (mapcar (lambda (x)
+                          (setcdr (cdr x) 'used)
+                          (list (car x) (cadr x)))
                         (macroexp--fgrep vars fun)))
            (call (progn
                    (when (assq arg env)
@@ -757,7 +765,7 @@ A and B can be one of:
                      (let ((newsym (gensym "x")))
                        (push (list newsym arg) env)
                        (setq arg newsym)))
-                   (if (functionp fun)
+                   (if (or (functionp fun) (not (consp fun)))
                        `(funcall #',fun ,arg)
                      `(,@fun ,arg)))))
       (if (null env)
@@ -770,10 +778,12 @@ A and B can be one of:
 (defun pcase--eval (exp vars)
   "Build an expression that will evaluate EXP."
   (let* ((found (assq exp vars)))
-    (if found (cdr found)
+    (if found (progn (setcdr (cdr found) 'used) (cadr found))
       (let* ((env (macroexp--fgrep vars exp)))
         (if env
-            (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x)))
+            (macroexp-let* (mapcar (lambda (x)
+                                     (setcdr (cdr x) 'used)
+                                     (list (car x) (cadr x)))
                                    env)
                            exp)
           exp)))))
@@ -865,12 +875,14 @@ Otherwise, it defers to REST which is a list of branches of the form
                      (pcase--u else-rest))))
        ((and (symbolp upat) upat)
         (pcase--mark-used sym)
-        (if (not (assq upat vars))
-            (pcase--u1 matches code (cons (cons upat sym) vars) rest)
-          ;; Non-linear pattern.  Turn it into an `eq' test.
-          (pcase--u1 (cons `(match ,sym . (pred (eql ,(cdr (assq upat vars)))))
-                           matches)
-                     code vars rest)))
+        (let ((v (assq upat vars)))
+          (if (not v)
+              (pcase--u1 matches code (cons (list upat sym) vars) rest)
+            ;; Non-linear pattern.  Turn it into an `eq' test.
+            (setq (cddr v) 'used)
+            (pcase--u1 (cons `(match ,sym . (pred (eql ,(cadr v))))
+                             matches)
+                       code vars rest))))
        ((eq (car-safe upat) 'app)
         ;; A upat of the form (app FUN PAT)
         (pcase--mark-used sym)