* lisp/emacs-lisp/pcase.el (pcase--split-pred): Add `vars' argument to try

and detect when a guard/pred depends on local vars.
(pcase--u1): Adjust caller.

Fixes: debbugs:14773

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5a99f61251b6645b2039f3303a3eb820624a629b..50044ffc9700f02b5f088f38a90e8738939e277b 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2013-07-08  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * emacs-lisp/pcase.el (pcase--split-pred): Add `vars' argument to try
+       and detect when a guard/pred depends on local vars (bug#14773).
+       (pcase--u1): Adjust caller.
+
 2013-07-08  Eli Zaretskii  <eliz@gnu.org>
 
        * simple.el (line-move-partial, line-move): Account for
@@ -17,7 +23,7 @@
 2013-07-07  Michael Kifer  <kifer@cs.stonybrook.edu>
             Stefan Monnier  <monnier@iro.umontreal.ca>
 
-       * faces.el (tty-run-terminal-initialization): Function changed.
+       * faces.el (tty-run-terminal-initialization): Run new tty-setup-hook.
 
        * viper.el (viper-emacs-state-mode-list): Add egg-status-buffer-mode.
        (viper-version): Version update.

diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index e000c343721e51c0c4aced2b830c7d464dea11bb..511f1480099c0d38c47a5aeea30533d09bb69e4a 100644 (file)
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -482,12 +482,19 @@ MATCH is the pattern that needs to be matched, of the form:
            all))
     '(:pcase--succeed . nil))))
 
-(defun pcase--split-pred (upat pat)
-  ;; FIXME: For predicates like (pred (> a)), two such predicates may
-  ;; actually refer to different variables `a'.
+(defun pcase--split-pred (vars upat pat)
   (let (test)
     (cond
-     ((equal upat pat) '(:pcase--succeed . :pcase--fail))
+     ((and (equal upat pat)
+           ;; For predicates like (pred (> a)), two such predicates may
+           ;; actually refer to different variables `a'.
+           (or (and (eq 'pred (car upat)) (symbolp (cadr upat)))
+               ;; FIXME: `vars' gives us the environment in which `upat' will
+               ;; run, but we don't have the environment in which `pat' will
+               ;; run, so we can't do a reliable verification.  But let's try
+               ;; and catch at least the easy cases such as (bug#14773).
+               (not (pcase--fgrep (mapcar #'car vars) (cadr upat)))))
+      '(:pcase--succeed . :pcase--fail))
      ((and (eq 'pred (car upat))
            (eq 'pred (car-safe pat))
            (or (member (cons (cadr upat) (cadr pat))
@@ -589,7 +596,7 @@ Otherwise, it defers to REST which is a list of branches of the form
         (if (eq (car upat) 'pred) (pcase--mark-used sym))
         (let* ((splitrest
                 (pcase--split-rest
-                 sym (lambda (pat) (pcase--split-pred upat pat)) rest))
+                 sym (lambda (pat) (pcase--split-pred vars upat pat)) rest))
                (then-rest (car splitrest))
                (else-rest (cdr splitrest)))
           (pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat)))