Fix bootstrap problems and various misc issues found along the way

* lisp/simple.el (function-docstring): Fix call to `signal`.

* lisp/emacs-lisp/fcr.el (fcr--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!).
This commit is contained in:
Stefan Monnier 2021-12-17 14:53:03 -05:00
parent a21cbc05f2
commit f2d8a24e21
3 changed files with 17 additions and 14 deletions

View file

@ -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

View file

@ -180,11 +180,10 @@
(defun fcr--define (class pred)
(let* ((name (cl--class-name class))
(predname (intern (format "fcr--%s-p" name)))
(type `(satisfies ,predname)))
(predname (intern (format "fcr--%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 fcr-lambda (type fields args &rest body)
(declare (indent 3) (debug (sexp (&rest (sexp form)) sexp def-body)))

View file

@ -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.