[Emacs-diffs] trunk r113330: * lisp/emacs-lisp/pcase.el (pcase--split-pred): Add `vars' argument to try

[Stefan Monnier]

------------------------------------------------------------
revno: 113330
revision-id: address@hidden
parent: address@hidden
fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=14773
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Mon 2013-07-08 17:54:54 -0400
message:
  * 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.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emacs-lisp/pcase.el       pcase.el-20100810123717-8zwve3391p2ywm1h-1

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-07-08 17:33:17 +0000
+++ b/lisp/ChangeLog    2013-07-08 21:54:54 +0000
@@ -1,3 +1,9 @@
+2013-07-08  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>
 
        * simple.el (line-move-partial, line-move): Account for
@@ -17,7 +23,7 @@
 2013-07-07  Michael Kifer  <address@hidden>
             Stefan Monnier  <address@hidden>
 
-       * 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.

=== modified file 'lisp/emacs-lisp/pcase.el'
--- a/lisp/emacs-lisp/pcase.el  2013-01-08 22:26:21 +0000
+++ b/lisp/emacs-lisp/pcase.el  2013-07-08 21:54:54 +0000
@@ -482,12 +482,19 @@
            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 @@
         (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)))