Commit 452aa949 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

Fix eieio vs cl-generic incompatibilities found in Rudel (bug#23947)

* lisp/emacs-lisp/cl-generic.el (cl-generic-apply): New function.
* lisp/emacs-lisp/eieio-compat.el (eieio--defmethod): Fix incorrect
mapping between cl-no-applicable-method and EIEIO's no-applicable-method.
* lisp/emacs-lisp/eieio-core.el (eieio--class-precedence-c3):
`class' is not a symbol but a class object.
parent 248d5dd1
...@@ -671,6 +671,15 @@ FUN is the function that should be called when METHOD calls ...@@ -671,6 +671,15 @@ FUN is the function that should be called when METHOD calls
(setq fun (cl-generic-call-method generic method fun))) (setq fun (cl-generic-call-method generic method fun)))
fun))))) fun)))))
(defun cl-generic-apply (generic args)
"Like `apply' but takes a cl-generic object rather than a function."
;; Handy in cl-no-applicable-method, for example.
;; In Common Lisp, generic-function objects are funcallable. Ideally
;; we'd want the same in Elisp, but it would either require using a very
;; different (and less efficient) representation of cl--generic objects,
;; or non-trivial changes in the general infrastructure (compiler and such).
(apply (cl--generic-name generic) args))
(defun cl--generic-arg-specializer (method dispatch-arg) (defun cl--generic-arg-specializer (method dispatch-arg)
(or (if (integerp dispatch-arg) (or (if (integerp dispatch-arg)
(nth dispatch-arg (nth dispatch-arg
......
...@@ -188,7 +188,8 @@ Summary: ...@@ -188,7 +188,8 @@ Summary:
(`no-applicable-method (`no-applicable-method
(setq method 'cl-no-applicable-method) (setq method 'cl-no-applicable-method)
(setq specializers `(generic ,@specializers)) (setq specializers `(generic ,@specializers))
(lambda (generic arg &rest args) (apply code arg generic args))) (lambda (generic arg &rest args)
(apply code arg (cl--generic-name generic) (cons arg args))))
(_ code)))) (_ code))))
(cl-generic-define-method (cl-generic-define-method
method (unless (memq kind '(nil :primary)) (list kind)) method (unless (memq kind '(nil :primary)) (list kind))
......
...@@ -976,7 +976,7 @@ If a consistent order does not exist, signal an error." ...@@ -976,7 +976,7 @@ If a consistent order does not exist, signal an error."
(defun eieio--class-precedence-c3 (class) (defun eieio--class-precedence-c3 (class)
"Return all parents of CLASS in c3 order." "Return all parents of CLASS in c3 order."
(let ((parents (eieio--class-parents (cl--find-class class)))) (let ((parents (eieio--class-parents class)))
(eieio--c3-merge-lists (eieio--c3-merge-lists
(list class) (list class)
(append (append
...@@ -1101,7 +1101,7 @@ method invocation orders of the involved classes." ...@@ -1101,7 +1101,7 @@ method invocation orders of the involved classes."
(list eieio--generic-subclass-generalizer)) (list eieio--generic-subclass-generalizer))
;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "6aca3c1b5f751a01331761da45fc4f5c") ;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "dba4205b1a0d7133f1311d975b4d0ebe")
;;; Generated autoloads from eieio-compat.el ;;; Generated autoloads from eieio-compat.el
(autoload 'eieio--defalias "eieio-compat" "\ (autoload 'eieio--defalias "eieio-compat" "\
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment