diff options
author | Tom Tromey <tromey@redhat.com> | 2013-07-12 18:44:13 -0600 |
---|---|---|
committer | Tom Tromey <tromey@redhat.com> | 2013-07-12 18:44:13 -0600 |
commit | b34a529f177a6ea32da5cb1254f91bf9d71838db (patch) | |
tree | 477131abc15d3107b30b635223d87a22550b480b /lisp/emacs-lisp/pcase.el | |
parent | e6f63071a3f7721f55220514b6d9a8ee8c1232d8 (diff) | |
parent | 5e301d7651c0691bb2bc7f3fbe711fdbe26ac471 (diff) | |
download | emacs-b34a529f177a6ea32da5cb1254f91bf9d71838db.tar.gz emacs-b34a529f177a6ea32da5cb1254f91bf9d71838db.tar.bz2 emacs-b34a529f177a6ea32da5cb1254f91bf9d71838db.zip |
Merge from trunk
Diffstat (limited to 'lisp/emacs-lisp/pcase.el')
-rw-r--r-- | lisp/emacs-lisp/pcase.el | 17 |
1 files changed, 12 insertions, 5 deletions
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index e000c343721..511f1480099 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))) |