summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/pcase.el
diff options
context:
space:
mode:
authorTom Tromey <tromey@redhat.com>2013-07-12 18:44:13 -0600
committerTom Tromey <tromey@redhat.com>2013-07-12 18:44:13 -0600
commitb34a529f177a6ea32da5cb1254f91bf9d71838db (patch)
tree477131abc15d3107b30b635223d87a22550b480b /lisp/emacs-lisp/pcase.el
parente6f63071a3f7721f55220514b6d9a8ee8c1232d8 (diff)
parent5e301d7651c0691bb2bc7f3fbe711fdbe26ac471 (diff)
downloademacs-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.el17
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)))