emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

feature/named-lambdas 7d92e7ac09e: Record the defining symbol for lambda


From: Alan Mackenzie
Subject: feature/named-lambdas 7d92e7ac09e: Record the defining symbol for lambda functions, too
Date: Sat, 28 Oct 2023 05:01:17 -0400 (EDT)

branch: feature/named-lambdas
commit 7d92e7ac09ebaa7580eea064b88a93bae2536365
Author: Alan Mackenzie <acm@muc.de>
Commit: Alan Mackenzie <acm@muc.de>

    Record the defining symbol for lambda functions, too
    
    Also record it for the trampolines for primitives.
    
    * lisp/emacs-lisp/comp.el (comp-spill-lap-function/symbol)
    (comp-intern-func-in-ctxt): Use as source the defining symbol
    embedded in the byte-code.
    (comp-trampoline-compile): Use subr-name as the defining symbol
    for the constructed lambda form.
---
 lisp/emacs-lisp/comp.el | 17 +++++++++++------
 1 file changed, 11 insertions(+), 6 deletions(-)

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 4884d85ccba..320d302cfb9 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -1323,6 +1323,8 @@ clashes."
   (let* ((f (symbol-function function-name))
          (byte-code (byte-compile function-name))
          (c-name (comp-c-func-name function-name "F"))
+         (defsym (and (> (length byte-code) 5)
+                      (aref byte-code 5)))
          (func
           (if (comp-lex-byte-func-p byte-code)
               (make-comp-func-l :name function-name
@@ -1333,7 +1335,7 @@ clashes."
                                 :speed (comp-spill-speed function-name)
                                 :pure (comp-spill-decl-spec function-name
                                                             'pure)
-                                :defining-symbol function-name)
+                                :defining-symbol defsym)
             (make-comp-func-d :name function-name
                               :c-name c-name
                               :doc (documentation f t)
@@ -1342,14 +1344,13 @@ clashes."
                               :speed (comp-spill-speed function-name)
                               :pure (comp-spill-decl-spec function-name
                                                           'pure)
-                              :defining-symbol function-name))))
+                              :defining-symbol defsym))))
       (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))))
+                  (gethash (aref byte-code 1) byte-to-native-lambdas-h))))
         (cl-assert lap)
         (comp-log lap 2 t)
         (if (comp-func-l-p func)
@@ -1413,6 +1414,8 @@ clashes."
   "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)))
     (let* ((lap (byte-to-native-lambda-lap obj))
+           (defsym (and (> (length byte-func) 5)
+                        (aref byte-func 5)))
            (top-l-form (cl-loop
                         for form in (comp-ctxt-top-level-forms comp-ctxt)
                         when (and (byte-to-native-func-def-p form)
@@ -1436,7 +1439,8 @@ clashes."
             (comp-func-lap func) lap
             (comp-func-frame-size func) (comp-byte-frame-size byte-func)
             (comp-func-speed func) (comp-spill-speed name)
-            (comp-func-pure func) (comp-spill-decl-spec name 'pure))
+            (comp-func-pure func) (comp-spill-decl-spec name 'pure)
+            (comp-func-defining-symbol func) defsym)
 
       ;; Store the c-name to have it retrievable from
       ;; `comp-ctxt-top-level-forms'.
@@ -3929,7 +3933,8 @@ Return the trampoline if found or nil otherwise."
                        (symbol-function subr-name)))
          ;; The synthesized trampoline must expose the exact same ABI of
          ;; the primitive we are replacing in the function reloc table.
-         (form `(lambda ,lambda-list
+         (form `(lambda ,subr-name      ; The defining symbol
+                  ,lambda-list
                   (let ((f #',subr-name))
                     (,(if (memq '&rest lambda-list) #'apply 'funcall)
                      f



reply via email to

[Prev in Thread] Current Thread [Next in Thread]