mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-24 07:20:37 +00:00
Code Issues Releases Activity

Redirect calls to subr-native-elisp-p to native-comp-function-p

Browse Source 
* test/src/comp-tests.el (comp-tests-bootstrap, lambda-return)
(lambda-return2, free-fun, free-fun2, free-fun-silly-name, speed--1)
(compile-forms, comp-test-defsubst, primitive-redefine-compile-44221)
(48029-1, 61917-1, tco, fw-prop-1, pure):
* test/lisp/help-fns-tests.el (help-fns-test-lisp-defun):
* lisp/subr.el (subr-primitive-p, primitive-function-p, symbol-file):
* lisp/help-fns.el (find-lisp-object-file-name):
* lisp/emacs-lisp/disass.el (disassemble-internal):
* lisp/emacs-lisp/comp.el (comp--call-optim-form-call):
* lisp/emacs-lisp/comp-run.el (comp-warn-primitives):
* lisp/emacs-lisp/comp-common.el (comp-function-type-spec):
* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns):
* lisp/emacs-lisp/bytecomp.el (<trailer>): Rename `subr-native-elisp-p`
to `native-comp-function-p`.
This commit is contained in:
Stefan Monnier 2024-05-22 14:45:35 -04:00
parent 1a1170cde7
commit fde8dc9287
10 changed files with 35 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lisp/emacs-lisp/byte-opt.el
View File

