[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/native-comp-cl 612df64 2/2: Have cl-declare set function speed p
From: |
Andrea Corallo |
Subject: |
scratch/native-comp-cl 612df64 2/2: Have cl-declare set function speed prop |
Date: |
Tue, 1 Sep 2020 16:58:00 -0400 (EDT) |
branch: scratch/native-comp-cl
commit 612df640cbcc800c14768f0722e5cd7001faa5f0
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Have cl-declare set function speed prop
---
lisp/emacs-lisp/byte-run.el | 4 ++++
lisp/emacs-lisp/cl-macs.el | 11 +++++++----
2 files changed, 11 insertions(+), 4 deletions(-)
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 8c16c17..8993a81 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -258,6 +258,9 @@ The return value is undefined.
(cons 'prog1 (cons def declarations))
def))))))
+(defvar defun-last-function-name nil
+ "Last function name macroexpanded by `defun'.")
+
;; Now that we defined defmacro we can use it!
(defmacro defun (name arglist &optional docstring &rest body)
"Define NAME as a function.
@@ -280,6 +283,7 @@ The return value is undefined.
(and (listp arglist)
(null (delq t (mapcar #'symbolp arglist)))))
(error "Malformed arglist: %s" arglist))
+ (setq defun-last-function-name name)
(let ((decls (cond
((eq (car-safe docstring) 'declare)
(prog1 (cdr docstring) (setq docstring nil)))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 75da039..235e7d0 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2374,10 +2374,13 @@ values. For compatibility, (cl-values A B C) is a
synonym for (list A B C).
'((0 nil) (1 t) (2 t) (3 t))))
(safety (assq (nth 1 (assq 'safety (cdr spec)))
'((0 t) (1 t) (2 t) (3 nil)))))
- (if speed (setq cl--optimize-speed (car speed)
- byte-optimize (nth 1 speed)))
- (if safety (setq cl--optimize-safety (car safety)
- byte-compile-delete-errors (nth 1 safety)))))
+ (when speed
+ (setq cl--optimize-speed (car speed)
+ byte-optimize (nth 1 speed))
+ (function-put defun-last-function-name 'speed cl--optimize-speed))
+ (when safety
+ (setq cl--optimize-safety (car safety)
+ byte-compile-delete-errors (nth 1 safety)))))
((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings))
(while (setq spec (cdr spec))