lisp/emacs-lisp/eieio*.el: Rewrite our generics on top of cl-generic

* lisp/emacs-lisp/eieio-generic.el: Remove.
(defgeneric, defmethod): Move to eieio-compat.el.  Mark obsolete.
* lisp/emacs-lisp/eieio-compat.el: New file.
* lisp/emacs-lisp/eieio.el: Don't require eieio-generic any more.
* lisp/emacs-lisp/eieio-core.el (eieio--slot-originating-class-p):
Remove unused function.
(eieio-defclass): Move to eieio-compat.el.
* lisp/emacs-lisp/macroexp.el (macroexp-macroexpand): New function.
(macroexp--expand-all): Use it.
* lisp/emacs-lisp/bytecomp.el (byte-compile-recurse-toplevel): Here too.

1 files changed, 246 insertions, 0 deletions

diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
new file mode 100644
index 00000000000..34c06c01763
--- /dev/null
+++ b/lisp/emacs-lisp/eieio-compat.el
@@ -0,0 +1,246 @@
+;;; eieio-compat.el --- Compatibility with Older EIEIO versions  -*- lexical-binding:t -*-
+
+;; Copyright (C) 1995-1996, 1998-2015 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; Keywords: OO, lisp
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Backward compatibility definition of old EIEIO functions in
+;; terms of newer equivalent.
+
+;; The main elements are the old EIEIO `defmethod' and `defgeneric' which are
+;; now implemented on top of cl-generic.  The differences we have to
+;; accommodate are:
+;; - EIEIO's :static methods (turned into a new `eieio--static' specializer).
+;; - EIEIO's support for `call-next-method' and `next-method-p' instead of
+;;   `cl-next-method-p' and `cl-call-next-method' (simple matter of renaming).
+;; - Different errors are signaled.
+;; - EIEIO's defgeneric does not reset the function.
+;; - EIEIO's no-next-method and no-applicable-method can't be aliases of
+;;   cl-generic's namesakes since they have different calling conventions,
+;;   which means that packages that (defmethod no-next-method ..) don't work.
+;; - EIEIO's `call-next-method' and `next-method-p' had dynamic scope whereas
+;;   cl-generic's `cl-next-method-p' and `cl-call-next-method' are lexically
+;;   scoped.
+
+;;; Code:
+
+(require 'eieio-core)
+(require 'cl-generic)
+
+(put 'eieio--defalias 'byte-hunk-handler
+     #'byte-compile-file-form-defalias) ;;(get 'defalias 'byte-hunk-handler)
+;;;###autoload
+(defun eieio--defalias (name body)
+  "Like `defalias', but with less side-effects.
+More specifically, it has no side-effects at all when the new function
+definition is the same (`eq') as the old one."
+  (cl-assert (not (symbolp body)))
+  (while (and (fboundp name) (symbolp (symbol-function name)))
+    ;; Follow aliases, so methods applied to obsolete aliases still work.
+    (setq name (symbol-function name)))
+  (unless (and (fboundp name)
+               (eq (symbol-function name) body))
+    (defalias name body)))
+
+;;;###autoload
+(defmacro defgeneric (method args &optional doc-string)
+  "Create a generic function METHOD.
+DOC-STRING is the base documentation for this class.  A generic
+function has no body, as its purpose is to decide which method body
+is appropriate to use.  Uses `defmethod' to create methods, and calls
+`defgeneric' for you.  With this implementation the ARGS are
+currently ignored.  You can use `defgeneric' to apply specialized
+top level documentation to a method."
+  (declare (doc-string 3) (obsolete cl-defgeneric "25.1"))
+  `(eieio--defalias ',method
+                    (eieio--defgeneric-init-form
+                     ',method
+                     ,(if doc-string (help-add-fundoc-usage doc-string args)))))
+
+;;;###autoload
+(defmacro defmethod (method &rest args)
+  "Create a new METHOD through `defgeneric' with ARGS.
+
+The optional second argument KEY is a specifier that
+modifies how the method is called, including:
+   :before  - Method will be called before the :primary
+   :primary - The default if not specified
+   :after   - Method will be called after the :primary
+   :static  - First arg could be an object or class
+The next argument is the ARGLIST.  The ARGLIST specifies the arguments
+to the method as with `defun'.  The first argument can have a type
+specifier, such as:
+  ((VARNAME CLASS) ARG2 ...)
+where VARNAME is the name of the local variable for the method being
+created.  The CLASS is a class symbol for a class made with `defclass'.
+A DOCSTRING comes after the ARGLIST, and is optional.
+All the rest of the args are the BODY of the method.  A method will
+return the value of the last form in the BODY.
+
+Summary:
+
+ (defmethod mymethod [:before | :primary | :after | :static]
+                     ((typearg class-name) arg2 &optional opt &rest rest)
+    \"doc-string\"
+     body)"
+  (declare (doc-string 3) (obsolete cl-defmethod "25.1")
+           (debug
+            (&define                    ; this means we are defining something
+             [&or name ("setf" :name setf name)]
+             ;; ^^ This is the methods symbol
+             [ &optional symbolp ]                ; this is key :before etc
+             list                                 ; arguments
+             [ &optional stringp ]                ; documentation string
+             def-body                             ; part to be debugged
+             )))
+  (let* ((key (if (keywordp (car args)) (pop args)))
+	 (params (car args))
+	 (arg1 (car params))
+         (fargs (if (consp arg1)
+                   (cons (car arg1) (cdr params))
+                 params))
+	 (class (if (consp arg1) (nth 1 arg1)))
+         (code `(lambda ,fargs ,@(cdr args))))
+    `(progn
+       ;; Make sure there is a generic and the byte-compiler sees it.
+       (defgeneric ,method ,args)
+       (eieio--defmethod ',method ',key ',class #',code))))
+
+(add-function :before-until cl-generic-tagcode-function
+              #'eieio--generic-static-tagcode)
+(defun eieio--generic-static-tagcode (type name)
+  (and (eq 'eieio--static (car-safe type))
+       `(40 . (cond
+               ((symbolp ,name) (eieio--class-v ,name))
+               ((vectorp ,name) (aref ,name 0))))))
+
+(add-function :around cl-generic-tag-types-function
+              #'eieio--generic-static-tag-types)
+(defun eieio--generic-static-tag-types (orig-fun tag)
+  (cond
+   ((or (eieio--class-p tag)
+        (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag))))
+    (let ((superclasses (funcall orig-fun tag))
+          (types ()))
+      ;; Interleave: (subclass <foo>) (eieio--static <foo>) <subclass <bar>) ..
+      (dolist (superclass superclasses)
+        (push superclass types)
+        (push `(eieio--static
+                ,(if (consp superclass) (cadr superclass) superclass))
+              types))
+      (nreverse types)))
+   (t (funcall orig-fun tag))))
+
+;;;###autoload
+(defun eieio--defgeneric-init-form (method doc-string)
+  (if doc-string (put method 'function-documentation doc-string))
+  (if (memq method '(no-next-method no-applicable-method))
+      (symbol-function method)
+    (let ((generic (cl-generic-ensure-function method)))
+      (symbol-function (cl--generic-name generic)))))
+
+;;;###autoload
+(defun eieio--defmethod (method kind argclass code)
+  (setq kind (intern (downcase (symbol-name kind))))
+  (let* ((specializer (if (not (eq kind :static))
+                          (or argclass t)
+                        (setq kind nil)
+                        `(eieio--static ,argclass)))
+         (uses-cnm (not (memq kind '(:before :after))))
+         (specializers `((arg ,specializer)))
+         (code
+          ;; Backward compatibility for `no-next-method' and
+          ;; `no-applicable-method', which have slightly different calling
+          ;; convention than their cl-generic counterpart.
+          (pcase method
+            (`no-next-method
+             (setq method 'cl-no-next-method)
+             (setq specializers `(generic method ,@specializers))
+             (lambda (_generic _method &rest args) (apply code args)))
+            (`no-applicable-method
+             (setq method 'cl-no-applicable-method)
+             (setq specializers `(generic ,@specializers))
+             (lambda (generic arg &rest args) (apply code arg generic args)))
+            (_ code))))
+    (cl-generic-define-method
+     method (if kind (list kind)) specializers uses-cnm
+     (if uses-cnm
+         (let* ((docstring (documentation code 'raw))
+                (args (help-function-arglist code 'preserve-names))
+                (doc-only (if docstring
+                              (let ((split (help-split-fundoc docstring nil)))
+                                (if split (cdr split) docstring))))
+                (new-docstring (help-add-fundoc-usage doc-only
+                                                      (cons 'cl-cnm args))))
+           ;; FIXME: ¡Add the new-docstring to those closures!
+           (lambda (cnm &rest args)
+             (cl-letf (((symbol-function 'call-next-method) cnm)
+                       ((symbol-function 'next-method-p)
+                        (lambda () (cl--generic-isnot-nnm-p cnm))))
+               (apply code args))))
+       code))))
+
+;; Compatibility with code which tries to catch `no-method-definition' errors.
+(push 'no-method-definition (get 'cl-no-applicable-method 'error-conditions))
+
+(defun generic-p (fname) (not (null (cl--generic fname))))
+
+(defun no-next-method (&rest args)
+  (declare (obsolete cl-no-next-method "25.1"))
+  (apply #'cl-no-next-method 'unknown nil args))
+
+(defun no-applicable-method (object method &rest args)
+  (declare (obsolete cl-no-applicable-method "25.1"))
+  (apply #'cl-no-applicable-method method object args))
+
+(define-obsolete-function-alias 'call-next-method 'cl-call-next-method "25.1")
+(define-obsolete-function-alias 'next-method-p 'cl-next-method-p "25.1")
+
+;;;###autoload
+(defun eieio-defmethod (method args)
+  "Obsolete work part of an old version of the `defmethod' macro."
+  (declare (obsolete cl-defmethod "24.1"))
+  (eval `(defmethod ,method ,@args))
+  method)
+
+;;;###autoload
+(defun eieio-defgeneric (method doc-string)
+  "Obsolete work part of an old version of the `defgeneric' macro."
+  (declare (obsolete cl-defgeneric "24.1"))
+  ;; Don't do this over and over.
+  (unless (fboundp 'method)
+    (eval `(defgeneric ,method (x) ,@(if doc-string `(,doc-string))))
+    ;; Return the method
+    'method))
+
+;;;###autoload
+(defun eieio-defclass (cname superclasses slots options)
+  (declare (obsolete eieio-defclass-internal "25.1"))
+  (eval `(defclass ,cname ,superclasses ,slots ,@options)))
+
+
+;; Local Variables:
+;; generated-autoload-file: "eieio-core.el"
+;; End:
+
+(provide 'eieio-compat)
+
+;;; eieio-compat.el ends here