emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] master 4589481: * lisp/emacs-lisp/advice.el: Only use defm


From: Stefan Monnier
Subject: [Emacs-diffs] master 4589481: * lisp/emacs-lisp/advice.el: Only use defmacro when needed
Date: Mon, 17 Sep 2018 14:02:13 -0400 (EDT)

branch: master
commit 458948189e56a110739ff9002236d269b8382293
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * lisp/emacs-lisp/advice.el: Only use defmacro when needed
    
    (ad-get-advice-info): Mark it inlinable.
    (ad-get-advice-info-macro): Make it an obsolete alias.
    (ad-copy-advice-info, ad-is-advised, ad-get-advice-info-field)
    (ad-find-advice, ad-macrofy, ad-lambdafy, ad-lambda-p, ad-advice-p)
    (ad-compiled-p, ad-compiled-code, ad-get-cache-definition)
    (ad-get-cache-id, ad-set-cache): Turn macros into defsubsts.
    (ad-defadvice-flags): Make it into a plain list.
    (ad-set-advice-info-field): Apply a bit of CSE.
---
 lisp/emacs-lisp/advice.el | 93 +++++++++++++++++++++++------------------------
 1 file changed, 45 insertions(+), 48 deletions(-)

diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 6fb28c4..04d2fbf 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1681,11 +1681,11 @@ On each iteration VAR will be bound to the name of an 
advised function
      (setq ,(car varform) (intern ,(car varform)))
      ,@body))
 
