mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-07 06:50:23 -08:00
Code Issues Projects Releases Wiki Activity

(compiled-function-p): New function (bug#56648)

Browse source 
* lisp/subr.el (compiled-function-p): New function.

* test/lisp/international/ucs-normalize-tests.el (ucs-normalize-part1):
* lisp/gnus/gnus.el (gnus):
* lisp/mh-e/mh-e.el (mh-version):
* lisp/emacs-lisp/macroexp.el (emacs-startup-hook):
* lisp/emacs-lisp/cl-macs.el (compiled-function):
* lisp/emacs-lisp/bytecomp.el (byte-compile-fdefinition)
(byte-compile, display-call-tree):
* lisp/emacs-lisp/byte-opt.el (<toplevel-end>):
* lisp/emacs-lisp/advice.el (ad-compiled-p):
* lisp/cedet/semantic/bovine.el (semantic-bovinate-stream):
* lisp/loadup.el (macroexpand-all):
* admin/unidata/unidata-gen.el (unidata--ensure-compiled): Use it.

* lisp/emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates):
Add entries for it.
(pcase--split-pred): Use it.

* lisp/help-fns.el (help-fns-function-description-header): Use `functionp`.
(help-fns--var-safe-local): Use `compiled-function-p`.
This commit is contained in:
Stefan Monnier 2022-08-14 12:28:37 -04:00
parent 1d3fe25690
commit 1faeef7924
17 changed files with 63 additions and 42 deletions
Download patch file Download diff file Expand all files Collapse all files

14
lisp/emacs-lisp/advice.el
View file

