diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/advice.el | 30 | ||||
| -rw-r--r-- | lisp/emacs-lisp/edebug.el | 15 | ||||
| -rw-r--r-- | lisp/emacs-lisp/nadvice.el | 23 | ||||
| -rw-r--r-- | lisp/emacs-lisp/pcase.el | 31 |
4 files changed, 37 insertions, 62 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index eb1d63e788b..861054e777f 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2140,14 +2140,6 @@ See Info node `(elisp)Computed Advice' for detailed documentation." "Take a macro function DEFINITION and make a lambda out of it." `(cdr ,definition)) -(defmacro ad-subr-p (definition) - ;;"non-nil if DEFINITION is a subr." - (list 'subrp definition)) - -(defmacro ad-macro-p (definition) - ;;"non-nil if DEFINITION is a macro." - `(eq (car-safe ,definition) 'macro)) - (defmacro ad-lambda-p (definition) ;;"non-nil if DEFINITION is a lambda expression." `(eq (car-safe ,definition) 'lambda)) @@ -2160,12 +2152,12 @@ See Info node `(elisp)Computed Advice' for detailed documentation." (defmacro ad-compiled-p (definition) "Return non-nil if DEFINITION is a compiled byte-code object." `(or (byte-code-function-p ,definition) - (and (ad-macro-p ,definition) - (byte-code-function-p (ad-lambdafy ,definition))))) + (and (macrop ,definition) + (byte-code-function-p (ad-lambdafy ,definition))))) (defmacro ad-compiled-code (compiled-definition) "Return the byte-code object of a COMPILED-DEFINITION." - `(if (ad-macro-p ,compiled-definition) + `(if (macrop ,compiled-definition) (ad-lambdafy ,compiled-definition) ,compiled-definition)) @@ -2173,7 +2165,7 @@ See Info node `(elisp)Computed Advice' for detailed documentation." "Return the lambda expression of a function/macro/advice DEFINITION." (cond ((ad-lambda-p definition) definition) - ((ad-macro-p definition) + ((macrop definition) (ad-lambdafy definition)) ((ad-advice-p definition) (cdr definition)) @@ -2183,7 +2175,7 @@ See Info node `(elisp)Computed Advice' for detailed documentation." "Return the argument list of DEFINITION." (require 'help-fns) (help-function-arglist - (if (or (ad-macro-p definition) (ad-advice-p definition)) + (if (or (macrop definition) (ad-advice-p definition)) (cdr definition) definition) 'preserve-names)) @@ -2229,7 +2221,7 @@ definition (see the code for `documentation')." (defun ad-advised-definition-p (definition) "Return non-nil if DEFINITION was generated from advice information." (if (or (ad-lambda-p definition) - (ad-macro-p definition) + (macrop definition) (ad-compiled-p definition)) (let ((docstring (ad-docstring definition))) (and (stringp docstring) @@ -2242,8 +2234,8 @@ definition (see the code for `documentation')." ;; representations, so cache entries preactivated with version ;; 1 can't be used. (cond - ((ad-macro-p definition) 'macro2) - ((ad-subr-p definition) 'subr2) + ((macrop definition) 'macro2) + ((subrp definition) 'subr2) ((or (ad-lambda-p definition) (ad-compiled-p definition)) 'fun2) ((ad-advice-p definition) 'advice2))) ;; FIXME: Can this ever happen? @@ -2273,7 +2265,7 @@ For that it has to be fbound with a non-autoload definition." "True if FUNCTION has an interpreted definition that can be compiled." (and (ad-has-proper-definition function) (or (ad-lambda-p (symbol-function function)) - (ad-macro-p (symbol-function function))) + (macrop (symbol-function function))) (not (ad-compiled-p (symbol-function function))))) (defvar warning-suppress-types) ;From warnings.el. @@ -2902,7 +2894,7 @@ If COMPILE is nil then the result depends on the value of ((eq ad-default-compilation-action 'never) nil) ((eq ad-default-compilation-action 'always) t) ((eq ad-default-compilation-action 'like-original) - (or (ad-subr-p (ad-get-orig-definition function)) + (or (subrp (ad-get-orig-definition function)) (ad-compiled-p (ad-get-orig-definition function)))) ;; everything else means `maybe': (t (featurep 'byte-compile)))) @@ -3249,7 +3241,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) `((ad-set-cache ',function ;; the function will get compiled: - ,(cond ((ad-macro-p (car preactivation)) + ,(cond ((macrop (car preactivation)) `(ad-macrofy (function ,(ad-lambdafy diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index ae20e5270e1..ac7e5f12a18 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -295,19 +295,6 @@ A lambda list keyword is a symbol that starts with `&'." (eq (selected-window) (next-window (next-window (selected-window)))))) -(defsubst edebug-lookup-function (object) - (while (and (symbolp object) (fboundp object)) - (setq object (symbol-function object))) - object) - -(defun edebug-macrop (object) - "Return the macro named by OBJECT, or nil if it is not a macro." - (setq object (edebug-lookup-function object)) - (if (and (listp object) - (eq 'macro (car object)) - (functionp (cdr object))) - object)) - (defun edebug-sort-alist (alist function) ;; Return the ALIST sorted with comparison function FUNCTION. ;; This uses 'sort so the sorting is destructive. @@ -1416,7 +1403,7 @@ expressions; a `progn' form will be returned enclosing these forms." ; but leave it in for compatibility. )) ;; No edebug-form-spec provided. - ((edebug-macrop head) + ((macrop head) (if edebug-eval-macro-args (edebug-forms cursor) (edebug-sexps cursor))) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 660eb0365ae..576e72088e9 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -314,9 +314,8 @@ of the piece of advice." ((special-form-p def) ;; Not worth the trouble trying to handle this, I think. (error "Advice impossible: %S is a special form" symbol)) - ((and (symbolp def) - (eq 'macro (car-safe (ignore-errors (indirect-function def))))) - (let ((newval (cons 'macro (cdr (indirect-function def))))) + ((and (symbolp def) (macrop def)) + (let ((newval `(macro . ,(lambda (&rest r) (macroexpand `(,def . ,r)))))) (put symbol 'advice--saved-rewrite (cons def (cdr newval))) newval)) ;; `f' might be a pure (hence read-only) cons! @@ -351,19 +350,7 @@ of the piece of advice." (when (get symbol 'advice--saved-rewrite) (put symbol 'advice--saved-rewrite nil)) (setq newdef (advice--normalize symbol newdef)) - (let* ((olddef (advice--strip-macro (symbol-function symbol))) - (oldadv - (cond - ((null (get symbol 'advice--pending)) - (or olddef - (progn - (message "Delayed advice activation failed for %s: no data" - symbol) - nil))) - ((or (not olddef) (autoloadp olddef)) - (get symbol 'advice--pending)) - (t (message "Dropping left-over advice--pending for %s" symbol) - olddef)))) + (let ((oldadv (advice--symbol-function symbol))) (if (and newdef (not (autoloadp newdef))) (let* ((snewdef (advice--strip-macro newdef)) (snewadv (advice--subst-main oldadv snewdef))) @@ -383,7 +370,6 @@ is defined as a macro, alias, command, ..." ;; TODO: ;; - record the advice location, to display in describe-function. ;; - change all defadvice in lisp/**/*.el. - ;; - rewrite advice.el on top of this. ;; - obsolete advice.el. (let* ((f (symbol-function symbol)) (nf (advice--normalize symbol f))) @@ -420,8 +406,7 @@ of the piece of advice." ((eq (car-safe f) 'macro) (cdr f)) (t (symbol-function symbol))) function) - (unless (advice--p - (if (eq (car-safe f) 'macro) (cdr f) (symbol-function symbol))) + (unless (advice--p (advice--symbol-function symbol)) ;; Not advised any more. (remove-function (get symbol 'defalias-fset-function) #'advice--defalias-fset) 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)) |