mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-14 09:39:42 +00:00
Code Issues Releases Activity

Use named functions in {defun,macro}-declarations-alist (Bug#40491)

Browse Source 
* 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.
This commit is contained in:
Philipp Stephani 2020-04-12 12:01:47 +02:00
parent c7ecc6bbc0
commit 4f197a5e79
1 changed files with 81 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

139
lisp/emacs-lisp/byte-run.el
View File

@ -82,65 +82,84 @@ The return value of this function is not used."
;; We define macro-declaration-alist here because it is needed to ;; We define macro-declaration-alist here because it is needed to
;; handle declarations in macro definitions and this is the first file ;; handle declarations in macro definitions and this is the first file
;; loaded by loadup.el that uses declarations in macros. ;; loaded by loadup.el that uses declarations in macros. We specify
;; the values as named aliases so that `describe-variable' prints
;; something useful; cf. Bug#40491. We can only use backquotes inside
;; the lambdas and not for those properties that are used by functions
;; loaded before backquote.el.
(defalias 'byte-run--set-advertised-calling-convention
#'(lambda (f _args arglist when)
(list 'set-advertised-calling-convention
(list 'quote f) (list 'quote arglist) (list 'quote when))))
(defalias 'byte-run--set-obsolete
#'(lambda (f _args new-name when)
(list 'make-obsolete
(list 'quote f) (list 'quote new-name) (list 'quote when))))
(defalias 'byte-run--set-interactive-only
#'(lambda (f _args instead)
(list 'function-put (list 'quote f)
''interactive-only (list 'quote instead))))
(defalias 'byte-run--set-pure
#'(lambda (f _args val)
(list 'function-put (list 'quote f)
''pure (list 'quote val))))
(defalias 'byte-run--set-side-effect-free
#'(lambda (f _args val)
(list 'function-put (list 'quote f)
''side-effect-free (list 'quote val))))
(defalias 'byte-run--set-compiler-macro
#'(lambda (f args compiler-function)
(if (not (eq (car-safe compiler-function) 'lambda))
`(eval-and-compile
(function-put ',f 'compiler-macro #',compiler-function))
(let ((cfname (intern (concat (symbol-name f) "--anon-cmacro")))
;; Avoid cadr/cddr so we can use `compiler-macro' before
;; defining cadr/cddr.
(data (cdr compiler-function)))
`(progn
(eval-and-compile
(function-put ',f 'compiler-macro #',cfname))
;; Don't autoload the compiler-macro itself, since the
;; macroexpander will find this file via `f's autoload,
;; if needed.
:autoload-end
(eval-and-compile
(defun ,cfname (,@(car data) ,@args)
,@(cdr data))))))))
(defalias 'byte-run--set-doc-string
#'(lambda (f _args pos)
(list 'function-put (list 'quote f)
''doc-string-elt (list 'quote pos))))
(defalias 'byte-run--set-indent
#'(lambda (f _args val)
(list 'function-put (list 'quote f)
''lisp-indent-function (list 'quote val))))
;; Add any new entries to info node `(elisp)Declare Form'. ;; Add any new entries to info node `(elisp)Declare Form'.
(defvar defun-declarations-alist (defvar defun-declarations-alist
(list (list
;; We can only use backquotes inside the lambdas and not for those
;; properties that are used by functions loaded before backquote.el.
(list 'advertised-calling-convention (list 'advertised-calling-convention
#'(lambda (f _args arglist when) #'byte-run--set-advertised-calling-convention)
(list 'set-advertised-calling-convention (list 'obsolete #'byte-run--set-obsolete)
(list 'quote f) (list 'quote arglist) (list 'quote when)))) (list 'interactive-only #'byte-run--set-interactive-only)
(list 'obsolete
#'(lambda (f _args new-name when)
(list 'make-obsolete
(list 'quote f) (list 'quote new-name) (list 'quote when))))
(list 'interactive-only
#'(lambda (f _args instead)
(list 'function-put (list 'quote f)
''interactive-only (list 'quote instead))))
;; FIXME: Merge `pure' and `side-effect-free'. ;; FIXME: Merge `pure' and `side-effect-free'.
(list 'pure (list 'pure #'byte-run--set-pure
#'(lambda (f _args val)
(list 'function-put (list 'quote f)
''pure (list 'quote val)))
"If non-nil, the compiler can replace calls with their return value. "If non-nil, the compiler can replace calls with their return value.
This may shift errors from run-time to compile-time.") This may shift errors from run-time to compile-time.")
(list 'side-effect-free (list 'side-effect-free #'byte-run--set-side-effect-free
#'(lambda (f _args val)
(list 'function-put (list 'quote f)
''side-effect-free (list 'quote val)))
"If non-nil, calls can be ignored if their value is unused. "If non-nil, calls can be ignored if their value is unused.
If `error-free', drop calls even if `byte-compile-delete-errors' is nil.") If `error-free', drop calls even if `byte-compile-delete-errors' is nil.")
(list 'compiler-macro (list 'compiler-macro #'byte-run--set-compiler-macro)
#'(lambda (f args compiler-function) (list 'doc-string #'byte-run--set-doc-string)
(if (not (eq (car-safe compiler-function) 'lambda)) (list 'indent #'byte-run--set-indent))
`(eval-and-compile
(function-put ',f 'compiler-macro #',compiler-function))
(let ((cfname (intern (concat (symbol-name f) "--anon-cmacro")))
;; Avoid cadr/cddr so we can use `compiler-macro' before
;; defining cadr/cddr.
(data (cdr compiler-function)))
`(progn
(eval-and-compile
(function-put ',f 'compiler-macro #',cfname))
;; Don't autoload the compiler-macro itself, since the
;; macroexpander will find this file via `f's autoload,
;; if needed.
:autoload-end
(eval-and-compile
(defun ,cfname (,@(car data) ,@args)
,@(cdr data))))))))
(list 'doc-string
#'(lambda (f _args pos)
(list 'function-put (list 'quote f)
''doc-string-elt (list 'quote pos))))
(list 'indent
#'(lambda (f _args val)
(list 'function-put (list 'quote f)
''lisp-indent-function (list 'quote val)))))
"List associating function properties to their macro expansion. "List associating function properties to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is Each element of the list takes the form (PROP FUN) where FUN is
a function. For each (PROP . VALUES) in a function's declaration, a function. For each (PROP . VALUES) in a function's declaration,
@ -150,18 +169,22 @@ to set this property.
This is used by `declare'.") This is used by `declare'.")
(defalias 'byte-run--set-debug
#'(lambda (name _args spec)
(list 'progn :autoload-end
(list 'put (list 'quote name)
''edebug-form-spec (list 'quote spec)))))
(defalias 'byte-run--set-no-font-lock-keyword
#'(lambda (name _args val)
(list 'function-put (list 'quote name)
''no-font-lock-keyword (list 'quote val))))
(defvar macro-declarations-alist (defvar macro-declarations-alist
(cons (cons
(list 'debug (list 'debug #'byte-run--set-debug)
#'(lambda (name _args spec)
(list 'progn :autoload-end
(list 'put (list 'quote name)
''edebug-form-spec (list 'quote spec)))))
(cons (cons
(list 'no-font-lock-keyword (list 'no-font-lock-keyword #'byte-run--set-no-font-lock-keyword)
#'(lambda (name _args val)
(list 'function-put (list 'quote name)
''no-font-lock-keyword (list 'quote val))))
defun-declarations-alist)) defun-declarations-alist))
"List associating properties of macros to their macro expansion. "List associating properties of macros to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is a function. Each element of the list takes the form (PROP FUN) where FUN is a function.