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

* 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`.

diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 0a9fd5108ceefa9ef59d95332aaafd6fd08bbdac..78dd1c37288c19f96ccd515f6f2d0426f84be835 100644 (file)
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -1083,8 +1083,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
 
 (defun unidata--ensure-compiled (&rest funcs)
   (dolist (fun funcs)
-    (or (byte-code-function-p (symbol-function fun))
-       (byte-compile fun))))
+    (unless (compiled-function-p (symbol-function fun))
+      (byte-compile fun))))
 
 (defun unidata-gen-table-name (prop index &rest _ignore)
   (let* ((table (unidata-gen-table-word-list prop index 'unidata-split-name))

diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 8265e58210e2ca098bcb4498f511ed2765c3b3d8..a7ce3270f5fad56e6e5e45dc47dd06502d553370 100644 (file)
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -217,6 +217,11 @@ function.  For example:
 @end example
 @end defun
 
+@defun compiled-function-p object
+This function returns @code{t} if @var{object} is a function object
+implemented in byte-code or machine code.
+@end defun
+
 @defun subr-arity subr
 This works like @code{func-arity}, but only for built-in functions and
 without symbol indirection.  It signals an error for non-built-in

diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 1bae192455721edc3e9679e5a3ebd70858d7daa0..7b5e9adee291e7f66d8be615d6ba3240b38fbfd6 100644 (file)
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -2022,6 +2022,9 @@ with references to further information.
 @item byte-code-function-p
 @xref{Byte-Code Type, byte-code-function-p}.
 
+@item compiled-function-p
+@xref{Byte-Code Type, compiled-function-p}.
+
 @item case-table-p
 @xref{Case Tables, case-table-p}.
 

diff --git a/etc/NEWS b/etc/NEWS
index a455b88f6bb9414e6de5b83c2d1282652eeb479c..0584403d8c7fc215e38ff81a2f9dec1b4471446b 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2571,6 +2571,9 @@ patcomp.el, pc-mode.el, pc-select.el, s-region.el, and sregex.el.
 \f
 * Lisp Changes in Emacs 29.1
 
++++
+** New function 'compile-function-p'.
+
 ---
 ** 'deactivate-mark' can have new value 'dont-save'.
 This value means that Emacs should deactivate the mark as usual, but

diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el
index 1e52b1f8504fe05ace303ee20efb304217c4136b..a6cf8d89a4f0ef6313fcabb4934ae9b2f14a02b3 100644 (file)
--- a/lisp/cedet/semantic/bovine.el
+++ b/lisp/cedet/semantic/bovine.el
@@ -143,14 +143,14 @@ list of semantic tokens found."
                         cvl nil     ;re-init the collected value list.
                         lte (car matchlist) ;Get the local matchlist entry.
                         )
-                  (if (or (byte-code-function-p (car lte))
+                  (if (or (compiled-function-p (car lte))
                           (listp (car lte)))
                       ;; In this case, we have an EMPTY match!  Make
                       ;; stuff up.
                       (setq cvl (list nil))))
 
                 (while (and lte
-                            (not (byte-code-function-p (car lte)))
+                            (not (compiled-function-p (car lte)))
                             (not (listp (car lte))))
 
                   ;; GRAMMAR SOURCE DEBUGGING!

diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 391743d71564e92b5444b38c932b73a63888c133..d383650f4e569d0d9ee7c3f82b2278d9cd8e27c8 100644 (file)
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -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."

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index fdeb5db0ece1e2cd92de20b2fa7d58f1025414a6..52e0095284620c59063f70e14aa37ba0b609c3e0 100644 (file)
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -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))

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 9d5f6682b5a5f291d101bfb549812373e68d2c11..907015eb48e14ea937f8efb090d06269af2679c4 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -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)

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index eefaa36b9112ede5f184aab59fadf137b8b76e1f..80ca43c902a37146c72f31d400c25478f3cedfbc 100644 (file)
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -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)

diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 6a193a56d2dad95129e103be95294cf0f99ad3a1..5ae9d8368f0bcb9c6e71718f6d204ccb892e3dcb 100644 (file)
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -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")))))

diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 07443dabfefa091a0e014105db95a3d47c00b331..10bd4bc6886268dcde289f5a7c6e30641ef446fa 100644 (file)
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -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))))

diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index b036978efa8fc37c2bc373eccc8f7818a387190c..0afd873a5df5adcb7d5825a873f68736fea48a9b 100644 (file)
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -4166,8 +4166,7 @@ prompt the user for the name of an NNTP server to use."
   ;; file.
   (unless (string-match "^Gnus" gnus-version)
     (load "gnus-load" nil t))
-  (unless (or (byte-code-function-p (symbol-function 'gnus))
-             (subr-native-elisp-p (symbol-function 'gnus)))
+  (unless (compiled-function-p (symbol-function 'gnus))
     (message "You should compile Gnus")
     (sit-for 2))
   (let ((gnus-action-message-log (list nil)))

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 59a509b22157ff5104119bea5f64c04fe20354af..74e18285e6498ab3ec32d6f2d25b00725256a834 100644 (file)
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1005,9 +1005,9 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
                 (help-fns--analyze-function function))
                (file-name (find-lisp-object-file-name
                            function (if aliased 'defun def)))
-               (beg (if (and (or (byte-code-function-p def)
+               (beg (if (and (or (functionp def)
                                  (keymapp def)
-                                 (memq (car-safe def) '(macro lambda closure)))
+                                 (eq (car-safe def) 'macro))
                              (stringp file-name)
                              (help-fns--autoloaded-p function))
                         (concat
@@ -1040,7 +1040,7 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
                            (t "Lisp function"))))
                 ((or (eq (car-safe def) 'macro)
                      ;; For advised macros, def is a lambda
-                     ;; expression or a byte-code-function-p, so we
+                     ;; expression or a compiled-function-p, so we
                      ;; need to check macros before functions.
                      (macrop function))
                  (concat beg "Lisp macro"))
@@ -1534,8 +1534,8 @@ This cancels value editing without updating the value."
     (when safe-var
       (princ "  This variable is safe as a file local variable ")
       (princ "if its value\n  satisfies the predicate ")
-      (princ (if (byte-code-function-p safe-var)
-                "which is a byte-compiled expression.\n"
+      (princ (if (compiled-function-p safe-var)
+                "which is a compiled expression.\n"
               (format-message "`%s'.\n" safe-var))))))
 
 (add-hook 'help-fns-describe-variable-functions #'help-fns--var-risky)

