From 0b64b838a014b3abd1a35953d599ddd803f66482 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 8 Jul 2013 17:54:54 -0400 Subject: [PATCH] * 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 --- lisp/ChangeLog | 8 +++++++- lisp/emacs-lisp/pcase.el | 17 ++++++++++++----- 2 files changed, 19 insertions(+), 6 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5a99f61251..50044ffc97 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2013-07-08 Stefan Monnier + + * 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 * simple.el (line-move-partial, line-move): Account for @@ -17,7 +23,7 @@ 2013-07-07 Michael Kifer Stefan Monnier - * 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 e000c34372..511f148009 100644 --- 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))) -- 2.20.1