From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Stefan Monnier via "Bug reports for GNU Emacs, the Swiss army knife of text editors" Newsgroups: gmane.emacs.bugs Subject: bug#56648: Acknowledgement (29.0.50; Need for `compiled-function-p`) Date: Fri, 22 Jul 2022 01:07:09 -0400 Message-ID: References: Reply-To: Stefan Monnier Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="1993"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) To: 56648@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Jul 22 07:08:27 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1oEktn-0000LX-AM for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 22 Jul 2022 07:08:27 +0200 Original-Received: from localhost ([::1]:60326 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oEktm-0002rh-3f for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 22 Jul 2022 01:08:26 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:51862) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oEktO-0002rT-JN for bug-gnu-emacs@gnu.org; Fri, 22 Jul 2022 01:08:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:50089) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oEktO-0004OE-1w for bug-gnu-emacs@gnu.org; Fri, 22 Jul 2022 01:08:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oEktN-0001vp-Qu for bug-gnu-emacs@gnu.org; Fri, 22 Jul 2022 01:08:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 22 Jul 2022 05:08:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56648 X-GNU-PR-Package: emacs Original-Received: via spool by 56648-submit@debbugs.gnu.org id=B56648.16584664507386 (code B ref 56648); Fri, 22 Jul 2022 05:08:01 +0000 Original-Received: (at 56648) by debbugs.gnu.org; 22 Jul 2022 05:07:30 +0000 Original-Received: from localhost ([127.0.0.1]:39838 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oEksr-0001v3-SR for submit@debbugs.gnu.org; Fri, 22 Jul 2022 01:07:30 -0400 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:45294) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oEksp-0001un-Aj for 56648@debbugs.gnu.org; Fri, 22 Jul 2022 01:07:28 -0400 Original-Received: from pmg3.iro.umontreal.ca (localhost [127.0.0.1]) by pmg3.iro.umontreal.ca (Proxmox) with ESMTP id 67C3544050C; Fri, 22 Jul 2022 01:07:21 -0400 (EDT) Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg3.iro.umontreal.ca (Proxmox) with ESMTP id A9F0D440320; Fri, 22 Jul 2022 01:07:10 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1658466430; bh=4W7CTcPvDLrckfMrPK8a3drwSyzV20I0lqiFxLEUdnc=; h=From:To:Subject:In-Reply-To:References:Date:From; b=Gyyd3ShfwDOaG1ypc04S6iNiEdMs5E4zYenLydPF05bBULCs0PXPcSpFS6mQUCy/K emGWf3VXVUjI3pTIv+5kNzQKdDadO7S8eYNydAmLC/bF1EN/9CNk1pdXBxk+DFkPjE CFh4S+AnYg2g44HH0iCuVeKkVSecN9eOVYc7FH0pvOFLby0S3zzZmjHo68GXzi80U2 EBLk5YWiGvjmzCwwQ5fRc0/cCWJrdM38XQQnE3UFuX+D4KqhxsymXGRiUWFE1v4Wif 3gnrBtgTYUrG8hJ239fU4D/IQtqNwA5lOPCkV1onU+7WDZ5Ans6bi9t8q1uNjnRJyZ g+Qfcxv0Z+D2w== Original-Received: from pastel (unknown [45.72.195.111]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id 779B51202CE; Fri, 22 Jul 2022 01:07:10 -0400 (EDT) In-Reply-To: (GNU bug Tracking System's message of "Tue, 19 Jul 2022 20:44:02 +0000") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:237582 Archived-At: --=-=-= Content-Type: text/plain Here is a draft of a patch for that (no docs yet). Any comment/suggestion? Stefan --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=compiled-function.patch diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index 0a9fd5108ce..78dd1c37288 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -1083,8 +1083,8 @@ unidata-split-name (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/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el index 1e52b1f8504..1ab27e33403 100644 --- a/lisp/cedet/semantic/bovine.el +++ b/lisp/cedet/semantic/bovine.el @@ -143,14 +143,15 @@ semantic-bovinate-stream cvl nil ;re-init the collected value list. lte (car matchlist) ;Get the local matchlist entry. ) - (if (or (byte-code-function-p (car lte)) + ;; FIXME: Should this `or' be replaced with `functionp'? + (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 86a42b208e7..11d055e2059 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1060,9 +1060,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) @@ -1304,7 +1304,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) @@ -1335,7 +1335,7 @@ ;; ;; A new uncompiled advised definition got constructed: ;; -;; (byte-code-function-p 'ad-Advice-fum) +;; (compiled-function-p 'ad-Advice-fum) ;; nil ;; ;; (fum 2) @@ -2124,9 +2124,9 @@ ad-advice-p (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 5705b2a8fd7..0f4131a658d 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -2476,8 +2476,7 @@ byte-optimize-lapcode ;; 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 86681cf4dd4..2cccc85f9c3 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1393,7 +1393,7 @@ byte-compile-fdefinition (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. @@ -1405,7 +1405,7 @@ byte-compile-fdefinition (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) @@ -2957,11 +2957,11 @@ byte-compile (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) @@ -3538,7 +3538,7 @@ byte-compile-inline-lapcode (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)) @@ -5272,11 +5272,13 @@ display-call-tree ((not (consp f)) "") ((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))))) " " " ")) ((assq 'byte-code (cdr (cdr f))) + ;; FIXME: Can this still happen? "") ((eq 'lambda (car f)) "") @@ -5525,9 +5527,7 @@ byte-compile-report-ops ;; 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 6646167b92b..ea3c23e7b54 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3408,7 +3408,7 @@ cl--macroexp-fboundp (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 6a193a56d2d..5ae9d8368f0 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -823,7 +823,7 @@ internal-macroexpand-for-load (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 07443dabfef..10bd4bc6886 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -607,31 +607,38 @@ pcase-mutually-exclusive-predicates (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 @@ pcase--split-pred ((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 8221f3017a2..7896babbb35 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -4169,8 +4169,7 @@ gnus ;; 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 dc64a09f3d8..7978108988b 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1009,7 +1009,7 @@ help-fns-function-description-header (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 (compiled-function-p def) (keymapp def) (memq (car-safe def) '(macro lambda closure))) (stringp file-name) @@ -1044,7 +1044,7 @@ help-fns-function-description-header (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")) @@ -1538,8 +1538,8 @@ help-fns--var-safe-local (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 21a87dbd77b..669470926fe 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -159,8 +159,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 a3a363e33ff..741de9cb88a 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -389,11 +389,11 @@ mh-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 510a77dbc8d..a3066cf96fd 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4019,6 +4019,12 @@ macrop (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))) + (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 27a4e70c78e..774a3ea7ec9 100644 --- a/test/lisp/international/ucs-normalize-tests.el +++ b/test/lisp/international/ucs-normalize-tests.el @@ -246,7 +246,7 @@ ucs-normalize-part1 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 --=-=-=--