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.

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 7fd9543d2babefa9cf219ed3c419100f70cc9ef7..ba64bae599a6d1d7af7c3732440bc1c23c43db3b 100644 (file)
--- 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 6d0cb35351349100ad4415f46990c89fa8e5496e..85282e4dc973d355b75350551da204d7bfde2137 100644 (file)
--- 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 2b3c3dd4c759a95c25a6dbd4f782f34c61dda8e9..c2f0af515700c3ed735b0f3265ee09e502b604ec 100644 (file)
--- 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)