* 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.

diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index b1e1305edfe7944182a079a6c9e7faae0474e145..0fa1b980a0f0e940fe54fea722e584f1af92e482 100644 (file)
--- 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)

diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el
index 32542d0400f333c66a8b36cba2a02026a0831365..25905385685782332f879c391c27229519dc2c1d 100644 (file)
--- a/lisp/textmodes/mhtml-mode.el
+++ b/lisp/textmodes/mhtml-mode.el
@@ -313,7 +313,7 @@ Prefix arg specifies how many times to move (default 1)."
   (interactive "P")
   (pcase (get-text-property (point) 'mhtml-submode)
     ('nil (sgml-skip-tag-forward arg))
-    (submode (forward-sexp arg))))
+    (_submode (forward-sexp arg))))
 
 ;;;###autoload
 (define-derived-mode mhtml-mode html-mode

diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 8bbab467af3c71c36a3acf9ae551e6a6d4f49bd7..342b4cc32b13171dd01e2d392da33a1cac554859 100644 (file)
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -2003,7 +2003,7 @@ revision of the file otherwise."
   (if event (posn-set-point (event-end event)))
   (let ((buffer (when event (current-buffer)))
         (reverse (not (save-excursion (beginning-of-line) (looking-at "[-<]")))))
-    (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
+    (pcase-let ((`(,buf ,_line-offset ,pos ,src ,_dst ,_switched)
                  (diff-find-source-location other-file reverse)))
       (pop-to-buffer buf)
       (goto-char (+ (car pos) (cdr src)))

diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index 14384112b34b6defdae6df50954fb0e5ff080c31..6ddeb7b622b26e55c5b0953d5b015b92a3a9856b 100644 (file)
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -83,6 +83,13 @@
     (should (equal (funcall f t) 'left))
     (should (equal (funcall f nil) 'right))))
 
+(ert-deftest pcase-tests-bug46786 ()
+  (let ((self 'outer))
+    (should (equal (cl-macrolet ((show-self () `(list 'self self)))
+                     (pcase-let ((`(,self ,self2) '(inner "2")))
+                       (show-self)))
+                   '(self inner)))))
+
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; End: