From 06e4ebc81a44c709b08ce72c746629c6c77e6f6e Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 8 Nov 2023 20:49:48 +0000 Subject: [PATCH] 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. --- lisp/emacs-lisp/comp.el | 79 ++++------------------ test/src/comp-resources/comp-test-funcs.el | 4 ++ test/src/comp-tests.el | 30 +++++++- 3 files changed, 45 insertions(+), 68 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 7fd9543d2ba..ba64bae599a 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -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'." diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el index 6d0cb353513..85282e4dc97 100644 --- a/test/src/comp-resources/comp-test-funcs.el +++ b/test/src/comp-resources/comp-test-funcs.el @@ -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) diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 2b3c3dd4c75..c2f0af51570 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -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) -- 2.39.2