diff --git a/lisp/loadup.el b/lisp/loadup.el
index 8dad382ac0ddfda909929e93239b54137ea0bc58..17e82cc0c49dc2124ffedb79e71d6e1361920f31 100644 (file)
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -154,8 +154,7 @@
 ;; Load-time macro-expansion can only take effect after setting
 ;; load-source-file-function because of where it is called in lread.c.
 (load "emacs-lisp/macroexp")
-(if (or (byte-code-function-p (symbol-function 'macroexpand-all))
-        (subr-native-elisp-p (symbol-function 'macroexpand-all)))
+(if (compiled-function-p (symbol-function 'macroexpand-all))
     nil
   ;; Since loaddefs is not yet loaded, macroexp's uses of pcase will simply
   ;; fail until pcase is explicitly loaded.  This also means that we have to

diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index 93af525e39d40410655741c1c58bd07dd228f845..a61620b2761ac43ad1243dcab1db3b6469b11c6f 100644 (file)
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -388,11 +388,11 @@ gnus-version)
   (insert "MH-E " mh-version "\n\n")
   ;; MH-E compilation details.
   (insert "MH-E compilation details:\n")
-  (let* ((compiled-mhe (byte-code-function-p (symbol-function 'mh-version)))
+  (let* ((compiled-mhe (compiled-function-p (symbol-function 'mh-version)))
          (gnus-compiled-version (if compiled-mhe
                                     (mh-macro-expansion-time-gnus-version)
                                   "N/A")))
-    (insert " Byte compiled:\t\t" (if compiled-mhe "yes" "no") "\n"
+    (insert " Compiled:\t\t" (if compiled-mhe "yes" "no") "\n"
             " Gnus (compile-time):\t" gnus-compiled-version "\n"
             " Gnus (run-time):\t" (mh-run-time-gnus-version) "\n\n"))
   ;; Emacs version.

diff --git a/lisp/subr.el b/lisp/subr.el
index 4b1fc832da15cdbcdaed85bb8baa9c3980863443..42ce9148a90ff0450604032dac676a8aefec7d5a 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4077,6 +4077,12 @@ Otherwise, return nil."
       (or (eq 'macro (car def))
           (and (autoloadp def) (memq (nth 4 def) '(macro t)))))))
 
+(defun compiled-function-p (object)
+  "Return non-nil if OBJECT is a function that has been compiled.
+Does not distinguish between functions implemented in machine code
+or byte-code."
+  (or (subrp object) (byte-code-function-p object)))
+
 (defun field-at-pos (pos)
   "Return the field at position POS, taking stickiness etc into account."
   (let ((raw-field (get-char-property (field-beginning pos) 'field)))

diff --git a/test/lisp/international/ucs-normalize-tests.el b/test/lisp/international/ucs-normalize-tests.el
index 27a4e70c78ebcd4e2999e3c3b8a12f5ea7322ab0..774a3ea7ec9778ef9a92f7a5ef9a2958a7201eb1 100644 (file)
--- a/test/lisp/international/ucs-normalize-tests.el
+++ b/test/lisp/international/ucs-normalize-tests.el
@@ -246,7 +246,7 @@ must be true for all conformant implementations:
                  ucs-normalize-tests--rule1-failing-for-partX
                  ucs-normalize-tests--rule1-holds-p
                  ucs-normalize-tests--rule2-holds-p))
-    (or (byte-code-function-p (symbol-function fun))
+    (or (compiled-function-p (symbol-function fun))
         (byte-compile fun)))
   (let ((ucs-normalize-tests--chars-part1 (make-char-table 'ucs-normalize-tests t)))
     (setq ucs-normalize-tests--part1-rule1-failed-lines