From a421c277237ab6b5923473f6dbb9c196b16bc833 Mon Sep 17 00:00:00 2001
From: Andrea Corallo <akrl@sdf.org>
Date: Sat, 23 Nov 2019 17:03:08 +0100
Subject: [PATCH] fix single function compilation

---
 lisp/emacs-lisp/bytecomp.el |  5 ++--
 lisp/emacs-lisp/comp.el     | 58 ++++++++++++++++++-------------------
 2 files changed, 31 insertions(+), 32 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 04c80c17577..ebbee2a0c7c 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -3147,9 +3147,8 @@ for symbols generated by the byte compiler itself."
 	                byte-compile-vector byte-compile-maxdepth)))
         (when byte-native-compiling
           ;; Spill LAP for the native compiler here
-          (when byte-compile-current-form
-            (push (cons byte-compile-current-form byte-compile-output)
-                  byte-to-native-lap)))
+          (push (cons byte-compile-current-form byte-compile-output)
+                byte-to-native-lap))
         out))
      ;; it's a trivial function
      ((cdr body) (cons 'progn (nreverse body)))
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 458c95a3227..7358e8616cc 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -102,7 +102,7 @@ Can be used by code that wants to expand differently in this case.")
                                  (* . number)
                                  (/ . number)
                                  (% . number)
-                                 ;; Type hint
+                                 ;; Type hints
                                  (comp-hint-fixnum . fixnum)
                                  (comp-hint-cons . cons))
   "Alist used for type propagation.")
@@ -412,31 +412,33 @@ Put PREFIX in front of it."
   ;; For the 1+ see bytecode.c:365 (finger crossed).
   (1+ (aref byte-compiled-func 3)))
 
-(defun comp-spill-lap-function (_function-name)
+(cl-defgeneric comp-spill-lap-function (input)
+  "Byte compile INPUT and spill lap for further stages.")
+
+(cl-defgeneric comp-spill-lap-function ((function-name symbol))
   "Byte compile FUNCTION-NAME spilling data from the byte compiler."
-  (signal 'native-ice "to be reimplemented")
-  ;; (let* ((f (symbol-function function-name))
-  ;;        (func (make-comp-func :symbol-name function-name
-  ;;                              :c-func-name (comp-c-func-name
-  ;;                                            function-name
-  ;;                                            "F"))))
-  ;;     (when (byte-code-function-p f)
-  ;;       (error "Can't native compile an already bytecompiled function"))
-  ;;     (setf (comp-func-byte-func func)
-  ;;           (byte-compile (comp-func-symbol-name func)))
-  ;;     (let ((lap (alist-get function-name (reverse byte-to-native-bytecode))))
-  ;;       (cl-assert lap)
-  ;;       (comp-log lap)
-  ;;       (let ((lambda-list (aref (comp-func-byte-func func) 0)))
-  ;;         (setf (comp-func-args func)
-  ;;               (comp-decrypt-lambda-list lambda-list)))
-  ;;       (setf (comp-func-lap func) lap)
-  ;;       (setf (comp-func-frame-size func)
-  ;;             (comp-byte-frame-size (comp-func-byte-func func)))
-  ;;       func))
-  )
-
-(defun comp-spill-lap-functions-file (filename)
+  (let* ((f (symbol-function function-name))
+         (func (make-comp-func :symbol-name function-name
+                               :c-func-name (comp-c-func-name
+                                             function-name
+                                             "F"))))
+      (when (byte-code-function-p f)
+        (signal 'native-compiler-error
+                "can't native compile an already bytecompiled function"))
+      (setf (comp-func-byte-func func)
+            (byte-compile (comp-func-symbol-name func)))
+      (let ((lap (alist-get nil byte-to-native-lap)))
+        (cl-assert lap)
+        (comp-log lap 1)
+        (let ((lambda-list (aref (comp-func-byte-func func) 0)))
+          (setf (comp-func-args func)
+                (comp-decrypt-lambda-list lambda-list)
+                (comp-func-lap func) lap
+                (comp-func-frame-size func)
+                (comp-byte-frame-size (comp-func-byte-func func))))
+        (list func))))
+
+(cl-defgeneric comp-spill-lap-function ((filename string))
   "Byte compile FILENAME spilling data from the byte compiler."
   (byte-compile-file filename)
   (unless byte-to-native-top-level-forms
@@ -472,9 +474,7 @@ If INPUT is a string this is the file path to be compiled."
   (let ((byte-native-compiling t)
         (byte-to-native-lap ())
         (byte-to-native-top-level-forms ()))
-    (cl-typecase input
-      (symbol (list (comp-spill-lap-function input)))
-      (string (comp-spill-lap-functions-file input)))))
+    (comp-spill-lap-function input)))
 
 
 ;;; Limplification pass specific code.
@@ -1860,7 +1860,7 @@ Return the compilation unit file name."
         (comp-native-compiling t)
         (comp-ctxt (make-comp-ctxt
                     :output (if (symbolp input)
-                                (symbol-name input)
+                                (make-temp-file (concat (symbol-name input) "-"))
                               (file-name-sans-extension (expand-file-name input))))))
     (comp-log "\n\n" 1)
     (condition-case err
-- 
2.39.5