@ -1876,9 +1876,10 @@ See Info node `(elisp) Integer Basics'."
byteorder car-safe cdr-safe char-or-string-p char-table-p
condition-variable-p consp eq floatp indirect-function
integer-or-marker-p integerp keywordp listp markerp
module-function-p multibyte-string-p mutexp natnump nlistp null
module-function-p multibyte-string-p mutexp native-comp-function-p
natnump nlistp null
number-or-marker-p numberp recordp remove-pos-from-symbol
sequencep stringp subr-native-elisp-p subrp symbol-with-pos-p symbolp
sequencep stringp subrp symbol-with-pos-p symbolp
threadp type-of user-ptrp vector-or-char-table-p vectorp wholenump
;; editfns.c
bobp bolp buffer-size buffer-string current-message emacs-pid

2
lisp/emacs-lisp/bytecomp.el
View File

@ -6028,7 +6028,7 @@ and corresponding effects."
(let ((byte-optimize nil) ; do it fast
(byte-compile-warnings nil))
(mapc (lambda (x)
(unless (subr-native-elisp-p x)
(unless (native-comp-function-p x)
(or noninteractive (message "compiling %s..." x))
(byte-compile x)
(or noninteractive (message "compiling %s...done" x))))

2
lisp/emacs-lisp/comp-common.el
View File

@ -518,7 +518,7 @@ itself."
(if-let ((delc-type (function-get function 'function-type)))
;; Declared Lisp function
(setf type-spec delc-type)
(when (subr-native-elisp-p f)
(when (native-comp-function-p f)
;; Native compiled inferred
(setf kind 'inferred
type-spec (subr-type f))))))

2
lisp/emacs-lisp/comp-run.el
View File

@ -341,7 +341,7 @@ display a message."
(clrhash comp-deferred-pending-h)))
(defconst comp-warn-primitives
'(null memq gethash and subrp not subr-native-elisp-p
'(null memq gethash and subrp not native-comp-function-p
comp--install-trampoline concat if symbolp symbol-name make-string
length aset aref length> mapcar expand-file-name
file-name-as-directory file-exists-p native-elisp-load)

2
lisp/emacs-lisp/comp.el
View File

@ -2847,7 +2847,7 @@ FUNCTION can be a function-name or byte compiled function."
(subrp (subrp f))
(comp-func-callee (comp--func-in-unit callee)))
(cond
((and subrp (not (subr-native-elisp-p f)))
((and subrp (not (native-comp-function-p f)))
;; Trampoline removal.
(let* ((callee (intern (subr-name f))) ; Fix aliased names.
(maxarg (cdr (subr-arity f)))

4
lisp/emacs-lisp/disass.el
View File

@ -91,8 +91,8 @@ redefine OBJECT if it is a symbol."
args)
(setq obj (autoload-do-load obj name))
(if (subrp obj)
(if (and (fboundp 'subr-native-elisp-p)
(subr-native-elisp-p obj))
(if (and (fboundp 'native-comp-function-p)
(native-comp-function-p obj))
(progn
(require 'comp)
(let ((eln (native-comp-unit-file (subr-native-comp-unit obj))))

2
lisp/help-fns.el
View File

@ -478,7 +478,7 @@ the C sources, too."
(cond
((and (not file-name)
(subrp type)
(not (subr-native-elisp-p type)))
(not (native-comp-function-p type)))
;; A built-in function. The form is from `describe-function-1'.
(if (or (get-buffer " *DOC*")
(and also-c-source

8
lisp/subr.el
View File

@ -316,14 +316,14 @@ value of last one, or nil if there are none."
Such objects can be functions or special forms."
(declare (side-effect-free error-free))
(and (subrp object)
(not (subr-native-elisp-p object))))
(not (native-comp-function-p object))))
(defsubst primitive-function-p (object)
"Return t if OBJECT is a built-in primitive function.
This excludes special forms, since they are not functions."
(declare (side-effect-free error-free))
(and (subrp object)
(not (or (subr-native-elisp-p object)
(not (or (native-comp-function-p object)
(eq (cdr (subr-arity object)) 'unevalled)))))
(defsubst xor (cond1 cond2)
@ -3022,7 +3022,7 @@ This is to `put' what `defalias' is to `fset'."
(defvar comp-native-version-dir)
(defvar native-comp-eln-load-path)
(declare-function subr-native-elisp-p "data.c")
(declare-function native-comp-function-p "data.c")
(declare-function native-comp-unit-file "data.c")
(declare-function subr-native-comp-unit "data.c")
(declare-function comp-el-to-eln-rel-filename "comp.c")
@ -3071,7 +3071,7 @@ instead."
(symbolp symbol)
(native-comp-available-p)
;; If it's a defun, we have a shortcut.
(subr-native-elisp-p (symbol-function symbol)))
(native-comp-function-p (symbol-function symbol)))
;; native-comp-unit-file returns unnormalized file names.
(expand-file-name (native-comp-unit-file (subr-native-comp-unit
(symbol-function symbol))))

2
test/lisp/help-fns-tests.el
View File

@ -67,7 +67,7 @@ Return first line of the output of (describe-function-1 FUNC)."
(result (help-fns-tests--describe-function 'last)))
(should (string-match regexp result))
(should (member (match-string 1 result)
'("subr-native-elisp" "byte-code-function")))))
'("native-comp-function" "byte-code-function")))))
(ert-deftest help-fns-test-lisp-defsubst ()
(let ((regexp "a byte-code-function in .+subr\\.el")

40
test/src/comp-tests.el
View File

@ -85,13 +85,13 @@ Check that the resulting binaries do not differ."
(copy-file comp-src comp2-src t)
(let ((load-no-native t))
(load (concat comp-src "c") nil nil t t))
(should-not (subr-native-elisp-p (symbol-function 'native-compile)))
(should-not (native-comp-function-p (symbol-function 'native-compile)))
(message "Compiling stage1...")
(let* ((t0 (current-time))
(comp1-eln (native-compile comp1-src)))
(message "Done in %d secs" (float-time (time-since t0)))
(load comp1-eln nil nil t t)
(should (subr-native-elisp-p (symbol-function 'native-compile)))
(should (native-comp-function-p (symbol-function 'native-compile)))
(message "Compiling stage2...")
(let ((t0 (current-time))
(comp2-eln (native-compile comp2-src)))
@ -325,15 +325,15 @@ Check that the resulting binaries do not differ."
(comp-deftest lambda-return ()
(let ((f (comp-tests-lambda-return-f)))
(should (subr-native-elisp-p f))
(should (native-comp-function-p f))
(should (= (funcall f 3) 4))))
(comp-deftest lambda-return2 ()
"Check a nested lambda function gets native compiled."
(let ((f (comp-tests-lambda-return-f2)))
(should (subr-native-elisp-p f))
(should (native-comp-function-p f))
(let ((f2 (funcall f)))
(should (subr-native-elisp-p f2))
(should (native-comp-function-p f2))
(should (= (funcall f2 3) 4)))))
(comp-deftest recursive ()
@ -391,7 +391,7 @@ Check that the resulting binaries do not differ."
t)
(native-compile #'comp-tests-free-fun-f)
(should (subr-native-elisp-p (symbol-function 'comp-tests-free-fun-f)))
(should (native-comp-function-p (symbol-function 'comp-tests-free-fun-f)))
(should (= (comp-tests-free-fun-f) 3))
(should (string= (documentation #'comp-tests-free-fun-f)
"Some doc."))
@ -412,8 +412,8 @@ Check that the resulting binaries do not differ."
(let* ((f (symbol-function 'comp-tests-free-fun-f2))
(f2 (funcall f)))
(should (subr-native-elisp-p f))
(should (subr-native-elisp-p f2))
(should (native-comp-function-p f))
(should (native-comp-function-p f2))
(should (string= (documentation f2) "Some doc."))
(should (commandp f2))
(should (equal (interactive-form f2) '(interactive nil)))
@ -425,7 +425,7 @@ Check that the resulting binaries do not differ."
"Check we are able to compile a single function."
(eval '(defun comp-tests/free\fun-f ()) t)
(native-compile #'comp-tests/free\fun-f)
(should (subr-native-elisp-p (symbol-function 'comp-tests/free\fun-f))))
(should (native-comp-function-p (symbol-function 'comp-tests/free\fun-f))))
(comp-deftest bug-40187 ()
"Check function name shadowing.
@ -436,7 +436,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
(comp-deftest speed--1 ()
"Check that at speed -1 we do not native compile."
(should (= (comp-test-speed--1-f) 3))
(should-not (subr-native-elisp-p (symbol-function 'comp-test-speed--1-f))))
(should-not (native-comp-function-p (symbol-function 'comp-test-speed--1-f))))
(comp-deftest bug-42360 ()
"<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-07/msg00418.html>."
@ -497,22 +497,22 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
(should-error (native-compile '(+ 1 foo)))
(let ((lexical-binding t)
(f (native-compile '(lambda (x) (1+ x)))))
(should (subr-native-elisp-p f))
(should (native-comp-function-p f))
(should (= (funcall f 2) 3)))
(let* ((lexical-binding nil)
(f (native-compile '(lambda (x) (1+ x)))))
(should (subr-native-elisp-p f))
(should (native-comp-function-p f))
(should (= (funcall f 2) 3))))
(comp-deftest comp-test-defsubst ()
;; Bug#42664, Bug#43280, Bug#44209.
(should-not (subr-native-elisp-p (symbol-function 'comp-test-defsubst-f))))
(should-not (native-comp-function-p (symbol-function 'comp-test-defsubst-f))))
(comp-deftest primitive-redefine-compile-44221 ()
"Test the compiler still works while primitives are redefined (bug#44221)."
(cl-letf (((symbol-function 'delete-region)
(lambda (_ _))))
(should (subr-native-elisp-p
(should (native-comp-function-p
(native-compile
'(lambda ()
(delete-region (point-min) (point-max))))))))
@ -564,7 +564,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
(comp-deftest 48029-1 ()
"<https://lists.gnu.org/archive/html/bug-gnu-emacs/2022-07/msg00666.html>"
(should (subr-native-elisp-p
(should (native-comp-function-p
(symbol-function 'comp-test-48029-nonascii-žžž-f))))
(comp-deftest 61917-1 ()
@ -578,7 +578,7 @@ dedicated byte-op code."
(setf x (native-compile
'(lambda ()
(delete-region 1 2))))
(should (subr-native-elisp-p x))
(should (native-comp-function-p x))
(funcall x)
(advice-remove #'delete-region f)
(should (equal comp-test-primitive-redefine-args '(1 2))))))
@ -874,7 +874,7 @@ Return a list of results."
(comp-tests-tco-f (+ a b) a (- count 1))))
t)
(native-compile #'comp-tests-tco-f)
(should (subr-native-elisp-p (symbol-function 'comp-tests-tco-f)))
(should (native-comp-function-p (symbol-function 'comp-tests-tco-f)))
(should (= (comp-tests-tco-f 1 0 10) 55))))
(defun comp-tests-fw-prop-checker-1 (_)
@ -901,7 +901,7 @@ Return a list of results."
(length c))) ; <= has to optimize
t)
(native-compile #'comp-tests-fw-prop-1-f)
(should (subr-native-elisp-p (symbol-function 'comp-tests-fw-prop-1-f)))
(should (native-comp-function-p (symbol-function 'comp-tests-fw-prop-1-f)))
(should (= (comp-tests-fw-prop-1-f) 6))))
(defun comp-tests--type-lists-equal (l1 l2)
@ -1556,10 +1556,10 @@ folded."
(declare-function comp-tests-pure-caller-f nil)
(declare-function comp-tests-pure-fibn-entry-f nil)
(should (subr-native-elisp-p (symbol-function 'comp-tests-pure-caller-f)))
(should (native-comp-function-p (symbol-function 'comp-tests-pure-caller-f)))
(should (= (comp-tests-pure-caller-f) 4))
(should (subr-native-elisp-p (symbol-function 'comp-tests-pure-fibn-entry-f)))
(should (native-comp-function-p (symbol-function 'comp-tests-pure-fibn-entry-f)))
(should (= (comp-tests-pure-fibn-entry-f) 6765))))
(defvar comp-tests-cond-rw-checked-function nil