diff options
Diffstat (limited to 'lisp/emacs-lisp/pcase.el')
-rw-r--r-- | lisp/emacs-lisp/pcase.el | 31 |
1 files changed, 21 insertions, 10 deletions
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 50c92518b02..eb2c7f002e8 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -353,23 +353,34 @@ MATCH is the pattern that needs to be matched, of the form: (symbolp . numberp) (symbolp . consp) (symbolp . arrayp) + (symbolp . vectorp) (symbolp . stringp) (symbolp . byte-code-function-p) (integerp . consp) (integerp . arrayp) + (integerp . vectorp) (integerp . stringp) (integerp . byte-code-function-p) (numberp . consp) (numberp . arrayp) + (numberp . vectorp) (numberp . stringp) (numberp . byte-code-function-p) (consp . arrayp) + (consp . vectorp) (consp . stringp) (consp . byte-code-function-p) - (arrayp . stringp) (arrayp . byte-code-function-p) + (vectorp . byte-code-function-p) + (stringp . vectorp) (stringp . byte-code-function-p))) +(defun pcase--mutually-exclusive-p (pred1 pred2) + (or (member (cons pred1 pred2) + pcase-mutually-exclusive-predicates) + (member (cons pred2 pred1) + pcase-mutually-exclusive-predicates))) + (defun pcase--split-match (sym splitter match) (cond ((eq (car match) 'match) @@ -433,10 +444,7 @@ MATCH is the pattern that needs to be matched, of the form: ;; A QPattern but not for a cons, can only go to the `else' side. ((eq (car-safe pat) '\`) '(:pcase--fail . nil)) ((and (eq (car-safe pat) 'pred) - (or (member (cons 'consp (cadr pat)) - pcase-mutually-exclusive-predicates) - (member (cons (cadr pat) 'consp) - pcase-mutually-exclusive-predicates))) + (pcase--mutually-exclusive-p #'consp (cadr pat))) '(:pcase--fail . nil)))) (defun pcase--split-equal (elem pat) @@ -496,11 +504,14 @@ MATCH is the pattern that needs to be matched, of the form: (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)) - pcase-mutually-exclusive-predicates) - (member (cons (cadr pat) (cadr upat)) - pcase-mutually-exclusive-predicates))) + (let ((otherpred + (cond ((eq 'pred (car-safe pat)) (cadr pat)) + ((not (eq '\` (car-safe pat))) nil) + ((consp (cadr pat)) #'consp) + ((vectorp (cadr pat)) #'vectorp) + ((byte-code-function-p (cadr pat)) + #'byte-code-function-p)))) + (pcase--mutually-exclusive-p (cadr upat) otherpred))) '(:pcase--fail . nil)) ((and (eq 'pred (car upat)) (eq '\` (car-safe pat)) |