From a444d859770cb8b461f27870d3c95e03edbbe8d7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 17 Dec 2021 14:53:03 -0500 Subject: [PATCH] Fix bootstrap problems and various misc issues found along the way * lisp/simple.el (function-docstring): Fix call to `signal`. * lisp/emacs-lisp/oclosure.el (oclosure--define): Use `cl-deftype-satisfies`. * lisp/emacs-lisp/cl-generic.el (cl--generic-prefill-dispatchers): Bind `cl--generic-compiler` around the right part of the function (duh!). --- lisp/emacs-lisp/cl-generic.el | 24 ++++++++++++++---------- lisp/emacs-lisp/oclosure.el | 5 ++--- lisp/simple.el | 2 +- 3 files changed, 17 insertions(+), 14 deletions(-) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index ba154707516..5e468cd0223 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -880,16 +880,20 @@ those methods.") (setq arg-or-context `(&context . ,arg-or-context))) (unless (fboundp 'cl--generic-get-dispatcher) (require 'cl-generic)) - (let ((fun (cl--generic-get-dispatcher - `(,arg-or-context - ,@(apply #'append - (mapcar #'cl-generic-generalizers specializers)) - ,cl--generic-t-generalizer))) - ;; When compiling `cl-generic' during bootstrap, make sure - ;; we prefill with compiled dispatchers even though the loaded - ;; `cl-generic' is still interpreted. - (cl--generic-compiler - (if (featurep 'bytecomp) #'byte-compile cl--generic-compiler))) + (let ((fun + ;; Let-bind cl--generic-dispatchers so we *re*compute the function + ;; from scratch, since the one in the cache may be non-compiled! + (let ((cl--generic-dispatchers (make-hash-table)) + ;; When compiling `cl-generic' during bootstrap, make sure + ;; we prefill with compiled dispatchers even though the loaded + ;; `cl-generic' is still interpreted. + (cl--generic-compiler + (if (featurep 'bytecomp) #'byte-compile cl--generic-compiler))) + (cl--generic-get-dispatcher + `(,arg-or-context + ,@(apply #'append + (mapcar #'cl-generic-generalizers specializers)) + ,cl--generic-t-generalizer))))) ;; Recompute dispatch at run-time, since the generalizers may be slightly ;; different (e.g. byte-compiled rather than interpreted). ;; FIXME: There is a risk that the run-time generalizer is not equivalent diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index 6015e32b917..4fafa1ac46d 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -180,11 +180,10 @@ (defun oclosure--define (class pred) (let* ((name (cl--class-name class)) - (predname (intern (format "oclosure--%s-p" name))) - (type `(satisfies ,predname))) + (predname (intern (format "oclosure--%s-p" name)))) (setf (cl--find-class name) class) (defalias predname pred) - (put name 'cl-deftype-handler (lambda () type)))) + (put name 'cl-deftype-satisfies predname))) (defmacro oclosure-lambda (type fields args &rest body) (declare (indent 3) (debug (sexp (&rest (sexp form)) sexp def-body))) diff --git a/lisp/simple.el b/lisp/simple.el index 09e1c7d845f..ffb1331e6ac 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2343,7 +2343,7 @@ FUNCTION is expected to be a function value rather than, say, a mere symbol." ;; in the function body, so reject them if they are last. (cdr body)) doc))) - (_ (signal 'invalid-function)))) + (_ (signal 'invalid-function (list function))))) (cl-defgeneric interactive-form (cmd) "Return the interactive form of CMD or nil if none. -- 2.39.5