With `native-compile', compile lambdas in a defun or lambda too

This fixes bug#64646.  Also refactor two functions to reduce
code duplication.

* lisp/emacs-lisp/comp.el (comp-spill-lap-function/symbol)
(comp-spill-lap-function/list): Add all functions found by the
byte compiler (including lambdas) to the native compiler's
context, thus making them be native compiled.  Refactor to use
comp-intern-func-in-ctxt.  Make comp-spill-lap-function/list
also compile closures.

* test/src/comp-resources/comp-test-funcs.el
(comp-tests-lambda-return-f2): New function

* test/src/comp-tests.el (comp-test-lambda-return2)
(comp-tests-free-fun-f2): New functions to test that internal
lambdas get native compiled.
This commit is contained in:
Alan Mackenzie 2023-11-08 20:49:48 +00:00
parent bf9cbc2354
commit 06e4ebc81a
3 changed files with 45 additions and 68 deletions

View file

@ -1316,86 +1316,31 @@ clashes."
nil ".eln")))
(let* ((f (symbol-function function-name))
(byte-code (byte-compile function-name))
(c-name (comp-c-func-name function-name "F"))
(func
(if (comp-lex-byte-func-p byte-code)
(make-comp-func-l :name function-name
:c-name c-name
:doc (documentation f t)
:int-spec (interactive-form f)
:command-modes (command-modes f)
:speed (comp-spill-speed function-name)
:pure (comp-spill-decl-spec function-name
'pure))
(make-comp-func-d :name function-name
:c-name c-name
:doc (documentation f t)
:int-spec (interactive-form f)
:command-modes (command-modes f)
:speed (comp-spill-speed function-name)
:pure (comp-spill-decl-spec function-name
'pure)))))
(c-name (comp-c-func-name function-name "F")))
(when (byte-code-function-p f)
(signal 'native-compiler-error
'("can't native compile an already byte-compiled function")))
(setf (comp-func-byte-func func) byte-code)
(let ((lap (byte-to-native-lambda-lap
(gethash (aref (comp-func-byte-func func) 1)
byte-to-native-lambdas-h))))
(cl-assert lap)
(comp-log lap 2 t)
(if (comp-func-l-p func)
(let ((arg-list (aref (comp-func-byte-func func) 0)))
(setf (comp-func-l-args func)
(comp-decrypt-arg-list arg-list function-name)))
(setf (comp-func-d-lambda-list func) (cadr f)))
(setf (comp-func-lap func)
lap
(comp-func-frame-size func)
(comp-byte-frame-size (comp-func-byte-func func))
(comp-ctxt-top-level-forms comp-ctxt)
(setf (comp-ctxt-top-level-forms comp-ctxt)
(list (make-byte-to-native-func-def :name function-name
:c-name c-name)))
(comp-add-func-to-ctxt func))))
:c-name c-name
:byte-func byte-code)))
(maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h)))
(cl-defmethod comp-spill-lap-function ((form list))
"Byte-compile FORM, spilling data from the byte compiler."
(unless (eq (car-safe form) 'lambda)
(unless (memq (car-safe form) '(lambda closure))
(signal 'native-compiler-error
'("Cannot native-compile, form is not a lambda")))
'("Cannot native-compile, form is not a lambda or closure")))
(unless (comp-ctxt-output comp-ctxt)
(setf (comp-ctxt-output comp-ctxt)
(make-temp-file "comp-lambda-" nil ".eln")))
(let* ((byte-code (byte-compile form))
(c-name (comp-c-func-name "anonymous-lambda" "F"))
(func (if (comp-lex-byte-func-p byte-code)
(make-comp-func-l :c-name c-name
:doc (documentation form t)
:int-spec (interactive-form form)
:command-modes (command-modes form)
:speed (comp-ctxt-speed comp-ctxt))
(make-comp-func-d :c-name c-name
:doc (documentation form t)
:int-spec (interactive-form form)
:command-modes (command-modes form)
:speed (comp-ctxt-speed comp-ctxt)))))
(let ((lap (byte-to-native-lambda-lap
(gethash (aref byte-code 1)
byte-to-native-lambdas-h))))
(cl-assert lap)
(comp-log lap 2 t)
(if (comp-func-l-p func)
(setf (comp-func-l-args func)
(comp-decrypt-arg-list (aref byte-code 0) byte-code))
(setf (comp-func-d-lambda-list func) (cadr form)))
(setf (comp-func-lap func) lap
(comp-func-frame-size func) (comp-byte-frame-size
byte-code))
(setf (comp-func-byte-func func) byte-code
(comp-ctxt-top-level-forms comp-ctxt)
(c-name (comp-c-func-name "anonymous-lambda" "F")))
(setf (comp-ctxt-top-level-forms comp-ctxt)
(list (make-byte-to-native-func-def :name '--anonymous-lambda
:c-name c-name)))
(comp-add-func-to-ctxt func))))
:c-name c-name
:byte-func byte-code)))
(maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h)))
(defun comp-intern-func-in-ctxt (_ obj)
"Given OBJ of type `byte-to-native-lambda', create a function in `comp-ctxt'."

View file

@ -242,6 +242,10 @@
(defun comp-tests-lambda-return-f ()
(lambda (x) (1+ x)))
(defun comp-tests-lambda-return-f2 ()
(lambda ()
(lambda (x) (1+ x))))
(defun comp-tests-fib-f (n)
(cond ((= n 0) 0)
((= n 1) 1)

View file

@ -327,6 +327,14 @@ Check that the resulting binaries do not differ."
(should (subr-native-elisp-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))
(let ((f2 (funcall f)))
(should (subr-native-elisp-p f2))
(should (= (funcall f2 3) 4)))))
(comp-deftest recursive ()
(should (= (comp-tests-fib-f 10) 55)))
@ -388,7 +396,27 @@ Check that the resulting binaries do not differ."
"Some doc."))
(should (commandp #'comp-tests-free-fun-f))
(should (equal (interactive-form #'comp-tests-free-fun-f)
'(interactive))))
'(interactive nil))))
(declare-function comp-tests-free-fun-f2 nil)
(comp-deftest free-fun2 ()
"Check compiling a symbol's function compiles contained lambdas."
(eval '(defun comp-tests-free-fun-f2 ()
(lambda (x)
"Some doc."
(interactive)
x)))
(native-compile #'comp-tests-free-fun-f2)
(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 (string= (documentation f2) "Some doc."))
(should (commandp f2))
(should (equal (interactive-form f2) '(interactive nil)))
(should (= (funcall f2 3) 3))))
(declare-function comp-tests/free\fun-f nil)