* lisp/emacs-lisp/eieio*.el: Move the function defs to defclass.

* lisp/emacs-lisp/eieio.el (defclass): Move from eieio-defclass all the code
that creates functions, and most of the sanity checks.
Mark as obsolete the <class>-child-p function.
* lisp/emacs-lisp/eieio-core.el (eieio--define-field-accessors): Remove.
(eieio--class, eieio--object): Use cl-defstruct.
(eieio--object-num-slots): Define manually.
(eieio-defclass-autoload): Use eieio--class-make.
(eieio-defclass-internal): Rename from eieio-defclass.  Move all the
`(lambda...) definitions and most of the sanity checks to `defclass'.
Mark as obsolete the <class>-list-p function, the <class> variable and
the <initarg> variables.  Use pcase-dolist.
(eieio-defclass): New compatibility function.
* lisp/emacs-lisp/eieio-opt.el (eieio-build-class-alist)
(eieio-class-speedbar): Don't use eieio-default-superclass var.

4 files changed, 295 insertions, 271 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 66b3b8eb061..6d7bfae31ce 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,9 +1,27 @@
 2015-01-08  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* emacs-lisp/eieio.el (defclass): Move from eieio-defclass all the code
+	that creates functions, and most of the sanity checks.
+	Mark as obsolete the <class>-child-p function.
+	* emacs-lisp/eieio-core.el (eieio--define-field-accessors): Remove.
+	(eieio--class, eieio--object): Use cl-defstruct.
+	(eieio--object-num-slots): Define manually.
+	(eieio-defclass-autoload): Use eieio--class-make.
+	(eieio-defclass-internal): Rename from eieio-defclass.  Move all the
+	`(lambda...) definitions and most of the sanity checks to `defclass'.
+	Mark as obsolete the <class>-list-p function, the <class> variable and
+	the <initarg> variables.  Use pcase-dolist.
+	(eieio-defclass): New compatibility function.
+	* emacs-lisp/eieio-opt.el (eieio-build-class-alist)
+	(eieio-class-speedbar): Don't use eieio-default-superclass var.
+
+2015-01-08  Stefan Monnier  <monnier@iro.umontreal.ca>
+
 	* emacs-lisp/eieio-generic.el: New file.
 	* emacs-lisp/eieio-core.el: Move all generic function code to
 	eieio-generic.el.
 	(eieio--defmethod): Declare.
