From: Andrea Corallo <akrl@sdf.org>
Date: Sat, 10 Oct 2020 20:07:59 +0000 (+0200)
Subject: * Allow for lambda forms as native compilation input
X-Git-Tag: emacs-28.0.90~2727^2~369
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4bea0c0b1d907d676cc9abc8d7048103c10b8d79;p=emacs.git

* Allow for lambda forms as native compilation input

	* lisp/emacs-lisp/comp.el (comp-spill-lap-function): Add new
	specialized method for compiling a lambda form.
---

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 26654a300a2..89b4230dc2c 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -698,6 +698,45 @@ clashes."
         (puthash 0 (comp-func-frame-size func) (comp-func-array-h func))
         (comp-add-func-to-ctxt func))))
 
+(cl-defmethod comp-spill-lap-function ((form list))
+  "Byte-compile FORM spilling data from the byte compiler."
+  (unless (eq (car-safe form) 'lambda)
+    (signal 'native-compiler-error
+            "Cannot native compile, form is not a lambda"))
+  (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)
+                                     :speed comp-speed)
+                 (make-comp-func-d :c-name c-name
+                                   :doc (documentation form t)
+                                   :int-spec (interactive-form form)
+                                   :speed comp-speed))))
+    (let ((lap (byte-to-native-lambda-lap
+                (gethash (aref byte-code 1)
+                         byte-to-native-lambdas-h))))
+      (cl-assert lap)
+      (comp-log lap 2)
+      (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)
+            (list (make-byte-to-native-func-def :name '--anonymous-lambda
+                                                :c-name c-name)))
+      ;; Create the default array.
+      (puthash 0 (comp-func-frame-size func) (comp-func-array-h func))
+      (comp-add-func-to-ctxt func))))
+
 (defun comp-intern-func-in-ctxt (_ obj)
   "Given OBJ of type `byte-to-native-lambda', create a function in `comp-ctxt'."
   (when-let ((byte-func (byte-to-native-lambda-byte-func obj)))