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.
This commit is contained in:
parent
bf9cbc2354
commit
06e4ebc81a
3 changed files with 45 additions and 68 deletions
|
@ -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'."
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue