From 671d5c16547d16bef2efa056705bd35b5feacc29 Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Sun, 4 Aug 2013 16:18:11 -0400
Subject: * lisp/subr.el (macrop): New function. (text-clone--maintaining): New
 var. (text-clone--maintain): Rename from text-clone-maintain.  Use it instead
 of inhibit-modification-hooks.

* lisp/emacs-lisp/nadvice.el (advice--normalize): For aliases to macros, use
a proxy, so as handle autoloads and redefinitions of the target.
(advice--defalias-fset, advice-remove): Use advice--symbol-function.

* lisp/emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates):
Remove bogus (arrayp . stringp) pair.  Add entries for `vectorp'.
(pcase--mutually-exclusive-p): New function.
(pcase--split-consp): Use it.
(pcase--split-pred): Use it.  Optimize the case where `pat' is a qpat
mutually exclusive with the current predicate.

* test/automated/advice-tests.el (advice-tests-nadvice): Test removal
before definition.
(advice-tests-macroaliases): New test.

* lisp/emacs-lisp/edebug.el (edebug-lookup-function): Remove function.
(edebug-macrop): Remove.  Use `macrop' instead.
* lisp/emacs-lisp/advice.el (ad-subr-p): Remove.  Use `subrp' instead.
(ad-macro-p):
* lisp/eshell/esh-cmd.el (eshell-macrop):
* lisp/apropos.el (apropos-macrop): Remove.  Use `macrop' instead.
---
 lisp/emacs-lisp/pcase.el | 31 +++++++++++++++++++++----------
 1 file changed, 21 insertions(+), 10 deletions(-)

(limited to 'lisp/emacs-lisp/pcase.el')

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))
-- 
cgit v1.2.3