feature/native-comp a335f7e 01/17: Update spill LAP machinery and compile anonymous lambdas

[Andrea Corallo]

branch: feature/native-comp
commit a335f7eeacd5381af1d8ef38a4c2b8e832ca96fa
Author: Andrea Corallo <address@hidden>
Commit: Andrea Corallo <address@hidden>

    Update spill LAP machinery and compile anonymous lambdas
    
        * lisp/emacs-lisp/comp.el (comp-spill-lap-function): Make use of
        byte-to-native-lambdas-h and update for 'byte-to-native-func-def'.
        (comp-spill-lap-function): Rework logic to retrive LAP using
        'byte-to-native-lambdas-h'.
        (comp-emit-for-top-level): Update for 'byte-to-native-function'.
    
        * lisp/emacs-lisp/bytecomp.el: Add commentary on new spill LAP
        mechanism.
        (byte-to-native-lambda, byte-to-native-func-def): New structures.
        (byte-to-native-top-level): Indent.
        (byte-to-native-lambdas-h): Update doc.
        (byte-compile-lapcode): Add a 'byte-to-native-lambda' instance
        into byte-to-native-lambdas-h instead of just LAP.
        (byte-compile-file-form-defmumble): Store into
        'byte-to-native-func-def' only the byte compiled function, the LAP
        will be retrived through 'byte-to-native-lambdas-h'.
        (byte-compile-lambda): Return the byte compiled function.
---
 lisp/emacs-lisp/bytecomp.el | 86 +++++++++++++++++++++++++++++----------------
 lisp/emacs-lisp/comp.el     | 67 ++++++++++++++++++++++-------------
 2 files changed, 97 insertions(+), 56 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c0662a6..f33c30e 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -562,13 +562,31 @@ Each element is (INDEX . VALUE)")
 (defvar byte-compile-depth 0 "Current depth of execution stack.")
 (defvar byte-compile-maxdepth 0 "Maximum depth of execution stack.")
 
-;; These are use by comp.el to spill data out of here
-(cl-defstruct byte-to-native-function
-  "Named or anonymous function defined a top level."
-              name c-name data lap)
+;; The following is used by comp.el to spill data out of here.
+;;
+;; Spilling is done in 3 places:
+;;
+;; - `byte-compile-lapcode' to obtain the map bytecode -> LAP for any
+;;   code assembled.
+;;
+;; - `byte-compile-lambda' to obtain arglist doc and interactive spec
+;;   af any lambda compiled (including anonymous).
+;;
+;; - `byte-compile-file-form-defmumble' to obtain the list of
+;;   top-level forms as they would be outputted in the .elc file.
+;;
+
+(cl-defstruct byte-to-native-lambda
+  byte-func lap)
+
+;; Top level forms:
+(cl-defstruct byte-to-native-func-def
+  "Named function defined at top-level."
+  name c-name byte-func)
 (cl-defstruct byte-to-native-top-level
-  "All other top level forms."
-              form)
+  "All other top-level forms."
+  form)
+
 (defvar byte-native-compiling nil
   "Non nil while native compiling.")
 (defvar byte-native-for-bootstrap nil
@@ -577,8 +595,8 @@ Each element is (INDEX . VALUE)")
   ;; Because the make target is the later this has to be produced as
   ;; last to be resilient against build interruptions.
 )
-(defvar byte-to-native-lap-h nil
-  "Hash byte-code -> LAP.")
+(defvar byte-to-native-lambdas-h nil
+  "Hash byte-code -> byte-to-native-lambda.")
 (defvar byte-to-native-top-level-forms nil
   "List of top level forms.")
 (defvar byte-to-native-output-file nil
@@ -978,8 +996,9 @@ CONST2 may be evaluated multiple times."
                hash-table))
     (let ((bytecode (apply 'unibyte-string (nreverse bytes))))
       (when byte-native-compiling
-        ;; Spill LAP for the native compiler here
-        (puthash bytecode lap byte-to-native-lap-h))
+        ;; Spill LAP for the native compiler here.
+        (puthash bytecode (make-byte-to-native-lambda :lap lap)
+                 byte-to-native-lambdas-h))
       bytecode)))
 
 
@@ -2689,10 +2708,8 @@ not to take responsibility for the actual compilation of 
the code."
               (push (if macro
                         (make-byte-to-native-top-level
                          :form `(defalias ',name '(macro . ,code) nil))