+
 	* emacs-lisp/eieio.el: Require eieio-generic.  Move all generic
 	function code to eieio-generic.el.
 	* emacs-lisp/eieio-opt.el (eieio-help-generic): Move to
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index fba4d8f50c7..dc2c873eb42 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -32,6 +32,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'pcase)
 
 (put 'eieio--defalias 'byte-hunk-handler
      #'byte-compile-file-form-defalias) ;;(get 'defalias 'byte-hunk-handler)
@@ -117,66 +118,70 @@ Currently under control of this var:
   `(let ((eieio--scoped-class-stack (cons ,class eieio--scoped-class-stack)))
      ,@forms))
 
-;;;
-;; Field Accessors
-;;
-(defmacro eieio--define-field-accessors (prefix fields)
-  (declare (indent 1))
-  (let ((index 0)
-        (defs '()))
-    (dolist (field fields)
-      (let ((doc (if (listp field)
-                     (prog1 (cadr field) (setq field (car field))))))
-        (push `(defmacro ,(intern (format "eieio--%s-%s" prefix field)) (x)
-                 ,@(if doc (list (format (if (string-match "\n" doc)
-                                             "Return %s" "Return %s of a %s.")
-                                         doc prefix)))
-                 (list 'aref x ,index))
-              defs)
-        (setq index (1+ index))))
-    `(eval-and-compile
-       ,@(nreverse defs)
-       (defconst ,(intern (format "eieio--%s-num-slots" prefix)) ,index))))
-
-(eieio--define-field-accessors class
-  (-unused-0 ;;Constant slot, set to `defclass'.
-   (symbol "symbol (self-referencing)")
-   parent children
-   (symbol-hashtable "hashtable permitting fast access to variable position indexes")
-   ;; @todo
-   ;; the word "public" here is leftovers from the very first version.
-   ;; Get rid of it!
-   (public-a "class attribute index")
-   (public-d "class attribute defaults index")
-   (public-doc "class documentation strings for attributes")
-   (public-type "class type for a slot")
-   (public-custom "class custom type for a slot")
-   (public-custom-label "class custom group for a slot")
-   (public-custom-group "class custom group for a slot")
-   (public-printer "printer for a slot")
-   (protection "protection for a slot")
-   (initarg-tuples "initarg tuples list")
-   (class-allocation-a "class allocated attributes")
-   (class-allocation-doc "class allocated documentation")
-   (class-allocation-type "class allocated value type")
-   (class-allocation-custom "class allocated custom descriptor")
-   (class-allocation-custom-label "class allocated custom descriptor")
-   (class-allocation-custom-group "class allocated custom group")
-   (class-allocation-printer "class allocated printer for a slot")
-   (class-allocation-protection "class allocated protection list")
-   (class-allocation-values "class allocated value vector")
-   (default-object-cache "what a newly created object would look like.
-This will speed up instantiation time as only a `copy-sequence' will
-be needed, instead of looping over all the values and setting them
-from the default.")
-   (options "storage location of tagged class options.
-Stored outright without modifications or stripping.")))
-
-(eieio--define-field-accessors object
+(progn
+  ;; Arrange for field access not to bother checking if the access is indeed
+  ;; made to an eieio--class object.
+  (cl-declaim (optimize (safety 0)))
+(cl-defstruct (eieio--class
+               (:constructor nil)
+               (:constructor eieio--class-make (symbol &aux (tag 'defclass)))
+               (:type vector)
+               (:copier nil))
+  ;; We use an untagged cl-struct, with our own hand-made tag as first field
+  ;; (containing the symbol `defclass').  It would be better to use a normal
+  ;; cl-struct with its normal tag (e.g. so that cl-defstruct can define the
+  ;; predicate for us), but that breaks compatibility with .elc files compiled
+  ;; against older versions of EIEIO.
+  tag
+  symbol ;; symbol (self-referencing)
+  parent children
+  symbol-hashtable ;; hashtable permitting fast access to variable position indexes
+  ;; @todo
+  ;; the word "public" here is leftovers from the very first version.
+  ;; Get rid of it!
+  public-a                        ;; class attribute index
+  public-d                        ;; class attribute defaults index
+  public-doc                      ;; class documentation strings for attributes
+  public-type                     ;; class type for a slot
+  public-custom                   ;; class custom type for a slot
+  public-custom-label             ;; class custom group for a slot
+  public-custom-group             ;; class custom group for a slot
+  public-printer                  ;; printer for a slot
+  protection                      ;; protection for a slot
+  initarg-tuples                  ;; initarg tuples list
+  class-allocation-a              ;; class allocated attributes
+  class-allocation-doc            ;; class allocated documentation
+  class-allocation-type           ;; class allocated value type
+  class-allocation-custom         ;; class allocated custom descriptor
+  class-allocation-custom-label   ;; class allocated custom descriptor
+  class-allocation-custom-group   ;; class allocated custom group
+  class-allocation-printer        ;; class allocated printer for a slot
+  class-allocation-protection     ;; class allocated protection list
+  class-allocation-values         ;; class allocated value vector
+  default-object-cache ;; what a newly created object would look like.
+                       ; This will speed up instantiation time as
+                       ; only a `copy-sequence' will be needed, instead of
+                       ; looping over all the values and setting them from
+                       ; the default.
+  options ;; storage location of tagged class option
+          ; Stored outright without modifications or stripping
+  )
+  ;; Set it back to the default value.
+  (cl-declaim (optimize (safety 1))))
+
+
+(cl-defstruct (eieio--object
+               (:type vector)           ;We manage our own tagging system.
+               (:constructor nil)
+               (:copier nil))
   ;; `class-tag' holds a symbol, which is not the class name, but is instead
   ;; properly prefixed as an internal EIEIO thingy and which holds the class
   ;; object/struct in its `symbol-value' slot.
-  ((class-tag "tag containing the class struct")))
+  class-tag)
+
+(eval-and-compile
+  (defconst eieio--object-num-slots
+    (length (get 'eieio--object 'cl-struct-slots))))
 
 (defsubst eieio--object-class-object (obj)
   (symbol-value (eieio--object-class-tag obj)))
@@ -297,15 +302,11 @@ It creates an autoload function for CNAME's constructor."
   ;; Assume we've already debugged inputs.
 
   (let* ((oldc (when (class-p cname) (eieio--class-v cname)))
-	 (newc (make-vector eieio--class-num-slots nil))
+	 (newc (eieio--class-make cname))
 	 )
     (if oldc
 	nil ;; Do nothing if we already have this class.
 
-      ;; Create the class in NEWC, but don't fill anything else in.
-      (aset newc 0 'defclass)
-      (setf (eieio--class-symbol newc) cname)
-
       (let ((clear-parent nil))
 	;; No parents?
 	(when (not superclasses)
@@ -333,7 +334,8 @@ It creates an autoload function for CNAME's constructor."
 
 	;; turn this into a usable self-pointing symbol
         (when eieio-backward-compatibility
-          (set cname cname))
+          (set cname cname)
+          (make-obsolete-variable cname (format "use '%s instead" cname) "25.1"))
 
 	;; Store the new class vector definition into the symbol.  We need to
 	;; do this first so that we can call defmethod for the accessor.
@@ -364,11 +366,10 @@ It creates an autoload function for CNAME's constructor."
 
 (declare-function eieio--defmethod "eieio-generic" (method kind argclass code))
 
-(defun eieio-defclass (cname superclasses slots options-and-doc)
-  ;; FIXME: Most of this should be moved to the `defclass' macro.
+(defun eieio-defclass-internal (cname superclasses slots options)
   "Define CNAME as a new subclass of SUPERCLASSES.
-SLOTS are the slots residing in that class definition, and options or
-documentation OPTIONS-AND-DOC is the toplevel documentation for this class.
+SLOTS are the slots residing in that class definition, and OPTIONS
+holds the class options.
 See `defclass' for more information."
   ;; Run our eieio-hook each time, and clear it when we are done.
   ;; This way people can add hooks safely if they want to modify eieio
@@ -376,18 +377,12 @@ See `defclass' for more information."
   (run-hooks 'eieio-hook)
   (setq eieio-hook nil)
 
-  (eieio--check-type listp superclasses)
-
   (let* ((pname superclasses)
-	 (newc (make-vector eieio--class-num-slots nil))
+	 (newc (eieio--class-make cname))
 	 (oldc (when (class-p cname) (eieio--class-v cname)))
 	 (groups nil) ;; list of groups id'd from slots
-	 (options nil)
 	 (clearparent nil))
 
-    (aset newc 0 'defclass)
-    (setf (eieio--class-symbol newc) cname)
-
     ;; If this class already existed, and we are updating its structure,
     ;; make sure we keep the old child list.  This can cause bugs, but
     ;; if no new slots are created, it also saves time, and prevents
@@ -403,19 +398,6 @@ See `defclass' for more information."
           (setf (eieio--class-children newc) children)
 	  (remhash cname eieio-defclass-autoload-map))))
 
-    (cond ((and (stringp (car options-and-doc))
-		(/= 1 (% (length options-and-doc) 2)))
-	   (error "Too many arguments to `defclass'"))
-	  ((and (symbolp (car options-and-doc))
-		(/= 0 (% (length options-and-doc) 2)))
-	   (error "Too many arguments to `defclass'"))
-	  )
-
-    (setq options
-	  (if (stringp (car options-and-doc))
-	      (cons :documentation options-and-doc)
-	    options-and-doc))
-
     (if pname
 	(progn
 	  (dolist (p pname)
@@ -447,52 +429,13 @@ See `defclass' for more information."
 
     ;; turn this into a usable self-pointing symbol;  FIXME: Why?
     (when eieio-backward-compatibility
-      (set cname cname))
-
-    ;; These two tests must be created right away so we can have self-
-    ;; referencing classes.  ei, a class whose slot can contain only
-    ;; pointers to itself.
-
-    ;; Create the test function
-    (let ((csym (intern (concat (symbol-name cname) "-p"))))
-      (fset csym
-	    `(lambda (obj)
-               ,(format "Test OBJ to see if it an object of type %s" cname)
-               (and (eieio-object-p obj)
-                    (same-class-p obj ',cname)))))
-
-    ;; Make sure the method invocation order  is a valid value.
-    (let ((io (eieio--class-option-assoc options :method-invocation-order)))
-      (when (and io (not (member io '(:depth-first :breadth-first :c3))))
-	(error "Method invocation order %s is not allowed" io)
-	))
-
-    ;; Create a handy child test too
-    (let ((csym (if eieio-backward-compatibility
-                    (intern (concat (symbol-name cname) "-child-p"))
-                  (make-symbol (concat (symbol-name cname) "-child-p")))))
-      (fset csym
-	    `(lambda (obj)
-	       ,(format
-                 "Test OBJ to see if it an object is a child of type %s"
-                 cname)
-	       (and (eieio-object-p obj)
-		    (object-of-class-p obj ',cname))))
-
-      ;; When using typep, (typep OBJ 'myclass) returns t for objects which
-      ;; are subclasses of myclass.  For our predicates, however, it is
-      ;; important for EIEIO to be backwards compatible, where
-      ;; myobject-p, and myobject-child-p are different.
-      ;; "cl" uses this technique to specify symbols with specific typep
-      ;; test, so we can let typep have the CLOS documented behavior
-      ;; while keeping our above predicate clean.
-
-      (put cname 'cl-deftype-satisfies csym))
+      (set cname cname)
+      (make-obsolete-variable cname (format "use '%s instead" cname) "25.1"))
 
     ;; Create a handy list of the class test too
     (when eieio-backward-compatibility
       (let ((csym (intern (concat (symbol-name cname) "-list-p"))))
-        (fset csym
+        (defalias csym
               `(lambda (obj)
                  ,(format
                    "Test OBJ to see if it a list of objects which are a child of type %s"
@@ -505,7 +448,10 @@ See `defclass' for more information."
                        (setq ans (and (eieio-object-p (car obj))
                                       (object-of-class-p (car obj) ,cname)))
                        (setq obj (cdr obj)))
-                     ans))))))
+                     ans))))
+        (make-obsolete csym (format "use (cl-typep ... '(list-of %s)) instead"
+                                    cname)
+                       "25.1")))
 
     ;; Before adding new slots, let's add all the methods and classes
     ;; in from the parent class.
@@ -519,19 +465,13 @@ See `defclass' for more information."
 
     ;; Query each slot in the declaration list and mangle into the
     ;; class structure I have defined.
-    (while slots
-      (let* ((slot1  (car slots))
-	     (name    (car slot1))
-	     (slot   (cdr slot1))
-	     (acces   (plist-get slot :accessor))
-	     (init    (or (plist-get slot :initform)
+    (pcase-dolist (`(,name . ,slot) slots)
+      (let* ((init    (or (plist-get slot :initform)
 			  (if (member :initform slot) nil
 			    eieio-unbound)))
 	     (initarg (plist-get slot :initarg))
 	     (docstr  (plist-get slot :documentation))
 	     (prot    (plist-get slot :protection))
-	     (reader  (plist-get slot :reader))
-	     (writer  (plist-get slot :writer))
 	     (alloc   (plist-get slot :allocation))
 	     (type    (plist-get slot :type))
 	     (custom  (plist-get slot :custom))
@@ -542,51 +482,24 @@ See `defclass' for more information."
 	     (skip-nil (eieio--class-option-assoc options :allow-nil-initform))
 	     )
 
-	(if eieio-error-unsupported-class-tags
-	    (let ((tmp slot))
-	      (while tmp
-		(if (not (member (car tmp) '(:accessor
-					     :initform
-					     :initarg
-					     :documentation
-					     :protection
-					     :reader
-					     :writer
-					     :allocation
-					     :type
-					     :custom
-					     :label
-					     :group
-					     :printer
-					     :allow-nil-initform
-					     :custom-groups)))
-		    (signal 'invalid-slot-type (list (car tmp))))
-		(setq tmp (cdr (cdr tmp))))))
-
 	;; Clean up the meaning of protection.
-	(cond ((or (eq prot 'public) (eq prot :public)) (setq prot nil))
-	      ((or (eq prot 'protected) (eq prot :protected)) (setq prot 'protected))
-	      ((or (eq prot 'private) (eq prot :private)) (setq prot 'private))
-	      ((eq prot nil) nil)
-	      (t (signal 'invalid-slot-type (list :protection prot))))
-
-	;; Make sure the :allocation parameter has a valid value.
-	(if (not (or (not alloc) (eq alloc :class) (eq alloc :instance)))
-	    (signal 'invalid-slot-type (list :allocation alloc)))
+        (setq prot
+              (pcase prot
+                ((or 'nil 'public ':public) nil)
+                ((or 'protected ':protected) 'protected)
+                ((or 'private ':private) 'private)
+                (_ (signal 'invalid-slot-type (list :protection prot)))))
 
 	;; The default type specifier is supposed to be t, meaning anything.
 	(if (not type) (setq type t))
 
-	;; Label is nil, or a string
-	(if (not (or (null label) (stringp label)))
-	    (signal 'invalid-slot-type (list :label label)))
-
-	;; Is there an initarg, but allocation of class?
-	(if (and initarg (eq alloc :class))
-	    (message "Class allocated slots do not need :initarg"))
-
 	;; intern the symbol so we can use it blankly
-	(if initarg (set initarg initarg))
+        (if eieio-backward-compatibility
+            (and initarg (not (keywordp initarg))
+                 (progn
+                   (set initarg initarg)
+                   (make-obsolete-variable
+                    initarg (format "use '%s instead" initarg) "25.1"))))
 
 	;; The customgroup should be a list of symbols
 	(cond ((null customg)
@@ -604,63 +517,9 @@ See `defclass' for more information."
 			     prot initarg alloc 'defaultoverride skip-nil)
 
 	;; We need to id the group, and store them in a group list attribute.
-	(mapc (lambda (cg) (cl-pushnew cg groups :test 'equal)) customg)
-
-	;; Anyone can have an accessor function.  This creates a function
-	;; of the specified name, and also performs a `defsetf' if applicable
-	;; so that users can `setf' the space returned by this function.
-	(if acces
-	    (progn
-	      (eieio--defmethod
-               acces (if (eq alloc :class) :static :primary) cname
-               `(lambda (this)
-                  ,(format
-		       "Retrieves the slot `%s' from an object of class `%s'"
-		       name cname)
-                  (if (slot-boundp this ',name)
-                      ;; Use oref-default for :class allocated slots, since
-                      ;; these also accept the use of a class argument instead
-                      ;; of an object argument.
-                      (,(if (eq alloc :class) 'eieio-oref-default 'eieio-oref)
-                       this ',name)
-                    ;; Else - Some error?  nil?
-                    nil)))
-
-              ;; FIXME: We should move more of eieio-defclass into the
-              ;; defclass macro so we don't have to use `eval' and require
-              ;; `gv' at run-time.
-              ;; FIXME: The defmethod above only defines a part of the generic
-              ;; function, but the define-setter below affects the whole
-              ;; generic function!
-              (eval `(gv-define-setter ,acces (eieio--store eieio--object)
-                       ;; Apparently, eieio-oset-default doesn't work like
-                       ;;  oref-default and only accept class arguments!
-                       (list ',(if nil ;; (eq alloc :class)
-                                   'eieio-oset-default
-                                 'eieio-oset)
-                             eieio--object '',name
-                             eieio--store)))))
-
-	;; If a writer is defined, then create a generic method of that
-	;; name whose purpose is to set the value of the slot.
-	(if writer
-            (eieio--defmethod
-             writer nil cname
-             `(lambda (this value)
-                ,(format "Set the slot `%s' of an object of class `%s'"
-			      name cname)
-                (setf (slot-value this ',name) value))))
-	;; If a reader is defined, then create a generic method
-	;; of that name whose purpose is to access this slot value.
-	(if reader
-            (eieio--defmethod
-             reader nil cname
-             `(lambda (this)
-                ,(format "Access the slot `%s' from object of class `%s'"
-			      name cname)
-                (slot-value this ',name))))
-	)
-      (setq slots (cdr slots)))
+	(dolist (cg customg)
+          (cl-pushnew cg groups :test 'equal))
+	))
 
     ;; Now that everything has been loaded up, all our lists are backwards!
     ;; Fix that up now.
@@ -700,30 +559,6 @@ See `defclass' for more information."
 	      prots (cdr prots)))
       (setf (eieio--class-symbol-hashtable newc) oa))
 
-    ;; Create the constructor function
-    (if (eieio--class-option-assoc options :abstract)
-	;; Abstract classes cannot be instantiated.  Say so.
-	(let ((abs (eieio--class-option-assoc options :abstract)))
-	  (if (not (stringp abs))
-	      (setq abs (format "Class %s is abstract" cname)))
-	  (fset cname
-		`(lambda (&rest stuff)
-		   ,(format "You cannot create a new object of type %s" cname)
-		   (error ,abs))))
-
-      ;; Non-abstract classes need a constructor.
-      (fset cname
-	    `(lambda (&rest slots)
-	       ,(format "Create a new object with name NAME of class type %s" cname)
-               (if (and slots
-                        (let ((x (car slots)))
-                          (or (stringp x) (null x))))
-                   (funcall (if eieio-backward-compatibility #'ignore #'message)
-                            "Obsolete name %S passed to %S constructor"
-                            (pop slots) ',cname))
-	       (apply #'eieio-constructor ',cname slots)))
-      )
-
     ;; Set up a specialized doc string.
     ;; Use stored value since it is calculated in a non-trivial way
     (put cname 'variable-documentation
@@ -1468,6 +1303,13 @@ method invocation orders of the involved classes."
 (define-error 'unbound-slot "Unbound slot")
 (define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy")
 
+;;; Backward compatibility functions
+;; To support .elc files compiled for older versions of EIEIO.
+
+(defun eieio-defclass (cname superclasses slots options)
+  (eval `(defclass ,cname ,superclasses ,slots ,options)))
+
+
 (provide 'eieio-core)
 
 ;;; eieio-core.el ends here
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 60bbd503adf..13ad120a9b5 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -230,7 +230,7 @@ Optional argument CLASS is the class to start with.
 If INSTANTIABLE-ONLY is non nil, only allow names of classes which
 are not abstract, otherwise allow all classes.
 Optional argument BUILDLIST is more list to attach and is used internally."
-  (let* ((cc (or class eieio-default-superclass))
+  (let* ((cc (or class 'eieio-default-superclass))
 	 (sublst (eieio--class-children (eieio--class-v cc))))
     (unless (assoc (symbol-name cc) buildlist)
       (when (or (not instantiable-only) (not (class-abstract-p cc)))
@@ -561,7 +561,7 @@ current expansion depth."
   (when (eq (point-min) (point-max))
     ;; This function is only called once, to start the whole deal.
     ;; Create and expand the default object.
-    (eieio-class-button eieio-default-superclass 0)
+    (eieio-class-button 'eieio-default-superclass 0)
     (forward-line -1)
     (speedbar-expand-line)))
 
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index bf51986b133..205f13108b8 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -58,13 +58,11 @@
 
 ;;; Defining a new class
 ;;
-(defmacro defclass (name superclass slots &rest options-and-doc)
+(defmacro defclass (name superclasses slots &rest options-and-doc)
   "Define NAME as a new class derived from SUPERCLASS with SLOTS.
 OPTIONS-AND-DOC is used as the class' options and base documentation.
-SUPERCLASS is a list of superclasses to inherit from, with SLOTS
-being the slots residing in that class definition.  NOTE: Currently
-only one slot may exist in SUPERCLASS as multiple inheritance is not
-yet supported.  Supported tags are:
+SUPERCLASSES is a list of superclasses to inherit from, with SLOTS
+being the slots residing in that class definition.  Supported tags are:
 
   :initform   - Initializing form.
   :initarg    - Tag used during initialization.
@@ -115,12 +113,178 @@ 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))
-  ;; This is eval-and-compile only to silence spurious compiler warnings
-  ;; about functions and variables not known to be defined.
-  ;; When eieio-defclass code is merged here and this becomes
-  ;; transparent to the compiler, the eval-and-compile can be removed.
-  `(eval-and-compile
-     (eieio-defclass ',name ',superclass ',slots ',options-and-doc)))
+  (eieio--check-type listp superclasses)
+
+  (cond ((and (stringp (car options-and-doc))
+              (/= 1 (% (length options-and-doc) 2)))
+         (error "Too many arguments to `defclass'"))
+        ((and (symbolp (car options-and-doc))
+              (/= 0 (% (length options-and-doc) 2)))
+         (error "Too many arguments to `defclass'")))
+
+  (if (stringp (car options-and-doc))
+      (setq options-and-doc
+            (cons :documentation options-and-doc)))
+
+  ;; Make sure the method invocation order is a valid value.
+  (let ((io (eieio--class-option-assoc options-and-doc
+                                       :method-invocation-order)))
+    (when (and io (not (member io '(:depth-first :breadth-first :c3))))
+      (error "Method invocation order %s is not allowed" io)))
+
+  (let ((testsym1 (intern (concat (symbol-name name) "-p")))
+        (testsym2 (intern (format "eieio--childp--%s" name)))
+        (accessors ()))
+
+    ;; Collect the accessors we need to define.
+    (pcase-dolist (`(,sname . ,soptions) slots)
+      (let* ((acces   (plist-get soptions :accessor))
+	     (initarg (plist-get soptions :initarg))
+	     (reader  (plist-get soptions :reader))
+	     (writer  (plist-get soptions :writer))
+	     (alloc   (plist-get soptions :allocation))
+	     (label   (plist-get soptions :label)))
+
+	(if eieio-error-unsupported-class-tags
+	    (let ((tmp soptions))
+	      (while tmp
+		(if (not (member (car tmp) '(:accessor
+					     :initform
+					     :initarg
+					     :documentation
+					     :protection
+					     :reader
+					     :writer
+					     :allocation
+					     :type
+					     :custom
+					     :label
+					     :group
+					     :printer
+					     :allow-nil-initform
+					     :custom-groups)))
+		    (signal 'invalid-slot-type (list (car tmp))))
+		(setq tmp (cdr (cdr tmp))))))
+
+	;; Make sure the :allocation parameter has a valid value.
+	(if (not (memq alloc '(nil :class :instance)))
+	    (signal 'invalid-slot-type (list :allocation alloc)))
+
+	;; Label is nil, or a string
+	(if (not (or (null label) (stringp label)))
+	    (signal 'invalid-slot-type (list :label label)))
+
+	;; Is there an initarg, but allocation of class?
+	(if (and initarg (eq alloc :class))
+	    (message "Class allocated slots do not need :initarg"))
+
+	;; Anyone can have an accessor function.  This creates a function
+	;; of the specified name, and also performs a `defsetf' if applicable
+	;; so that users can `setf' the space returned by this function.
+	(when acces
+          ;; FIXME: The defmethod below only defines a part of the generic
+          ;; function (good), but the define-setter below affects the whole
+          ;; generic function (bad)!
+          (push `(gv-define-setter ,acces (store object)
+                   ;; Apparently, eieio-oset-default doesn't work like
+                   ;;  oref-default and only accept class arguments!
+                   (list ',(if nil ;; (eq alloc :class)
+                               'eieio-oset-default
+                             'eieio-oset)
+                         object '',sname store))
+                accessors)
+          (push `(defmethod ,acces ,(if (eq alloc :class) :static :primary)
+                   ((this ,name))
+                   ,(format
+                     "Retrieve the slot `%S' from an object of class `%S'."
+                     sname name)
+                   (if (slot-boundp this ',sname)
+                       ;; Use oref-default for :class allocated slots, since
+                       ;; these also accept the use of a class argument instead
+                       ;; of an object argument.
+                       (,(if (eq alloc :class) 'eieio-oref-default 'eieio-oref)
+                        this ',sname)
+                     ;; Else - Some error?  nil?
+                     nil))
+                accessors))
+
+	;; If a writer is defined, then create a generic method of that
+	;; name whose purpose is to set the value of the slot.
+	(if writer
+            (push `(defmethod ,writer ((this ,name) value)
+                     ,(format "Set the slot `%S' of an object of class `%S'."
+                              sname name)
+                     (setf (slot-value this ',sname) value))
+                  accessors))
+	;; If a reader is defined, then create a generic method
+	;; of that name whose purpose is to access this slot value.
+	(if reader
+            (push `(defmethod ,reader ((this ,name))
+                     ,(format "Access the slot `%S' from object of class `%S'."
+                              sname name)
+                     (slot-value this ',sname))
+                  accessors))
+	))
+
+    `(progn
+       ;; This test must be created right away so we can have self-
+       ;; 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)))
+
+       ,@(when eieio-backward-compatibility
+           (let ((f (intern (format "%s-child-p" name))))
+             `((defalias ',f ',testsym2)
+               (make-obsolete
+                ',f ,(format "use (cl-typep ... '%s) instead" name) "25.1"))))
+
+       ;; When using typep, (typep OBJ 'myclass) returns t for objects which
+       ;; are subclasses of myclass.  For our predicates, however, it is
+       ;; important for EIEIO to be backwards compatible, where
+       ;; myobject-p, and myobject-child-p are different.
+       ;; "cl" uses this technique to specify symbols with specific typep
+       ;; test, so we can let typep have the CLOS documented behavior
+       ;; while keeping our above predicate clean.
+
+       (put ',name 'cl-deftype-satisfies #',testsym2)
+
+       (eieio-defclass-internal ',name ',superclasses ',slots ',options-and-doc)
+
+       ,@accessors
+
+       ;; Create the constructor function
+       ,(if (eieio--class-option-assoc options-and-doc :abstract)
+            ;; Abstract classes cannot be instantiated.  Say so.
+            (let ((abs (eieio--class-option-assoc options-and-doc :abstract)))
+              (if (not (stringp abs))
+                  (setq abs (format "Class %s is abstract" name)))
+              `(defun ,name (&rest _)
+                 ,(format "You cannot create a new object of type %S." name)
+                 (error ,abs)))
+
+          ;; Non-abstract classes need a constructor.
+          `(defun ,name (&rest slots)
+             ,(format "Create a new object with name NAME of class type %S."
+                      name)
+             (if (and slots
+                      (let ((x (car slots)))
+                        (or (stringp x) (null x))))
+                 (funcall (if eieio-backward-compatibility #'ignore #'message)
+                          "Obsolete name %S passed to %S constructor"
+                          (pop slots) ',name))
+             (apply #'eieio-constructor ',name slots))))))
 
 
 ;;; CLOS style implementation of object creators.