-(defun ad-get-advice-info (function)
+(defsubst ad-get-advice-info (function)
   (get function 'ad-advice-info))
 
-(defmacro ad-get-advice-info-macro (function)
-  `(get ,function 'ad-advice-info))
+(define-obsolete-function-alias 'ad-get-advice-info-macro
+  #'ad-get-advice-info "27.1")
 
 (defsubst ad-set-advice-info (function advice-info)
   (cond
@@ -1697,13 +1697,12 @@ On each iteration VAR will be bound to the name of an 
advised function
                      #'ad--defalias-fset)))
   (put function 'ad-advice-info advice-info))
 
-(defmacro ad-copy-advice-info (function)
-  `(copy-tree (get ,function 'ad-advice-info)))
+(defsubst ad-copy-advice-info (function)
+  (copy-tree (get function 'ad-advice-info)))
 
-(defmacro ad-is-advised (function)
+(defalias 'ad-is-advised #'ad-get-advice-info
   "Return non-nil if FUNCTION has any advice info associated with it.
-This does not mean that the advice is also active."
-  `(ad-get-advice-info-macro ,function))
+This does not mean that the advice is also active.")
 
 (defun ad-initialize-advice-info (function)
   "Initialize the advice info for FUNCTION.
@@ -1711,19 +1710,19 @@ Assumes that FUNCTION has not yet been advised."
   (ad-pushnew-advised-function function)
   (ad-set-advice-info function (list (cons 'active nil))))
 
-(defmacro ad-get-advice-info-field (function field)
+(defsubst ad-get-advice-info-field (function field)
   "Retrieve the value of the advice info FIELD of FUNCTION."
-  `(cdr (assq ,field (ad-get-advice-info-macro ,function))))
+  (cdr (assq field (ad-get-advice-info function))))
 
 (defun ad-set-advice-info-field (function field value)
   "Destructively modify VALUE of the advice info FIELD of FUNCTION."
-  (and (ad-is-advised function)
-       (cond ((assq field (ad-get-advice-info-macro function))
-             ;; A field with that name is already present:
-              (rplacd (assq field (ad-get-advice-info-macro function)) value))
-            (t;; otherwise, create a new field with that name:
-             (nconc (ad-get-advice-info-macro function)
-                    (list (cons field value)))))))
+  (let ((info (ad-get-advice-info function)))
+    (and info
+         (cond ((assq field info)
+               ;; A field with that name is already present:
+                (rplacd (assq field info) value))
+              (t;; otherwise, create a new field with that name:
+               (nconc info (list (cons field value))))))))
 
 ;; Don't make this a macro so we can use it as a predicate:
 (defun ad-is-active (function)
@@ -1934,9 +1933,9 @@ be used to prompt for the function."
 ;; @@ Finding, enabling, adding and removing pieces of advice:
 ;; ===========================================================
 
-(defmacro ad-find-advice (function class name)
+(defsubst ad-find-advice (function class name)
   "Find the first advice of FUNCTION in CLASS with NAME."
-  `(assq ,name (ad-get-advice-info-field ,function ,class)))
+  (assq name (ad-get-advice-info-field function class)))
 
 (defun ad-advice-position (function class name)
   "Return position of first advice of FUNCTION in CLASS with NAME."
@@ -2104,34 +2103,33 @@ the cache-id will clear the cache."
 ;; @@ Accessing and manipulating function definitions:
 ;; ===================================================
 
-(defmacro ad-macrofy (definition)
+(defsubst ad-macrofy (definition)
   "Take a lambda function DEFINITION and make a macro out of it."
-  `(cons 'macro ,definition))
+  (cons 'macro definition))
 
-(defmacro ad-lambdafy (definition)
-  "Take a macro function DEFINITION and make a lambda out of it."
-  `(cdr ,definition))
+(defalias 'ad-lambdafy #'cdr
+  "Take a macro function DEFINITION and make a lambda out of it.")
 
-(defmacro ad-lambda-p (definition)
+(defsubst ad-lambda-p (definition)
   ;;"non-nil if DEFINITION is a lambda expression."
-  `(eq (car-safe ,definition) 'lambda))
+  (eq (car-safe definition) 'lambda))
 
 ;; see ad-make-advice for the format of advice definitions:
-(defmacro ad-advice-p (definition)
+(defsubst ad-advice-p (definition)
   ;;"non-nil if DEFINITION is a piece of advice."
-  `(eq (car-safe ,definition) 'advice))
+  (eq (car-safe definition) 'advice))
 
-(defmacro ad-compiled-p (definition)
+(defsubst ad-compiled-p (definition)
   "Return non-nil if DEFINITION is a compiled byte-code object."
-  `(or (byte-code-function-p ,definition)
-       (and (macrop ,definition)
-            (byte-code-function-p (ad-lambdafy ,definition)))))
+  (or (byte-code-function-p definition)
+       (and (macrop definition)
+            (byte-code-function-p (ad-lambdafy definition)))))
 
-(defmacro ad-compiled-code (compiled-definition)
+(defsubst ad-compiled-code (compiled-definition)
   "Return the byte-code object of a COMPILED-DEFINITION."
-  `(if (macrop ,compiled-definition)
-    (ad-lambdafy ,compiled-definition)
-    ,compiled-definition))
+  (if (macrop compiled-definition)
+    (ad-lambdafy compiled-definition)
+    compiled-definition))
 
 (defun ad-lambda-expression (definition)
   "Return the lambda expression of a function/macro/advice DEFINITION."
@@ -2692,15 +2690,15 @@ should be modified.  The assembled function will be 
returned."
 ;; the added efficiency.  The validation itself is also pretty cheap, certainly
 ;; a lot cheaper than reconstructing an advised definition.
 
-(defmacro ad-get-cache-definition (function)
-  `(car (ad-get-advice-info-field ,function 'cache)))
+(defsubst ad-get-cache-definition (function)
+  (car (ad-get-advice-info-field function 'cache)))
 
-(defmacro ad-get-cache-id (function)
-  `(cdr (ad-get-advice-info-field ,function 'cache)))
+(defsubst ad-get-cache-id (function)
+  (cdr (ad-get-advice-info-field function 'cache)))
 
-(defmacro ad-set-cache (function definition id)
-  `(ad-set-advice-info-field
-    ,function 'cache (cons ,definition ,id)))
+(defsubst ad-set-cache (function definition id)
+  (ad-set-advice-info-field
+    function 'cache (cons definition id)))
 
 (defun ad-clear-cache (function)
   "Clears a previously cached advised definition of FUNCTION.
@@ -3093,9 +3091,8 @@ deactivation, which might run hooks and get into other 
trouble."
 
 
 ;; Completion alist of valid `defadvice' flags
-(defvar ad-defadvice-flags
-  '(("protect") ("disable") ("activate")
-    ("compile") ("preactivate")))
+(defconst ad-defadvice-flags
+  '("protect" "disable" "activate" "compile" "preactivate"))
 
 ;;;###autoload
 (defmacro defadvice (function args &rest body)
@@ -3175,7 +3172,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] 
[ARGLIST] FLAG...)
              (let ((completion
                     (try-completion (symbol-name flag) ad-defadvice-flags)))
                (cond ((eq completion t) flag)
-                     ((assoc completion ad-defadvice-flags)
+                     ((member completion ad-defadvice-flags)
                       (intern completion))
                      (t (error "defadvice: Invalid or ambiguous flag: %s"
                                flag))))))
@@ -3216,7 +3213,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] 
[ARGLIST] FLAG...)
 For any members of FUNCTIONS that are not currently advised the rebinding will
 be a noop.  Any modifications done to the definitions of FUNCTIONS will be
 undone on exit of this macro."
-  (declare (indent 1))
+  (declare (indent 1) (obsolete nil "27.1"))
   (let* ((index -1)
         ;; Make let-variables to store current definitions:
         (current-bindings



reply via email to

[Prev in Thread] Current Thread [Next in Thread]