diff options
| author | Philipp Stephani | 2020-04-12 12:01:47 +0200 |
|---|---|---|
| committer | Philipp Stephani | 2020-04-12 13:18:43 +0200 |
| commit | 4f197a5e79ef25bcbcb3bf50ab3071fd0f1fae9e (patch) | |
| tree | b2db20cd044771b1b6af6d07e761ffcd72e3fcea | |
| parent | c7ecc6bbc03af4c2746e2e8765dbbe5bf4a3a908 (diff) | |
| download | emacs-4f197a5e79ef25bcbcb3bf50ab3071fd0f1fae9e.tar.gz emacs-4f197a5e79ef25bcbcb3bf50ab3071fd0f1fae9e.zip | |
Use named functions in {defun,macro}-declarations-alist (Bug#40491)
* lisp/emacs-lisp/byte-run.el (byte-run--set-advertised-calling-convention)
(byte-run--set-obsolete, byte-run--set-interactive-only)
(byte-run--set-pure, byte-run--set-side-effect-free)
(byte-run--set-compiler-macro, byte-run--set-doc-string)
(byte-run--set-indent, byte-run--set-debug)
(byte-run--set-no-font-lock-keyword): New helper functions.
(defun-declarations-alist, macro-declarations-alist): Use them.
| -rw-r--r-- | lisp/emacs-lisp/byte-run.el | 139 |
1 files changed, 81 insertions, 58 deletions
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 6a49c60099d..fa769adb061 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el | |||
| @@ -82,65 +82,84 @@ The return value of this function is not used." | |||
| 82 | 82 | ||
| 83 | ;; We define macro-declaration-alist here because it is needed to | 83 | ;; We define macro-declaration-alist here because it is needed to |
| 84 | ;; handle declarations in macro definitions and this is the first file | 84 | ;; handle declarations in macro definitions and this is the first file |
| 85 | ;; loaded by loadup.el that uses declarations in macros. | 85 | ;; loaded by loadup.el that uses declarations in macros. We specify |
| 86 | ;; the values as named aliases so that `describe-variable' prints | ||
| 87 | ;; something useful; cf. Bug#40491. We can only use backquotes inside | ||
| 88 | ;; the lambdas and not for those properties that are used by functions | ||
| 89 | ;; loaded before backquote.el. | ||
| 90 | |||
| 91 | (defalias 'byte-run--set-advertised-calling-convention | ||
| 92 | #'(lambda (f _args arglist when) | ||
| 93 | (list 'set-advertised-calling-convention | ||
| 94 | (list 'quote f) (list 'quote arglist) (list 'quote when)))) | ||
| 95 | |||
| 96 | (defalias 'byte-run--set-obsolete | ||
| 97 | #'(lambda (f _args new-name when) | ||
| 98 | (list 'make-obsolete | ||
| 99 | (list 'quote f) (list 'quote new-name) (list 'quote when)))) | ||
| 100 | |||
| 101 | (defalias 'byte-run--set-interactive-only | ||
| 102 | #'(lambda (f _args instead) | ||
| 103 | (list 'function-put (list 'quote f) | ||
| 104 | ''interactive-only (list 'quote instead)))) | ||
| 105 | |||
| 106 | (defalias 'byte-run--set-pure | ||
| 107 | #'(lambda (f _args val) | ||
| 108 | (list 'function-put (list 'quote f) | ||
| 109 | ''pure (list 'quote val)))) | ||
| 110 | |||
| 111 | (defalias 'byte-run--set-side-effect-free | ||
| 112 | #'(lambda (f _args val) | ||
| 113 | (list 'function-put (list 'quote f) | ||
| 114 | ''side-effect-free (list 'quote val)))) | ||
| 115 | |||
| 116 | (defalias 'byte-run--set-compiler-macro | ||
| 117 | #'(lambda (f args compiler-function) | ||
| 118 | (if (not (eq (car-safe compiler-function) 'lambda)) | ||
| 119 | `(eval-and-compile | ||
| 120 | (function-put ',f 'compiler-macro #',compiler-function)) | ||
| 121 | (let ((cfname (intern (concat (symbol-name f) "--anon-cmacro"))) | ||
| 122 | ;; Avoid cadr/cddr so we can use `compiler-macro' before | ||
| 123 | ;; defining cadr/cddr. | ||
| 124 | (data (cdr compiler-function))) | ||
| 125 | `(progn | ||
| 126 | (eval-and-compile | ||
| 127 | (function-put ',f 'compiler-macro #',cfname)) | ||
| 128 | ;; Don't autoload the compiler-macro itself, since the | ||
| 129 | ;; macroexpander will find this file via `f's autoload, | ||
| 130 | ;; if needed. | ||
| 131 | :autoload-end | ||
| 132 | (eval-and-compile | ||
| 133 | (defun ,cfname (,@(car data) ,@args) | ||
| 134 | ,@(cdr data)))))))) | ||
| 135 | |||
| 136 | (defalias 'byte-run--set-doc-string | ||
| 137 | #'(lambda (f _args pos) | ||
| 138 | (list 'function-put (list 'quote f) | ||
| 139 | ''doc-string-elt (list 'quote pos)))) | ||
| 140 | |||
| 141 | (defalias 'byte-run--set-indent | ||
| 142 | #'(lambda (f _args val) | ||
| 143 | (list 'function-put (list 'quote f) | ||
| 144 | ''lisp-indent-function (list 'quote val)))) | ||
| 86 | 145 | ||
| 87 | ;; Add any new entries to info node `(elisp)Declare Form'. | 146 | ;; Add any new entries to info node `(elisp)Declare Form'. |
| 88 | (defvar defun-declarations-alist | 147 | (defvar defun-declarations-alist |
| 89 | (list | 148 | (list |
| 90 | ;; We can only use backquotes inside the lambdas and not for those | ||
| 91 | ;; properties that are used by functions loaded before backquote.el. | ||
| 92 | (list 'advertised-calling-convention | 149 | (list 'advertised-calling-convention |
| 93 | #'(lambda (f _args arglist when) | 150 | #'byte-run--set-advertised-calling-convention) |
| 94 | (list 'set-advertised-calling-convention | 151 | (list 'obsolete #'byte-run--set-obsolete) |
| 95 | (list 'quote f) (list 'quote arglist) (list 'quote when)))) | 152 | (list 'interactive-only #'byte-run--set-interactive-only) |
| 96 | (list 'obsolete | ||
| 97 | #'(lambda (f _args new-name when) | ||
| 98 | (list 'make-obsolete | ||
| 99 | (list 'quote f) (list 'quote new-name) (list 'quote when)))) | ||
| 100 | (list 'interactive-only | ||
| 101 | #'(lambda (f _args instead) | ||
| 102 | (list 'function-put (list 'quote f) | ||
| 103 | ''interactive-only (list 'quote instead)))) | ||
| 104 | ;; FIXME: Merge `pure' and `side-effect-free'. | 153 | ;; FIXME: Merge `pure' and `side-effect-free'. |
| 105 | (list 'pure | 154 | (list 'pure #'byte-run--set-pure |
| 106 | #'(lambda (f _args val) | ||
| 107 | (list 'function-put (list 'quote f) | ||
| 108 | ''pure (list 'quote val))) | ||
| 109 | "If non-nil, the compiler can replace calls with their return value. | 155 | "If non-nil, the compiler can replace calls with their return value. |
| 110 | This may shift errors from run-time to compile-time.") | 156 | This may shift errors from run-time to compile-time.") |
| 111 | (list 'side-effect-free | 157 | (list 'side-effect-free #'byte-run--set-side-effect-free |
| 112 | #'(lambda (f _args val) | ||
| 113 | (list 'function-put (list 'quote f) | ||
| 114 | ''side-effect-free (list 'quote val))) | ||
| 115 | "If non-nil, calls can be ignored if their value is unused. | 158 | "If non-nil, calls can be ignored if their value is unused. |
| 116 | If `error-free', drop calls even if `byte-compile-delete-errors' is nil.") | 159 | If `error-free', drop calls even if `byte-compile-delete-errors' is nil.") |
| 117 | (list 'compiler-macro | 160 | (list 'compiler-macro #'byte-run--set-compiler-macro) |
| 118 | #'(lambda (f args compiler-function) | 161 | (list 'doc-string #'byte-run--set-doc-string) |
| 119 | (if (not (eq (car-safe compiler-function) 'lambda)) | 162 | (list 'indent #'byte-run--set-indent)) |
| 120 | `(eval-and-compile | ||
| 121 | (function-put ',f 'compiler-macro #',compiler-function)) | ||
| 122 | (let ((cfname (intern (concat (symbol-name f) "--anon-cmacro"))) | ||
| 123 | ;; Avoid cadr/cddr so we can use `compiler-macro' before | ||
| 124 | ;; defining cadr/cddr. | ||
| 125 | (data (cdr compiler-function))) | ||
| 126 | `(progn | ||
| 127 | (eval-and-compile | ||
| 128 | (function-put ',f 'compiler-macro #',cfname)) | ||
| 129 | ;; Don't autoload the compiler-macro itself, since the | ||
| 130 | ;; macroexpander will find this file via `f's autoload, | ||
| 131 | ;; if needed. | ||
| 132 | :autoload-end | ||
| 133 | (eval-and-compile | ||
| 134 | (defun ,cfname (,@(car data) ,@args) | ||
| 135 | ,@(cdr data)))))))) | ||
| 136 | (list 'doc-string | ||
| 137 | #'(lambda (f _args pos) | ||
| 138 | (list 'function-put (list 'quote f) | ||
| 139 | ''doc-string-elt (list 'quote pos)))) | ||
| 140 | (list 'indent | ||
| 141 | #'(lambda (f _args val) | ||
| 142 | (list 'function-put (list 'quote f) | ||
| 143 | ''lisp-indent-function (list 'quote val))))) | ||
| 144 | "List associating function properties to their macro expansion. | 163 | "List associating function properties to their macro expansion. |
| 145 | Each element of the list takes the form (PROP FUN) where FUN is | 164 | Each element of the list takes the form (PROP FUN) where FUN is |
| 146 | a function. For each (PROP . VALUES) in a function's declaration, | 165 | a function. For each (PROP . VALUES) in a function's declaration, |
| @@ -150,18 +169,22 @@ to set this property. | |||
| 150 | 169 | ||
| 151 | This is used by `declare'.") | 170 | This is used by `declare'.") |
| 152 | 171 | ||
| 172 | (defalias 'byte-run--set-debug | ||
| 173 | #'(lambda (name _args spec) | ||
| 174 | (list 'progn :autoload-end | ||
| 175 | (list 'put (list 'quote name) | ||
| 176 | ''edebug-form-spec (list 'quote spec))))) | ||
| 177 | |||
| 178 | (defalias 'byte-run--set-no-font-lock-keyword | ||
| 179 | #'(lambda (name _args val) | ||
| 180 | (list 'function-put (list 'quote name) | ||
| 181 | ''no-font-lock-keyword (list 'quote val)))) | ||
| 182 | |||
| 153 | (defvar macro-declarations-alist | 183 | (defvar macro-declarations-alist |
| 154 | (cons | 184 | (cons |
| 155 | (list 'debug | 185 | (list 'debug #'byte-run--set-debug) |
| 156 | #'(lambda (name _args spec) | ||
| 157 | (list 'progn :autoload-end | ||
| 158 | (list 'put (list 'quote name) | ||
| 159 | ''edebug-form-spec (list 'quote spec))))) | ||
| 160 | (cons | 186 | (cons |
| 161 | (list 'no-font-lock-keyword | 187 | (list 'no-font-lock-keyword #'byte-run--set-no-font-lock-keyword) |
| 162 | #'(lambda (name _args val) | ||
| 163 | (list 'function-put (list 'quote name) | ||
| 164 | ''no-font-lock-keyword (list 'quote val)))) | ||
| 165 | defun-declarations-alist)) | 188 | defun-declarations-alist)) |
| 166 | "List associating properties of macros to their macro expansion. | 189 | "List associating properties of macros to their macro expansion. |
| 167 | Each element of the list takes the form (PROP FUN) where FUN is a function. | 190 | Each element of the list takes the form (PROP FUN) where FUN is a function. |