@ -1054,9 +1054,9 @@
;; (print "Let's clean up now!"))
;; foo
;;
;; Now `foo's advice is byte-compiled:
;; Now `foo's advice is compiled:
;;
;; (byte-code-function-p 'ad-Advice-foo)
;; (compiled-function-p 'ad-Advice-foo)
;; t
;;
;; (foo 3)
@ -1298,7 +1298,7 @@
;; constructed during preactivation was used, even though we did not specify
;; the `compile' flag:
;;
;; (byte-code-function-p 'ad-Advice-fum)
;; (compiled-function-p 'ad-Advice-fum)
;; t
;;
;; (fum 2)
@ -1329,7 +1329,7 @@
;;
;; A new uncompiled advised definition got constructed:
;;
;; (byte-code-function-p 'ad-Advice-fum)
;; (compiled-function-p 'ad-Advice-fum)
;; nil
;;
;; (fum 2)
@ -2116,9 +2116,9 @@ the cache-id will clear the cache."
(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 (compiled-function-p definition)
(and (macrop definition)
(compiled-function-p (ad-lambdafy definition)))))
(defsubst ad-compiled-code (compiled-definition)
"Return the byte-code object of a COMPILED-DEFINITION."

3
lisp/emacs-lisp/byte-opt.el
View file

@ -2479,8 +2479,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
;; itself, compile some of its most used recursive functions (at load time).
;;
(eval-when-compile
(or (byte-code-function-p (symbol-function 'byte-optimize-form))
(subr-native-elisp-p (symbol-function 'byte-optimize-form))
(or (compiled-function-p (symbol-function 'byte-optimize-form))
(assq 'byte-code (symbol-function 'byte-optimize-form))
(let ((byte-optimize nil)
(byte-compile-warnings nil))

24
lisp/emacs-lisp/bytecomp.el
View file

@ -1395,7 +1395,7 @@ when printing the error message."
(or (symbolp (symbol-function fn))
(consp (symbol-function fn))
(and (not macro-p)
(byte-code-function-p (symbol-function fn)))))
(compiled-function-p (symbol-function fn)))))
(setq fn (symbol-function fn)))
(let ((advertised (gethash (if (and (symbolp fn) (fboundp fn))
;; Could be a subr.
@ -1407,7 +1407,7 @@ when printing the error message."
(if macro-p
`(macro lambda ,advertised)
`(lambda ,advertised)))
((and (not macro-p) (byte-code-function-p fn)) fn)
((and (not macro-p) (compiled-function-p fn)) fn)
((not (consp fn)) nil)
((eq 'macro (car fn)) (cdr fn))
(macro-p nil)
@ -2946,11 +2946,11 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(setq fun (cdr fun)))
(prog1
(cond
;; Up until Emacs-24.1, byte-compile silently did nothing when asked to
;; compile something invalid. So let's tune down the complaint from an
;; error to a simple message for the known case where signaling an error
;; causes problems.
((byte-code-function-p fun)
;; Up until Emacs-24.1, byte-compile silently did nothing
;; when asked to compile something invalid. So let's tone
;; down the complaint from an error to a simple message for
;; the known case where signaling an error causes problems.
((compiled-function-p fun)
(message "Function %s is already compiled"
(if (symbolp form) form "provided"))
fun)
@ -3527,7 +3527,7 @@ lambda-expression."
(byte-compile-out-tag endtag)))
(defun byte-compile-unfold-bcf (form)
"Inline call to byte-code-functions."
"Inline call to byte-code function."
(let* ((byte-compile-bound-variables byte-compile-bound-variables)
(fun (car form))
(fargs (aref fun 0))
@ -5254,11 +5254,13 @@ invoked interactively."
((not (consp f))
"<malformed function>")
((eq 'macro (car f))
(if (or (byte-code-function-p (cdr f))
(if (or (compiled-function-p (cdr f))
;; FIXME: Can this still happen?
(assq 'byte-code (cdr (cdr (cdr f)))))
" <compiled macro>"
" <macro>"))
((assq 'byte-code (cdr (cdr f)))
;; FIXME: Can this still happen?
"<compiled lambda>")
((eq 'lambda (car f))
"<function>")
@ -5507,9 +5509,7 @@ and corresponding effects."
;; itself, compile some of its most used recursive functions (at load time).
;;
(eval-when-compile
(or (byte-code-function-p (symbol-function 'byte-compile-form))
(subr-native-elisp-p (symbol-function 'byte-compile-form))
(assq 'byte-code (symbol-function 'byte-compile-form))
(or (compiled-function-p (symbol-function 'byte-compile-form))
(let ((byte-optimize nil) ; do it fast
(byte-compile-warnings nil))
(mapc (lambda (x)

2
lisp/emacs-lisp/cl-macs.el
View file

@ -3411,7 +3411,7 @@ Of course, we really can't know that for sure, so it's just a heuristic."
(character . natnump)
(char-table . char-table-p)
(command . commandp)
(compiled-function . byte-code-function-p)
(compiled-function . compiled-function-p)
(hash-table . hash-table-p)
(cons . consp)
(fixnum . fixnump)

2
lisp/emacs-lisp/macroexp.el
View file

@ -823,7 +823,7 @@ test of free variables in the following ways:
(eval-when-compile
(add-hook 'emacs-startup-hook
(lambda ()
(and (not (byte-code-function-p
(and (not (compiled-function-p
(symbol-function 'macroexpand-all)))
(locate-library "macroexp.elc")
(load "macroexp.elc")))))

13
lisp/emacs-lisp/pcase.el
View file

@ -607,31 +607,38 @@ recording whether the var has been referenced by earlier parts of the match."
(symbolp . vectorp)
(symbolp . stringp)
(symbolp . byte-code-function-p)
(symbolp . compiled-function-p)
(symbolp . recordp)
(integerp . consp)
(integerp . arrayp)
(integerp . vectorp)
(integerp . stringp)
(integerp . byte-code-function-p)
(integerp . compiled-function-p)
(integerp . recordp)
(numberp . consp)
(numberp . arrayp)
(numberp . vectorp)
(numberp . stringp)
(numberp . byte-code-function-p)
(numberp . compiled-function-p)
(numberp . recordp)
(consp . arrayp)
(consp . atom)
(consp . vectorp)
(consp . stringp)
(consp . byte-code-function-p)
(consp . compiled-function-p)
(consp . recordp)
(arrayp . byte-code-function-p)
(arrayp . compiled-function-p)
(vectorp . byte-code-function-p)
(vectorp . compiled-function-p)
(vectorp . recordp)
(stringp . vectorp)
(stringp . recordp)
(stringp . byte-code-function-p)))
(stringp . byte-code-function-p)
(stringp . compiled-function-p)))
(defun pcase--mutually-exclusive-p (pred1 pred2)
(or (member (cons pred1 pred2)
@ -771,8 +778,8 @@ A and B can be one of:
((consp (cadr pat)) #'consp)
((stringp (cadr pat)) #'stringp)
((vectorp (cadr pat)) #'vectorp)
((byte-code-function-p (cadr pat))
#'byte-code-function-p))))
((compiled-function-p (cadr pat))
#'compiled-function-p))))
(pcase--mutually-exclusive-p (cadr upat) otherpred))
'(:pcase--fail . nil))
;; Since we turn (or 'a 'b 'c) into (pred (pcase--flip (memq '(a b c))))