-                      (make-byte-to-native-function :name name
-                                                    :data code
-                                                    :lap (gethash (aref code 1)
-                                                                  
byte-to-native-lap-h)))
+                      (make-byte-to-native-func-def :name name
+                                                    :byte-func code))
                     byte-to-native-top-level-forms))
             ;; Output the form by hand, that's much simpler than having
             ;; b-c-output-file-form analyze the defalias.
@@ -2950,23 +2967,30 @@ for symbols generated by the byte compiler itself."
                                    reserved-csts)))
       ;; Build the actual byte-coded function.
       (cl-assert (eq 'byte-code (car-safe compiled)))
-      (apply #'make-byte-code
-             (if lexical-binding
-                 (byte-compile-make-args-desc arglist)
-               arglist)
-             (append
-              ;; byte-string, constants-vector, stack depth
-              (cdr compiled)
-              ;; optionally, the doc string.
-              (cond ((and lexical-binding arglist)
-                     ;; byte-compile-make-args-desc lost the args's names,
-                     ;; so preserve them in the docstring.
-                     (list (help-add-fundoc-usage doc arglist)))
-                    ((or doc int)
-                     (list doc)))
-              ;; optionally, the interactive spec.
-              (if int
-                  (list (nth 1 int))))))))
+      (let ((out
+             (apply #'make-byte-code
+                    (if lexical-binding
+                        (byte-compile-make-args-desc arglist)
+                      arglist)
+                    (append
+                     ;; byte-string, constants-vector, stack depth
+                     (cdr compiled)
+                     ;; optionally, the doc string.
+                     (cond ((and lexical-binding arglist)
+                            ;; byte-compile-make-args-desc lost the args's 
names,
+                            ;; so preserve them in the docstring.
+                            (list (help-add-fundoc-usage doc arglist)))
+                           ((or doc int)
+                            (list doc)))
+                     ;; optionally, the interactive spec.
+                     (if int
+                         (list (nth 1 int)))))))
+        (when byte-native-compiling
+          (setf (byte-to-native-lambda-byte-func
+                 (gethash (cadr compiled)
+                          byte-to-native-lambdas-h))
+                out))
+        out))))
 
 (defvar byte-compile-reserved-constants 0)
 
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index c2a95fe..3977580 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -230,6 +230,9 @@ Can be one of: 'd-default', 'd-impure' or 'd-ephemeral'.  
See `comp-ctxt'.")
   (sym-to-c-name-h (make-hash-table :test #'eq) :type hash-table
                    :documentation "symbol-function -> c-name.
 This is only for optimizing intra CU calls at speed 3.")
+  (byte-func-to-func-h (make-hash-table :test #'eq) :type hash-table
+                     :documentation "byte-function -> comp-func.
+Needed to replace immediate byte-compiled lambdas with the compiled 
reference.")
   (function-docs (make-hash-table :test #'eql) :type (or hash-table vector)
                :documentation "Documentation index -> documentation")
   (d-default (make-comp-data-container) :type comp-data-container
@@ -311,7 +314,7 @@ Is in use to help the SSA rename pass."))
 (cl-defstruct (comp-func (:copier nil))
   "LIMPLE representation of a function."
   (name nil :type symbol
-        :documentation "Function symbol name.")
+        :documentation "Function symbol name. Nil indicates anonymous.")
   (c-name nil :type string
           :documentation "The function name in the native world.")
   (byte-func nil
@@ -554,8 +557,9 @@ Put PREFIX in front of it."
                 "can't native compile an already bytecompiled function"))
       (setf (comp-func-byte-func func)
             (byte-compile (comp-func-name func)))
-      (let ((lap (gethash (aref (comp-func-byte-func func) 1)
-                          byte-to-native-lap-h)))
+      (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)
         (let ((arg-list (aref (comp-func-byte-func func) 0)))
@@ -566,7 +570,7 @@ Put PREFIX in front of it."
                 (comp-func-frame-size func)
                 (comp-byte-frame-size (comp-func-byte-func func))))
         (setf (comp-ctxt-top-level-forms comp-ctxt)
-              (list (make-byte-to-native-function :name function-name
+              (list (make-byte-to-native-func-def :name function-name
                                                   :c-name c-name)))
         ;; Create the default array.
         (puthash 0 (comp-func-frame-size func) (comp-func-array-h func))
@@ -580,38 +584,47 @@ Put PREFIX in front of it."
   (setf (comp-ctxt-top-level-forms comp-ctxt)
         (reverse byte-to-native-top-level-forms))
   (cl-loop
-   ;; All non anonymous functions.
-   for f in (cl-loop for x in (comp-ctxt-top-level-forms comp-ctxt)
-                     when (and (byte-to-native-function-p x)
-                               (byte-to-native-function-name x))
-                       collect x)
-   for name = (byte-to-native-function-name f)
-   for c-name = (comp-c-func-name name "F")
-   for data = (byte-to-native-function-data f)
+   for x being each hash-value of byte-to-native-lambdas-h
+   for byte-func = (byte-to-native-lambda-byte-func x)
+   for lap = (byte-to-native-lambda-lap x)
+   for top-l-form = (cl-loop
+                     for form in (comp-ctxt-top-level-forms comp-ctxt)
+                     when (and (byte-to-native-func-def-p form)
+                               (eq (byte-to-native-func-def-byte-func form)
+                                   byte-func))
+                       return form)
+   for name = (when top-l-form
+                (byte-to-native-func-def-name top-l-form))
+   for c-name = (comp-c-func-name (or name "anonymous-lambda")
+                                  "F")
    for func = (make-comp-func :name name
-                              :byte-func data
-                              :doc (documentation data)
-                              :int-spec (interactive-form data)
+                              :byte-func byte-func
+                              :doc (documentation byte-func)
+                              :int-spec (interactive-form byte-func)
                               :c-name c-name
-                              :args (comp-decrypt-arg-list (aref data 0) name)
-                              :lap (byte-to-native-function-lap f)
-                              :frame-size (comp-byte-frame-size data))
-   do
+                              :args (comp-decrypt-arg-list (aref byte-func 0)
+                                                           name)
+                              :lap lap
+                              :frame-size (comp-byte-frame-size byte-func))
    ;; Store the c-name to have it retrivable from
    ;; comp-ctxt-top-level-forms.
-   (setf (byte-to-native-function-c-name f) c-name)
+   when top-l-form
+     do (setf (byte-to-native-func-def-c-name top-l-form) c-name)
+   unless name
+     do (puthash byte-func func (comp-ctxt-byte-func-to-func-h comp-ctxt))
+   do
    ;; Create the default array.
    (puthash 0 (comp-func-frame-size func) (comp-func-array-h func))
    (comp-add-func-to-ctxt func)
    (comp-log (format "Function %s:\n" name) 1)
-   (comp-log (byte-to-native-function-lap f) 1)))
+   (comp-log lap 1)))
 
 (defun comp-spill-lap (input)
   "Byte compile and spill the LAP representation for INPUT.
 If INPUT is a symbol this is the function-name to be compiled.
 If INPUT is a string this is the file path to be compiled."
   (let ((byte-native-compiling t)
-        (byte-to-native-lap-h (make-hash-table :test #'eq))
+        (byte-to-native-lambdas-h (make-hash-table :test #'eq))
         (byte-to-native-top-level-forms ()))
     (comp-spill-lap-function input)))
 
@@ -1225,10 +1238,10 @@ the annotation emission."
 (cl-defgeneric comp-emit-for-top-level (form for-late-load)
   "Emit the limple code for top level FORM.")
 
-(cl-defmethod comp-emit-for-top-level ((form byte-to-native-function)
+(cl-defmethod comp-emit-for-top-level ((form byte-to-native-func-def)
                                        for-late-load)
-  (let* ((name (byte-to-native-function-name form))
-         (c-name (byte-to-native-function-c-name form))
+  (let* ((name (byte-to-native-func-def-name form))
+         (c-name (byte-to-native-func-def-c-name form))
          (f (gethash c-name (comp-ctxt-funcs-h comp-ctxt)))
          (args (comp-func-args f)))
     (cl-assert (and name f))
@@ -1293,6 +1306,9 @@ into the C code forwarding the compilation unit."
                             "Top level"))
     ;; Assign the compilation unit incoming as parameter to the slot frame 0.
     (comp-emit `(set-par-to-local ,(comp-slot-n 0) 0))
+    (maphash (lambda (_ func)
+               (comp-emit-lambda-for-top-level func))
+             (comp-ctxt-byte-func-to-func-h comp-ctxt))
     (mapc (lambda (x) (comp-emit-for-top-level x for-late-load))
           (comp-ctxt-top-level-forms comp-ctxt))
     (comp-emit `(return ,(make-comp-mvar :constant t)))
@@ -2142,6 +2158,7 @@ Update all insn accordingly."
   "Compile as native code the current context naming it NAME.
 Prepare every function for final compilation and drive the C back-end."
   (let ((dir (file-name-directory name)))
+    ;; FIXME: Strip bytecompiled functions here.
     (comp-finalize-relocs)
     (unless (file-exists-p dir)
       ;; In case it's created in the meanwhile.