Merge branch 'master' into xwidget

11 files changed, 285 insertions, 321 deletions

diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el
index 082955e0823..d5cdca2b1b5 100644
--- a/lisp/emacs-lisp/backquote.el
+++ b/lisp/emacs-lisp/backquote.el
@@ -120,9 +120,7 @@ Vectors work just like lists.  Nested backquotes are permitted."
 This simply recurses through the body."
   (let ((exp (backquote-listify (list (cons 0 (list 'quote (car s))))
                                 (backquote-process (cdr s) level))))
-    (if (eq (car-safe exp) 'quote)
-        (cons 0 (list 'quote s))
-      (cons 1 exp))))
+    (cons (if (eq (car-safe exp) 'quote) 0 1) exp)))
 
 (defun backquote-process (s &optional level)
   "Process the body of a backquote.
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 1bb70963a57..72ec8ec1801 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -635,7 +635,8 @@ Can only be used from within the lexical body of a primary or around method."
 
 (defun cl--generic-search-method (met-name)
   (let ((base-re (concat "(\\(?:cl-\\)?defmethod[ \t]+"
-                         (regexp-quote (format "%s\\_>" (car met-name))))))
+                         (regexp-quote (format "%s" (car met-name)))
+			 "\\_>")))
     (or
      (re-search-forward
       (concat base-re "[^&\"\n]*"
@@ -724,6 +725,14 @@ Can only be used from within the lexical body of a primary or around method."
 
 (add-function :before-until cl-generic-tagcode-function
               #'cl--generic-struct-tagcode)
+
+(defun cl--generic-struct-tag (name)
+  `(and (vectorp ,name)
+        (> (length ,name) 0)
+        (let ((tag (aref ,name 0)))
+          (if (eq (symbol-function tag) :quick-object-witness-check)
+              tag))))
+
 (defun cl--generic-struct-tagcode (type name)
   (and (symbolp type)
        (get type 'cl-struct-type)
@@ -733,12 +742,19 @@ Can only be used from within the lexical body of a primary or around method."
        (or (equal '(cl-tag-slot) (car (get type 'cl-struct-slots)))
            (error "Can't dispatch on cl-struct %S: no tag in slot 0"
                   type))
-       ;; We could/should check the vector has length >0,
-       ;; but really, mixing vectors and structs is a bad idea,
-       ;; so let's not waste time trying to handle the case
-       ;; of an empty vector.
-       ;; BEWARE: this returns a bogus tag for non-struct vectors.
-       `(50 . (and (vectorp ,name) (aref ,name 0)))))
+       ;; It's tempting to use (and (vectorp ,name) (aref ,name 0))
+       ;; but that would suffer from some problems:
+       ;; - the vector may have size 0.
+       ;; - when called on an actual vector (rather than an object), we'd
+       ;;   end up returning an arbitrary value, possibly colliding with
+       ;;   other tagcode's values.
+       ;; - it can also result in returning all kinds of irrelevant
+       ;;   values which would end up filling up the method-cache with
+       ;;   lots of irrelevant/redundant entries.
+       ;; FIXME: We could speed this up by introducing a dedicated
+       ;; vector type at the C level, so we could do something like
+       ;; (and (vector-objectp ,name) (aref ,name 0))
+       `(50 . ,(cl--generic-struct-tag name))))
 
 (add-function :before-until cl-generic-tag-types-function
               #'cl--generic-struct-tag-types)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 38f15b89b0e..eaec2c5263c 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -221,7 +221,7 @@ The name is made by appending a number to PREFIX, default \"G\"."
   '(&optional &rest &key &allow-other-keys &aux &whole &body &environment))
 
 (defvar cl--bind-block) (defvar cl--bind-defs) (defvar cl--bind-enquote)
-(defvar cl--bind-inits) (defvar cl--bind-lets) (defvar cl--bind-forms)
+(defvar cl--bind-lets) (defvar cl--bind-forms)
 
 (defun cl--transform-lambda (form bind-block)
   "Transform a function form FORM of name BIND-BLOCK.
@@ -229,9 +229,11 @@ BIND-BLOCK is the name of the symbol to which the function will be bound,
 and which will be used for the name of the `cl-block' surrounding the
 function's body.
 FORM is of the form (ARGS . BODY)."
+  ;; FIXME: (lambda (a &aux b) 1) expands to (lambda (a &rest --cl-rest--) ...)
+  ;; where the --cl-rest-- is clearly undesired.
   (let* ((args (car form)) (body (cdr form)) (orig-args args)
 	 (cl--bind-block bind-block) (cl--bind-defs nil) (cl--bind-enquote nil)
-	 (cl--bind-inits nil) (cl--bind-lets nil) (cl--bind-forms nil)
+         (cl--bind-lets nil) (cl--bind-forms nil)
 	 (header nil) (simple-args nil))
     (while (or (stringp (car body))
 	       (memq (car-safe (car body)) '(interactive declare cl-declare)))
@@ -244,10 +246,10 @@ FORM is of the form (ARGS . BODY)."
     (if (setq cl--bind-enquote (memq '&cl-quote args))
 	(setq args (delq '&cl-quote args)))
     (if (memq '&whole args) (error "&whole not currently implemented"))
-    (let* ((p (memq '&environment args)) (v (cadr p))
-           (env-exp 'macroexpand-all-environment))
+    (let* ((p (memq '&environment args))
+           (v (cadr p)))
       (if p (setq args (nconc (delq (car p) (delq v args))
-                              (list '&aux (list v env-exp))))))
+                              `(&aux (,v macroexpand-all-environment))))))
     (while (and args (symbolp (car args))
 		(not (memq (car args) '(nil &rest &body &key &aux)))
 		(not (and (eq (car args) '&optional)
@@ -261,8 +263,7 @@ FORM is of the form (ARGS . BODY)."
       (cl--do-arglist args nil (- (length simple-args)
                                   (if (memq '&optional simple-args) 1 0)))
       (setq cl--bind-lets (nreverse cl--bind-lets))
-      (cl-list* (and cl--bind-inits `(cl-eval-when (compile load eval)
-                                ,@(nreverse cl--bind-inits)))
+      (cl-list* nil
 	     (nconc (nreverse simple-args)
 		    (list '&rest (car (pop cl--bind-lets))))
 	     (nconc (let ((hdr (nreverse header)))
@@ -390,6 +391,11 @@ its argument list allows full Common Lisp conventions."
    (t x)))
 
 (defun cl--make-usage-args (arglist)
+  (let ((aux (ignore-errors (cl-position '&aux arglist))))
+    (when aux
+      ;; `&aux' args aren't arguments, so let's just drop them from the
+      ;; usage info.
+      (setq arglist (cl-subseq arglist 0 aux))))
   (if (cdr-safe (last arglist))         ;Not a proper list.
       (let* ((last (last arglist))
              (tail (cdr last)))
@@ -426,7 +432,7 @@ its argument list allows full Common Lisp conventions."
                    ))))
               arglist))))
 
-(defun cl--do-arglist (args expr &optional num)   ; uses bind-*
+(defun cl--do-arglist (args expr &optional num)   ; uses cl--bind-*
   (if (nlistp args)
       (if (or (memq args cl--lambda-list-keywords) (not (symbolp args)))
 	  (error "Invalid argument name: %s" args)
@@ -441,9 +447,9 @@ its argument list allows full Common Lisp conventions."
 	  (keys nil)
 	  (laterarg nil) (exactarg nil) minarg)
       (or num (setq num 0))
-      (if (listp (cadr restarg))
-	  (setq restarg (make-symbol "--cl-rest--"))
-	(setq restarg (cadr restarg)))
+      (setq restarg (if (listp (cadr restarg))
+                        (make-symbol "--cl-rest--")
+                      (cadr restarg)))
       (push (list restarg expr) cl--bind-lets)
       (if (eq (car args) '&whole)
 	  (push (list (cl--pop2 args) restarg) cl--bind-lets))
@@ -570,12 +576,11 @@ its argument list allows full Common Lisp conventions."
   "Bind the variables in ARGS to the result of EXPR and execute BODY."
   (declare (indent 2)
            (debug (&define cl-macro-list def-form cl-declarations def-body)))
-  (let* ((cl--bind-lets nil) (cl--bind-forms nil) (cl--bind-inits nil)
+  (let* ((cl--bind-lets nil) (cl--bind-forms nil)
 	 (cl--bind-defs nil) (cl--bind-block 'cl-none) (cl--bind-enquote nil))
     (cl--do-arglist (or args '(&aux)) expr)
-    (append '(progn) cl--bind-inits
-	    (list `(let* ,(nreverse cl--bind-lets)
-                     ,@(nreverse cl--bind-forms) ,@body)))))
+    (macroexp-let* (nreverse cl--bind-lets)
+                   (macroexp-progn (append (nreverse cl--bind-forms) body)))))
 
 
 ;;; The `cl-eval-when' form.
@@ -655,30 +660,26 @@ allowed only in the final clause, and matches if no other keys match.
 Key values are compared by `eql'.
 \n(fn EXPR (KEYLIST BODY...)...)"
   (declare (indent 1) (debug (form &rest (sexp body))))
-  (let* ((temp (if (cl--simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
-	 (head-list nil)
-	 (body (cons
-		'cond
-		(mapcar
-		 (function
-		  (lambda (c)
-		    (cons (cond ((memq (car c) '(t otherwise)) t)
-				((eq (car c) 'cl--ecase-error-flag)
-				 `(error "cl-ecase failed: %s, %s"
-                                         ,temp ',(reverse head-list)))
-				((listp (car c))
-				 (setq head-list (append (car c) head-list))
-				 `(cl-member ,temp ',(car c)))
-				(t
-				 (if (memq (car c) head-list)
-				     (error "Duplicate key in case: %s"
-					    (car c)))
-				 (push (car c) head-list)
-				 `(eql ,temp ',(car c))))
-			  (or (cdr c) '(nil)))))
-		 clauses))))
-    (if (eq temp expr) body
-      `(let ((,temp ,expr)) ,body))))
+  (macroexp-let2 macroexp-copyable-p temp expr
+    (let* ((head-list nil))
+      `(cond
+        ,@(mapcar
+           (lambda (c)
+             (cons (cond ((memq (car c) '(t otherwise)) t)
+                         ((eq (car c) 'cl--ecase-error-flag)
+                          `(error "cl-ecase failed: %s, %s"
+                                  ,temp ',(reverse head-list)))
+                         ((listp (car c))
+                          (setq head-list (append (car c) head-list))
+                          `(cl-member ,temp ',(car c)))
+                         (t
+                          (if (memq (car c) head-list)
+                              (error "Duplicate key in case: %s"
+                                     (car c)))
+                          (push (car c) head-list)
+                          `(eql ,temp ',(car c))))
+                   (or (cdr c) '(nil))))
+           clauses)))))
 
 ;;;###autoload
 (defmacro cl-ecase (expr &rest clauses)
@@ -698,24 +699,22 @@ final clause, and matches if no other keys match.
 \n(fn EXPR (TYPE BODY...)...)"
   (declare (indent 1)
            (debug (form &rest ([&or cl-type-spec "otherwise"] body))))
-  (let* ((temp (if (cl--simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
-	 (type-list nil)
-	 (body (cons
-		'cond
-		(mapcar
-		 (function
-		  (lambda (c)
-		    (cons (cond ((eq (car c) 'otherwise) t)
-				((eq (car c) 'cl--ecase-error-flag)
-				 `(error "cl-etypecase failed: %s, %s"
-                                         ,temp ',(reverse type-list)))
-				(t
-				 (push (car c) type-list)
-				 (cl--make-type-test temp (car c))))
-			  (or (cdr c) '(nil)))))
-		 clauses))))
-    (if (eq temp expr) body
-      `(let ((,temp ,expr)) ,body))))
+  (macroexp-let2 macroexp-copyable-p temp expr
+    (let* ((type-list nil))
+      (cons
+       'cond
+       (mapcar
+        (function
+         (lambda (c)
+           (cons (cond ((eq (car c) 'otherwise) t)
+                       ((eq (car c) 'cl--ecase-error-flag)
+                        `(error "cl-etypecase failed: %s, %s"
+                                ,temp ',(reverse type-list)))
+                       (t
+                        (push (car c) type-list)
+                        `(cl-typep ,temp ',(car c))))
+                 (or (cdr c) '(nil)))))
+        clauses)))))
 
 ;;;###autoload
 (defmacro cl-etypecase (expr &rest clauses)
@@ -1439,16 +1438,14 @@ For more details, see Info node `(cl)Loop Facility'.
 	(push `(progn (if ,what (cl-incf ,var)) t) cl--loop-body)))
 
      ((memq word '(minimize minimizing maximize maximizing))
-      (let* ((what (pop cl--loop-args))
-	     (temp (if (cl--simple-expr-p what) what
-                     (make-symbol "--cl-var--")))
-	     (var (cl--loop-handle-accum nil))
-	     (func (intern (substring (symbol-name word) 0 3)))
-	     (set `(setq ,var (if ,var (,func ,var ,temp) ,temp))))
-	(push `(progn ,(if (eq temp what) set
-                         `(let ((,temp ,what)) ,set))
-                      t)
-              cl--loop-body)))
+      (push `(progn ,(macroexp-let2 macroexp-copyable-p temp
+                                    (pop cl--loop-args)
+                       (let* ((var (cl--loop-handle-accum nil))
+                              (func (intern (substring (symbol-name word)
+                                                       0 3))))
+                         `(setq ,var (if ,var (,func ,var ,temp) ,temp))))
+                    t)
+            cl--loop-body))
 
      ((eq word 'with)
       (let ((bindings nil))
@@ -2104,14 +2101,11 @@ values.  For compatibility, (cl-values A B C) is a synonym for (list A B C).
                (< cl--optimize-speed 3)
                (= cl--optimize-safety 3)))
       form
-    (let* ((temp (if (cl--simple-expr-p form 3)
-                     form (make-symbol "--cl-var--")))
-           (body `(progn (unless ,(cl--make-type-test temp type)
-                           (signal 'wrong-type-argument
-                                   (list ',type ,temp ',form)))
-                         ,temp)))
-      (if (eq temp form) body
-        `(let ((,temp ,form)) ,body)))))
+    (macroexp-let2 macroexp-copyable-p temp form
+      `(progn (unless (cl-typep ,temp ',type)
+                (signal 'wrong-type-argument
+                        (list ',type ,temp ',form)))
+              ,temp))))
 
 (defvar cl--proclaim-history t)    ; for future compilers
 (defvar cl--declare-stack t)       ; for future compilers
@@ -2425,15 +2419,11 @@ non-nil value, that slot cannot be set via `setf'.
 	 (tag (intern (format "cl-struct-%s" name)))
 	 (tag-symbol (intern (format "cl-struct-%s-tags" name)))
 	 (include-descs nil)
-	 (side-eff nil)
 	 (type nil)
 	 (named nil)
 	 (forms nil)
+         (docstring (if (stringp (car descs)) (pop descs)))
 	 pred-form pred-check)
-    (if (stringp (car descs))
-	(push `(put ',name 'structure-documentation
-                    ,(pop descs))
-              forms))
     (setq descs (cons '(cl-tag-slot)
 		      (mapcar (function (lambda (x) (if (consp x) x (list x))))
 			      descs)))
@@ -2458,6 +2448,7 @@ non-nil value, that slot cannot be set via `setf'.
 	      ((eq opt :predicate)
 	       (if args (setq predicate (car args))))
 	      ((eq opt :include)
+               (when include (error "Can't :include more than once"))
 	       (setq include (car args)
 		     include-descs (mapcar (function
 					    (lambda (x)
@@ -2511,20 +2502,19 @@ non-nil value, that slot cannot be set via `setf'.
 	    (if named (setq tag name)))
 	(setq type 'vector named 'true)))
     (or named (setq descs (delq (assq 'cl-tag-slot descs) descs)))
-    (push `(defvar ,tag-symbol) forms)
     (when (and (null predicate) named)
       (setq predicate (intern (format "cl--struct-%s-p" name))))
     (setq pred-form (and named
 			 (let ((pos (- (length descs)
 				       (length (memq (assq 'cl-tag-slot descs)
 						     descs)))))
-			   (if (eq type 'vector)
-			       `(and (vectorp cl-x)
-				     (>= (length cl-x) ,(length descs))
-				     (memq (aref cl-x ,pos) ,tag-symbol))
-			     (if (= pos 0)
-				 `(memq (car-safe cl-x) ,tag-symbol)
-			       `(and (consp cl-x)
+			   (cond
+                            ((eq type 'vector)
+                             `(and (vectorp cl-x)
+                                   (>= (length cl-x) ,(length descs))
+                                   (memq (aref cl-x ,pos) ,tag-symbol)))
+                            ((= pos 0) `(memq (car-safe cl-x) ,tag-symbol))
+                            (t `(and (consp cl-x)
 				     (memq (nth ,pos cl-x) ,tag-symbol))))))
 	  pred-check (and pred-form (> safety 0)
 			  (if (and (eq (cl-caadr pred-form) 'vectorp)
@@ -2546,6 +2536,7 @@ non-nil value, that slot cannot be set via `setf'.
 	      (push slot slots)
 	      (push (nth 1 desc) defaults)
 	      (push `(cl-defsubst ,accessor (cl-x)
+                       (declare (side-effect-free t))
                        ,@(and pred-check
 			      (list `(or ,pred-check
                                          (error "%s accessing a non-%s"
@@ -2554,7 +2545,6 @@ non-nil value, that slot cannot be set via `setf'.
                           (if (= pos 0) '(car cl-x)
                             `(nth ,pos cl-x))))
                     forms)
-	      (push (cons accessor t) side-eff)
               (if (cadr (memq :read-only (cddr desc)))
                   (push `(gv-define-expander ,accessor
                            (lambda (_cl-do _cl-x)
@@ -2587,15 +2577,14 @@ non-nil value, that slot cannot be set via `setf'.
 	  defaults (nreverse defaults))
     (when pred-form
       (push `(cl-defsubst ,predicate (cl-x)
+               (declare (side-effect-free error-free))
                ,(if (eq (car pred-form) 'and)
                     (append pred-form '(t))
                   `(and ,pred-form t)))
             forms)
-      (push `(put ',name 'cl-deftype-satisfies ',predicate) forms)
-      (push (cons predicate 'error-free) side-eff))
+      (push `(put ',name 'cl-deftype-satisfies ',predicate) forms))
     (and copier
-	 (progn (push `(defun ,copier (x) (copy-sequence x)) forms)
-		(push (cons copier t) side-eff)))
+         (push `(defalias ',copier #'copy-sequence) forms))
     (if constructor
 	(push (list constructor
 		       (cons '&key (delq nil (copy-sequence slots))))
@@ -2607,11 +2596,11 @@ non-nil value, that slot cannot be set via `setf'.
 	     (make (cl-mapcar (function (lambda (s d) (if (memq s anames) s d)))
 			    slots defaults)))
 	(push `(cl-defsubst ,name
-                 (&cl-defs '(nil ,@descs) ,@args)
+                   (&cl-defs '(nil ,@descs) ,@args)
+                 ,@(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
+                       '((declare (side-effect-free t))))
                  (,type ,@make))
-              forms)
-	(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
-	    (push (cons name t) side-eff))))
+              forms)))
     (if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
     ;; Don't bother adding to cl-custom-print-functions since it's not used
     ;; by anything anyway!
@@ -2624,17 +2613,14 @@ non-nil value, that slot cannot be set via `setf'.
     ;;                  (and ,pred-form ,print-func))
     ;;                cl-custom-print-functions))
     ;;          forms))
-    (push `(setq ,tag-symbol (list ',tag)) forms)
-    (push `(cl-eval-when (compile load eval)
-             (put ',name 'cl-struct-slots ',descs)
-             (put ',name 'cl-struct-type ',(list type (eq named t)))
-             (put ',name 'cl-struct-include ',include)
-             (put ',name 'cl-struct-print ,print-auto)
-             ,@(mapcar (lambda (x)
-                         `(function-put ',(car x) 'side-effect-free ',(cdr x)))
-                       side-eff))
-          forms)
-    `(progn ,@(nreverse (cons `',name forms)))))
+    `(progn
+       (defvar ,tag-symbol)
+       ,@(nreverse forms)
+       (eval-and-compile
+         (cl-struct-define ',name ,docstring ',include
+                           ',type ,(eq named t) ',descs ',tag-symbol ',tag
+                           ',print-auto))
+       ',name)))
 
 (defun cl-struct-sequence-type (struct-type)
   "Return the sequence used to build STRUCT-TYPE.
@@ -2741,14 +2727,11 @@ STRING is an optional description of the desired type."
   (declare (debug (place cl-type-spec &optional stringp)))
   (and (or (not (cl--compiling-file))
 	   (< cl--optimize-speed 3) (= cl--optimize-safety 3))
-       (let* ((temp (if (cl--simple-expr-p form 3)
-			form (make-symbol "--cl-var--")))
-	      (body `(or ,(cl--make-type-test temp type)
-                         (signal 'wrong-type-argument
-                                 (list ,(or string `',type)
-                                       ,temp ',form)))))
-	 (if (eq temp form) `(progn ,body nil)
-	   `(let ((,temp ,form)) ,body nil)))))
+       (macroexp-let2 macroexp-copyable-p temp form
+         `(progn (or (cl-typep ,temp ',type)
+                     (signal 'wrong-type-argument
+                             (list ,(or string `',type) ,temp ',form)))
+                 nil))))
 
 ;;;###autoload
 (defmacro cl-assert (form &optional show-args string &rest args)
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
new file mode 100644
index 00000000000..c9867b412a1
--- /dev/null
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -0,0 +1,48 @@
+;;; cl-preloaded.el --- Preloaded part of the CL library  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015  Free Software Foundation, Inc
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+
+;; 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:
+
+;; The expectation is that structs defined with cl-defstruct do not
+;; need cl-lib at run-time, but we'd like to hide the details of the
+;; cl-struct metadata behind the cl-struct-define function, so we put
+;; it in this pre-loaded file.
+
+;;; Code:
+
+(defun cl-struct-define (name docstring parent type named slots children-sym
+                              tag print-auto)
+  (if (boundp children-sym)
+      (add-to-list children-sym tag)
+    (set children-sym (list tag)))
+  ;; If the cl-generic support, we need to be able to check
+  ;; if a vector is a cl-struct object, without knowing its particular type.
+  ;; So we use the (otherwise) unused function slots of the tag symbol
+  ;; to put a special witness value, to make the check easy and reliable.
+  (unless named (fset tag :quick-object-witness-check))
+  (put name 'cl-struct-slots slots)
+  (put name 'cl-struct-type (list type named))
+  (if parent (put name 'cl-struct-include parent))
+  (if print-auto (put name 'cl-struct-print print-auto))
+  (if docstring (put name 'structure-documentation docstring)))
+
+(provide 'cl-preloaded)
+;;; cl-preloaded.el ends here
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 1cd7bd76b0e..5da1cea6bb3 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -376,7 +376,6 @@ The two cases that are handled are:
           (setq cl--function-convert-cache (cons newf res))
           res))))
    (t
-    (setq cl--labels-convert-cache cl--function-convert-cache)
     (cl--labels-convert f))))
 
 (defmacro lexical-let (bindings &rest body)
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 7e6f56518a2..f7e8619948a 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -149,11 +149,12 @@ For example, you could write
     ...BODY CODE...)"
   (declare (doc-string 2)
            (debug (&define name string-or-null-p
-			   [&optional [&not keywordp] sexp
-			    &optional [&not keywordp] sexp
-			    &optional [&not keywordp] sexp]
-			   [&rest [keywordp sexp]]
-			   def-body)))
+                           [&optional [&not keywordp] sexp
+                            &optional [&not keywordp] sexp
+                            &optional [&not keywordp] sexp]
+                           [&rest [keywordp sexp]]
+                           def-body))
+           (indent 1))
 
   ;; Allow skipping the first three args.
   (cond
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index feb06711cb3..46585ee76c6 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -219,7 +219,7 @@ for CLASS.  Optional ALLOW-SUBCLASS says that it is ok for
 being pedantic."
   (unless class
     (message "Unsafe call to `eieio-persistent-read'."))
-  (when class (eieio--check-type class-p class))
+  (when class (cl-check-type class class))
   (let ((ret nil)
 	(buffstr nil))
     (unwind-protect
@@ -481,7 +481,7 @@ instance."
 
 (cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
   "Set the string which is OBJ's NAME."
-  (eieio--check-type stringp name)
+  (cl-check-type name string)
   (eieio-oset obj 'object-name name))
 
 (cl-defmethod clone ((obj eieio-named) &rest params)
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 7492f0522ab..77d8c01388b 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -40,6 +40,8 @@
 (declare-function slot-unbound "eieio")
 (declare-function slot-missing "eieio")
 (declare-function child-of-class-p "eieio")
+(declare-function same-class-p "eieio")
+(declare-function object-of-class-p "eieio")
 
 
 ;;;
@@ -154,15 +156,6 @@ Currently under control of this var:
 
 
 ;;; Important macros used internally in eieio.
-;;
-(defmacro eieio--check-type (type obj)
-  (unless (symbolp obj)
-    (error "eieio--check-type wants OBJ to be a variable"))
-  `(if (not ,(cond
-              ((eq 'or (car-safe type))
-               `(or ,@(mapcar (lambda (type) `(,type ,obj)) (cdr type))))
-              (t `(,type ,obj))))
-       (signal 'wrong-type-argument (list ',type ,obj))))
 
 (defmacro eieio--class-v (class)        ;Use a macro, so it acts as a GV place.
   "Internal: Return the class vector from the CLASS symbol."
@@ -183,27 +176,17 @@ Currently under control of this var:
       (eq (aref class 0) 'defclass)
     (error nil)))
 
-(defsubst eieio-class-object (class)
-  "Check that CLASS is a class and return the corresponding object."
-  (let ((c (eieio--class-object class)))
-    (eieio--check-type eieio--class-p c)
-    c))
-
-(defsubst class-p (class)
+(defun class-p (class)
   "Return non-nil if CLASS is a valid class vector.
 CLASS is a symbol."                     ;FIXME: Is it a vector or a symbol?
-  ;; this new method is faster since it doesn't waste time checking lots of
-  ;; things.
-  (condition-case nil
-      (eq (aref (eieio--class-v class) 0) 'defclass)
-    (error nil)))
+  (and (symbolp class) (eieio--class-p (eieio--class-v class))))
 
 (defun eieio-class-name (class)
   "Return a Lisp like symbol name for CLASS."
   ;; FIXME: What's a "Lisp like symbol name"?
   ;; FIXME: CLOS returns a symbol, but the code returns a string.
   (if (eieio--class-p class) (setq class (eieio--class-symbol class)))
-  (eieio--check-type class-p class)
+  (cl-check-type class class)
   ;; I think this is supposed to return a symbol, but to me CLASS is a symbol,
   ;; and I wanted a string.  Arg!
   (format "#<class %s>" (symbol-name class)))
@@ -221,14 +204,17 @@ CLASS is a symbol."                     ;FIXME: Is it a vector or a symbol?
 Return nil if that option doesn't exist."
   (eieio--class-option-assoc (eieio--class-options class) option))
 
-(defsubst eieio-object-p (obj)
+(defun eieio-object-p (obj)
   "Return non-nil if OBJ is an EIEIO object."
   (and (vectorp obj)
-       (condition-case nil
-           (eq (aref (eieio--object-class-object obj) 0) 'defclass)
-         (error nil))))
+       (> (length obj) 0)
+       (let ((tag (eieio--object-class-tag obj)))
+         (and (symbolp tag)
+              ;; (eq (symbol-function tag) :quick-object-witness-check)
+              (boundp tag)
+              (eieio--class-p (symbol-value tag))))))
 
-(defalias 'object-p 'eieio-object-p)
+(define-obsolete-function-alias 'object-p 'eieio-object-p "25.1")
 
 (defsubst class-abstract-p (class)
   "Return non-nil if CLASS is abstract.
@@ -266,10 +252,9 @@ It creates an autoload function for CNAME's constructor."
   ;; simply not exist yet.  So instead we just don't store the list of parents
   ;; here in eieio-defclass-autoload at all, since it seems that they're just
   ;; not needed before the class is actually loaded.
-  (let* ((oldc (when (class-p cname) (eieio--class-v cname)))
-	 (newc (eieio--class-make cname))
-	 )
-    (if oldc
+  (let* ((oldc (eieio--class-v cname))
+	 (newc (eieio--class-make cname)))
+    (if (eieio--class-p oldc)
 	nil ;; Do nothing if we already have this class.
 
       ;; turn this into a usable self-pointing symbol
@@ -300,7 +285,21 @@ It creates an autoload function for CNAME's constructor."
                      (cl-every (lambda (elem) (cl-typep elem ',elem-type))
                                list)))))
 
-(declare-function eieio--defmethod "eieio-generic" (method kind argclass code))
+
+(defun eieio-make-class-predicate (class)
+  (lambda (obj)
+    ;; (:docstring (format "Test OBJ to see if it's an object of type %S."
+    ;;                     class))
+    (and (eieio-object-p obj)
+         (same-class-p obj class))))
+
+(defun eieio-make-child-predicate (class)
+  (lambda (obj)
+    ;; (:docstring (format
+    ;;              "Test OBJ to see if it's an object is a child of type %S."
+    ;;              class))
+    (and (eieio-object-p obj)
+         (object-of-class-p obj class))))
 
 (defun eieio-defclass-internal (cname superclasses slots options)
   "Define CNAME as a new subclass of SUPERCLASSES.
@@ -314,7 +313,7 @@ See `defclass' for more information."
   (setq eieio-hook nil)
 
   (let* ((pname superclasses)
-	 (oldc (when (class-p cname) (eieio--class-v cname)))
+	 (oldc (let ((c (eieio--class-v cname))) (if (eieio--class-p c) c)))
 	 (newc (if (and oldc (not (eieio--class-default-object-cache oldc)))
                    ;; The oldc class is a stub setup by eieio-defclass-autoload.
                    ;; Reuse it instead of creating a new one, so that existing
@@ -342,19 +341,20 @@ See `defclass' for more information."
     (if pname
 	(progn
 	  (dolist (p pname)
-	    (if (and p (symbolp p))
-		(if (not (class-p p))
+	    (if (not (and p (symbolp p)))
+		(error "Invalid parent class %S" p)
+              (let ((c (eieio--class-v p)))
+                (if (not (eieio--class-p c))
 		    ;; bad class
 		    (error "Given parent class %S is not a class" p)
 		  ;; good parent class...
 		  ;; save new child in parent
-                  (cl-pushnew cname (eieio--class-children (eieio--class-v p)))
+                  (cl-pushnew cname (eieio--class-children c))
 		  ;; Get custom groups, and store them into our local copy.
 		  (mapc (lambda (g) (cl-pushnew g groups :test #'equal))
-			(eieio--class-option (eieio--class-v p) :custom-groups))
-		  ;; save parent in child
-                  (push (eieio--class-v p) (eieio--class-parent newc)))
-	      (error "Invalid parent class %S" p)))
+			(eieio--class-option c :custom-groups))
+		  ;; Save parent in child.
+                  (push c (eieio--class-parent newc))))))
 	  ;; Reverse the list of our parents so that they are prioritized in
 	  ;; the same order as specified in the code.
 	  (cl-callf nreverse (eieio--class-parent newc)))
@@ -506,13 +506,7 @@ See `defclass' for more information."
 	 (eieio--class-option-assoc options :documentation))
 
     ;; Save the file location where this class is defined.
-    (let ((fname (if load-in-progress
-		     load-file-name
-		   buffer-file-name)))
-      (when fname
-	(when (string-match "\\.elc\\'" fname)
-	  (setq fname (substring fname 0 (1- (length fname)))))
-	(put cname 'class-location fname)))
+    (add-to-list 'current-load-list `(eieio-defclass . ,cname))
 
     ;; We have a list of custom groups.  Store them into the options.
     (let ((g (eieio--class-option-assoc options :custom-groups)))
@@ -539,6 +533,7 @@ See `defclass' for more information."
           ;; objects readable.
           (tag (intern (format "eieio-class-tag--%s" cname))))
       (set tag newc)
+      (fset tag :quick-object-witness-check)
       (setf (eieio--object-class-tag cache) tag)
       (let ((eieio-skip-typecheck t))
 	;; All type-checking has been done to our satisfaction
@@ -908,12 +903,13 @@ Argument FN is the function calling this verifier."
 ;;
 (defun eieio-oref (obj slot)
   "Return the value in OBJ at SLOT in the object vector."
-  (eieio--check-type (or eieio-object-p class-p) obj)
-  (eieio--check-type symbolp slot)
-  (if (class-p obj) (eieio-class-un-autoload obj))
+  (cl-check-type slot symbol)
+  (cl-check-type obj (or eieio-object class))
   (let* ((class (cond ((symbolp obj)
                        (error "eieio-oref called on a class!")
-                       (eieio--class-v obj))
+                       (let ((c (eieio--class-v obj)))
+                         (if (eieio--class-p c) (eieio-class-un-autoload obj))
+                         c))
                       (t (eieio--object-class-object obj))))
 	 (c (eieio--slot-name-index class obj slot)))
     (if (not c)
@@ -928,15 +924,15 @@ Argument FN is the function calling this verifier."
 	  (slot-missing obj slot 'oref)
 	  ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot))
 	  )
-      (eieio--check-type eieio-object-p obj)
+      (cl-check-type obj eieio-object)
       (eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref))))
 
 
 (defun eieio-oref-default (obj slot)
   "Do the work for the macro `oref-default' with similar parameters.
 Fills in OBJ's SLOT with its default value."
-  (eieio--check-type (or eieio-object-p class-p) obj)
-  (eieio--check-type symbolp slot)
+  (cl-check-type obj (or eieio-object class))
+  (cl-check-type slot symbol)
   (let* ((cl (cond ((symbolp obj) (eieio--class-v obj))
                    (t (eieio--object-class-object obj))))
 	 (c (eieio--slot-name-index cl obj slot)))
@@ -974,8 +970,8 @@ Fills in OBJ's SLOT with its default value."
 (defun eieio-oset (obj slot value)
   "Do the work for the macro `oset'.
 Fills in OBJ's SLOT with VALUE."
-  (eieio--check-type eieio-object-p obj)
-  (eieio--check-type symbolp slot)
+  (cl-check-type obj eieio-object)
+  (cl-check-type slot symbol)
   (let* ((class (eieio--object-class-object obj))
          (c (eieio--slot-name-index class obj slot)))
     (if (not c)
@@ -999,8 +995,8 @@ Fills in OBJ's SLOT with VALUE."
   "Do the work for the macro `oset-default'.
 Fills in the default value in CLASS' in SLOT with VALUE."
   (setq class (eieio--class-object class))
-  (eieio--check-type eieio--class-p class)
-  (eieio--check-type symbolp slot)
+  (cl-check-type class eieio--class)
+  (cl-check-type slot symbol)
   (let* ((c (eieio--slot-name-index class nil slot)))
     (if (not c)
         ;; It might be missing because it is a :class allocated slot.
@@ -1222,10 +1218,11 @@ method invocation orders of the involved classes."
   ;;    A class must be defined before it can be used as a parameter
   ;;    specializer in a defmethod form.
   ;; So we can ignore types that are not known to denote classes.
-  (and (class-p type)
-       ;; Prefer (aref ,name 0) over (eieio--class-tag ,name) so that
-       ;; the tagcode is identical to the tagcode used for cl-struct.
-       `(50 . (and (vectorp ,name) (aref ,name 0)))))
+  (and (eieio--class-p (eieio--class-object type))
+       ;; Use the exact same code as for cl-struct, so that methods
+       ;; that dispatch on both kinds of objects get to share this
+       ;; part of the dispatch code.
+       `(50 . ,(cl--generic-struct-tag name))))
 
 (add-function :before-until cl-generic-tag-types-function
               #'eieio--generic-tag-types)
diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el
index 119f7cce038..82349192e5e 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -117,7 +117,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
 	  (setq publa (cdr publa)))))))
 
 ;;; Augment the Data debug thing display list.
-(data-debug-add-specialized-thing (lambda (thing) (object-p thing))
+(data-debug-add-specialized-thing (lambda (thing) (eieio-object-p thing))
 				  #'data-debug-insert-object-button)
 
 ;;; DEBUG METHODS
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 8d40edf5624..304ee364dc8 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -45,7 +45,7 @@ variable `eieio-default-superclass'."
 						nil t)))
 		 nil))
   (if (not root-class) (setq root-class 'eieio-default-superclass))
-  (eieio--check-type class-p root-class)
+  (cl-check-type root-class class)
   (display-buffer (get-buffer-create "*EIEIO OBJECT BROWSE*") t)
   (with-current-buffer (get-buffer "*EIEIO OBJECT BROWSE*")
     (erase-buffer)
@@ -58,7 +58,7 @@ variable `eieio-default-superclass'."
 Argument THIS-ROOT is the local root of the tree.
 Argument PREFIX is the character prefix to use.
 Argument CH-PREFIX is another character prefix to display."
-  (eieio--check-type class-p this-root)
+  (cl-check-type this-root class)
   (let ((myname (symbol-name this-root))
 	(chl (eieio--class-children (eieio--class-v this-root)))
 	(fprefix (concat ch-prefix "  +--"))
@@ -85,12 +85,12 @@ If CLASS is actually an object, then also display current values of that object.
 	      "n abstract"
 	    "")
 	  " class")
-  (let ((location (get class 'class-location)))
+  (let ((location (find-lisp-object-file-name class 'eieio-defclass)))
     (when location
       (insert " in `")
       (help-insert-xref-button
-       (file-name-nondirectory location)
-       'eieio-class-def class location)
+       (help-fns-short-filename location)
+       'eieio-class-def class location 'eieio-defclass)
       (insert "'")))
   (insert ".\n")
   ;; Parents
@@ -204,15 +204,6 @@ Outputs to the current buffer."
 	    prot (cdr prot)
 	    i (1+ i)))))
 
-(defun eieio-build-class-list (class)
-  "Return a list of all classes that inherit from CLASS."
-  (if (class-p class)
-      (cl-mapcan
-       (lambda (c)
-         (append (list c) (eieio-build-class-list c)))
-       (eieio--class-children (eieio--class-v class)))
-    (list class)))
-
 (defun eieio-build-class-alist (&optional class instantiable-only buildlist)
   "Return an alist of all currently active classes for completion purposes.
 Optional argument CLASS is the class to start with.
@@ -256,24 +247,22 @@ are not abstract."
 
 ;;; METHOD COMPLETION / DOC
 
-(define-button-type 'eieio-method-def
-  :supertype 'help-xref
-  'help-function (lambda (class method file)
-		   (eieio-help-find-method-definition class method file))
-  'help-echo (purecopy "mouse-2, RET: find method's definition"))
-
 (define-button-type 'eieio-class-def
-  :supertype 'help-xref
-  'help-function (lambda (class file)
-		   (eieio-help-find-class-definition class file))
+  :supertype 'help-function-def
   'help-echo (purecopy "mouse-2, RET: find class definition"))
 
+(defconst eieio--defclass-regexp "(defclass[ \t\r\n]+%s[ \t\r\n]+")
+(with-eval-after-load 'find-func
+  (defvar find-function-regexp-alist)
+  (add-to-list 'find-function-regexp-alist
+               `(eieio-defclass . eieio--defclass-regexp)))
+
 ;;;###autoload
 (defun eieio-help-constructor (ctr)
   "Describe CTR if it is a class constructor."
   (when (class-p ctr)
     (erase-buffer)
-    (let ((location (get ctr 'class-location))
+    (let ((location (find-lisp-object-file-name ctr 'eieio-defclass))
 	  (def (symbol-function ctr)))
       (goto-char (point-min))
       (prin1 ctr)
@@ -288,8 +277,8 @@ are not abstract."
       (when location
 	(insert " in `")
 	(help-insert-xref-button
-	 (file-name-nondirectory location)
-	 'eieio-class-def ctr location)
+	 (help-fns-short-filename location)
+	 'eieio-class-def ctr location 'eieio-defclass)
 	(insert "'"))
       (insert ".\nCreates an object of class " (symbol-name ctr) ".")
       (goto-char (point-max))
@@ -304,7 +293,7 @@ are not abstract."
   "Return non-nil if a method with SPECIALIZERS applies to CLASS."
   (let ((applies nil))
     (dolist (specializer specializers)
-      (if (eq 'subclass (car-safe specializer))
+      (if (memq (car-safe specializer) '(subclass eieio--static))
           (setq specializer (nth 1 specializer)))
       ;; Don't include the methods that are "too generic", such as those
       ;; applying to `eieio-default-superclass'.
@@ -443,60 +432,6 @@ The value returned is a list of elements of the form
     (terpri)
     ))
 
-;;; HELP AUGMENTATION
-;;
-(defun eieio-help-find-method-definition (class method file)
-  (let ((filename (find-library-name file))
-	location buf)
-    (when (symbolp class)
-      (setq class (symbol-name class)))
-    (when (symbolp method)
-      (setq method (symbol-name method)))
-    (when (null filename)
-      (error "Cannot find library %s" file))
-    (setq buf (find-file-noselect filename))
-    (with-current-buffer buf
-      (goto-char (point-min))
-      (when
-	  (re-search-forward
-	   ;; Regexp for searching methods.
-	   (concat "(defmethod[ \t\r\n]+" method
-		   "\\([ \t\r\n]+:[a-zA-Z]+\\)?"
-		   "[ \t\r\n]+(\\s-*(\\(\\sw\\|\\s_\\)+\\s-+"
-		   class
-		   "\\s-*)")
-	   nil t)
-	(setq location (match-beginning 0))))
-    (if (null location)
-	(message "Unable to find location in file")
-      (pop-to-buffer buf)
-      (goto-char location)
-      (recenter)
-      (beginning-of-line))))
-
-(defun eieio-help-find-class-definition (class file)
-  (when (symbolp class)
-    (setq class (symbol-name class)))
-  (let ((filename (find-library-name file))
-	location buf)
-    (when (null filename)
-      (error "Cannot find library %s" file))
-    (setq buf (find-file-noselect filename))
-    (with-current-buffer buf
-      (goto-char (point-min))
-      (when
-	  (re-search-forward
-	   ;; Regexp for searching a class.
-	   (concat "(defclass[ \t\r\n]+" class "[ \t\r\n]+")
-	   nil t)
-	(setq location (match-beginning 0))))
-    (if (null location)
-	(message "Unable to find location in file")
-      (pop-to-buffer buf)
-      (goto-char location)
-      (recenter)
-      (beginning-of-line))))
-
 ;;; SPEEDBAR SUPPORT
 ;;
 
@@ -546,7 +481,7 @@ current expansion depth."
 
 (defun eieio-class-button (class depth)
   "Draw a speedbar button at the current point for CLASS at DEPTH."
-  (eieio--check-type class-p class)
+  (cl-check-type class class)
   (let ((subclasses (eieio--class-children (eieio--class-v class))))
     (if subclasses
 	(speedbar-make-tag-line 'angle ?+
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 91469b4b96c..526090954a9 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -110,7 +110,7 @@ Options in CLOS not supported in EIEIO:
 Due to the way class options are set up, you can add any tags you wish,
 and reference them using the function `class-option'."
   (declare (doc-string 4))
-  (eieio--check-type listp superclasses)
+  (cl-check-type superclasses list)
 
   (cond ((and (stringp (car options-and-doc))
               (/= 1 (% (length options-and-doc) 2)))
@@ -223,18 +223,9 @@ This method is obsolete."
        ;; referencing classes.  ei, a class whose slot can contain only
        ;; pointers to itself.
 
-       ;; Create the test function.
-       (defun ,testsym1 (obj)
-         ,(format "Test OBJ to see if it an object of type %S." name)
-         (and (eieio-object-p obj)
-              (same-class-p obj ',name)))
-
-       (defun ,testsym2 (obj)
-         ,(format
-           "Test OBJ to see if it an object is a child of type %S."
-           name)
-         (and (eieio-object-p obj)
-              (object-of-class-p obj ',name)))
+       ;; Create the test functions.
+       (defalias ',testsym1 (eieio-make-class-predicate ',name))
+       (defalias ',testsym2 (eieio-make-child-predicate ',name))
 
        ,@(when eieio-backward-compatibility
            (let ((f (intern (format "%s-child-p" name))))
@@ -374,7 +365,7 @@ variable name of the same name as the slot."
 (defun eieio-object-name (obj &optional extra)
   "Return a Lisp like symbol string for object OBJ.
 If EXTRA, include that in the string returned to represent the symbol."
-  (eieio--check-type eieio-object-p obj)
+  (cl-check-type obj eieio-object)
   (format "#<%s %s%s>" (eieio--object-class-name obj)
 	  (eieio-object-name-string obj) (or extra "")))
 (define-obsolete-function-alias 'object-name #'eieio-object-name "24.4")
@@ -394,7 +385,7 @@ If EXTRA, include that in the string returned to represent the symbol."
 (cl-defmethod eieio-object-set-name-string (obj name)
   "Set the string which is OBJ's NAME."
   (declare (obsolete eieio-named "25.1"))
-  (eieio--check-type stringp name)
+  (cl-check-type name string)
   (setf (gethash obj eieio--object-names) name))
 (define-obsolete-function-alias
   'object-set-name-string 'eieio-object-set-name-string "24.4")
@@ -402,7 +393,7 @@ If EXTRA, include that in the string returned to represent the symbol."
 (defun eieio-object-class (obj)
   "Return the class struct defining OBJ."
   ;; FIXME: We say we return a "struct" but we return a symbol instead!
-  (eieio--check-type eieio-object-p obj)
+  (cl-check-type obj eieio-object)
   (eieio--object-class-name obj))
 (define-obsolete-function-alias 'object-class #'eieio-object-class "24.4")
 ;; CLOS name, maybe?
@@ -410,7 +401,7 @@ If EXTRA, include that in the string returned to represent the symbol."
 
 (defun eieio-object-class-name (obj)
   "Return a Lisp like symbol name for OBJ's class."
-  (eieio--check-type eieio-object-p obj)
+  (cl-check-type obj eieio-object)
   (eieio-class-name (eieio--object-class-name obj)))
 (define-obsolete-function-alias
   'object-class-name 'eieio-object-class-name "24.4")
@@ -419,15 +410,14 @@ If EXTRA, include that in the string returned to represent the symbol."
   "Return parent classes to CLASS.  (overload of variable).
 
 The CLOS function `class-direct-superclasses' is aliased to this function."
-  (let ((c (eieio-class-object class)))
-    (eieio--class-parent c)))
+  (eieio--class-parent (eieio--class-object class)))
 
 (define-obsolete-function-alias 'class-parents #'eieio-class-parents "24.4")
 
 (defun eieio-class-children (class)
   "Return child classes to CLASS.
 The CLOS function `class-direct-subclasses' is aliased to this function."
-  (eieio--check-type class-p class)
+  (cl-check-type class class)
   (eieio--class-children (eieio--class-v class)))
 (define-obsolete-function-alias
   'class-children #'eieio-class-children "24.4")
@@ -446,13 +436,13 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
 (defun same-class-p (obj class)
   "Return t if OBJ is of class-type CLASS."
   (setq class (eieio--class-object class))
-  (eieio--check-type eieio--class-p class)
-  (eieio--check-type eieio-object-p obj)
+  (cl-check-type class eieio--class)
+  (cl-check-type obj eieio-object)
   (eq (eieio--object-class-object obj) class))
 
 (defun object-of-class-p (obj class)
   "Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses."
-  (eieio--check-type eieio-object-p obj)
+  (cl-check-type obj eieio-object)
   ;; class will be checked one layer down
   (child-of-class-p (eieio--object-class-object obj) class))
 ;; Backwards compatibility
@@ -461,13 +451,13 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
 (defun child-of-class-p (child class)
   "Return non-nil if CHILD class is a subclass of CLASS."
   (setq child (eieio--class-object child))
-  (eieio--check-type eieio--class-p child)
+  (cl-check-type child eieio--class)
   ;; `eieio-default-superclass' is never mentioned in eieio--class-parent,
   ;; so we have to special case it here.
   (or (eq class 'eieio-default-superclass)
       (let ((p nil))
         (setq class (eieio--class-object class))
-        (eieio--check-type eieio--class-p class)
+        (cl-check-type class eieio--class)
         (while (and child (not (eq child class)))
           (setq p (append p (eieio--class-parent child))
                 child (pop p)))
@@ -475,11 +465,11 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
 
 (defun object-slots (obj)
   "Return list of slots available in OBJ."
-  (eieio--check-type eieio-object-p obj)
+  (cl-check-type obj eieio-object)
   (eieio--class-public-a (eieio--object-class-object obj)))
 
 (defun eieio--class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg."
-  (eieio--check-type eieio--class-p class)
+  (cl-check-type class eieio--class)
   (let ((ia (eieio--class-initarg-tuples class))
 	(f nil))
     (while (and ia (not f))
@@ -517,7 +507,7 @@ OBJECT can be an instance or a class."
     ;; Return nil if the magic symbol is in there.
     (not (eq (cond
 	      ((eieio-object-p object) (eieio-oref object slot))
-	      ((class-p object)        (eieio-oref-default object slot))
+	      ((symbolp object)        (eieio-oref-default object slot))
 	      (t (signal 'wrong-type-argument (list 'eieio-object-p object))))
 	     eieio-unbound))))
 
@@ -529,7 +519,8 @@ OBJECT can be an instance or a class."
   "Return non-nil if OBJECT-OR-CLASS has SLOT."
   (let ((cv (cond ((eieio-object-p object-or-class)
                    (eieio--object-class-object object-or-class))
-                  (t (eieio-class-object object-or-class)))))
+                  ((eieio--class-p object-or-class) object-or-class)
+                  (t (find-class object-or-class 'error)))))
     (or (memq slot (eieio--class-public-a cv))
 	(memq slot (eieio--class-class-allocation-a cv)))
     ))
@@ -538,10 +529,10 @@ OBJECT can be an instance or a class."
   "Return the class that SYMBOL represents.
 If there is no class, nil is returned if ERRORP is nil.
 If ERRORP is non-nil, `wrong-argument-type' is signaled."
-  (if (not (class-p symbol))
-      (if errorp (signal 'wrong-type-argument (list 'class-p symbol))
-	nil)
-    (eieio--class-v symbol)))
+  (let ((class (eieio--class-v symbol)))
+    (cond
+     ((eieio--class-p class) class)
+     (errorp (signal 'wrong-type-argument (list 'class-p symbol))))))
 
 ;;; Slightly more complex utility functions for objects
 ;;
@@ -551,7 +542,7 @@ LIST is a list of objects whose slots are searched.
 Objects in LIST do not need to have a slot named SLOT, nor does
 SLOT need to be bound.  If these errors occur, those objects will
 be ignored."
-  (eieio--check-type listp list)
+  (cl-check-type list list)
   (while (and list (not (condition-case nil
 			    ;; This prevents errors for missing slots.
 			    (equal key (eieio-oref (car list) slot))
@@ -563,7 +554,7 @@ be ignored."
   "Return an association list with the contents of SLOT as the key element.
 LIST must be a list of objects with SLOT in it.
 This is useful when you need to do completing read on an object group."
-  (eieio--check-type listp list)
+  (cl-check-type list list)
   (let ((assoclist nil))
     (while list
       (setq assoclist (cons (cons (eieio-oref (car list) slot)
@@ -577,7 +568,7 @@ This is useful when you need to do completing read on an object group."
 LIST must be a list of objects, but those objects do not need to have
 SLOT in it.  If it does not, then that element is left out of the association
 list."
-  (eieio--check-type listp list)
+  (cl-check-type list list)
   (let ((assoclist nil))
     (while list
       (if (slot-exists-p (car list) slot)
@@ -869,12 +860,8 @@ this object."
 	 (object-write thing))
 	((consp thing)
 	 (eieio-list-prin1 thing))
-	((class-p thing)
+	((eieio--class-p thing)
 	 (princ (eieio-class-name thing)))
-	((or (keywordp thing) (booleanp thing))
-	 (prin1 thing))
-	((symbolp thing)
-	 (princ (concat "'" (symbol-name thing))))
 	(t (prin1 thing))))
 
 (defun eieio-list-prin1 (list)
@@ -942,7 +929,7 @@ Optional argument GROUP is the sub-group of slots to display.
 
 ;;;***
 
-;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "b849f8bf1312d5ef57e53d02173e4b5a")
+;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "ff1097f185bc2c253276a7d19fe2f54a")
 ;;; Generated autoloads from eieio-opt.el
 
 (autoload 'eieio-browse "eieio-opt" "\