1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-10 08:10:21 -08:00

* 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.
This commit is contained in:
Stefan Monnier 2013-08-04 16:18:11 -04:00
parent e443729d65
commit 671d5c1654
11 changed files with 106 additions and 90 deletions

View file

@ -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))