From 1e88e89002ebac9ad9e5ded5777bb25b63bca8b7 Mon Sep 17 00:00:00 2001
From: gerd <gerd>
Date: Wed, 26 Mar 2003 17:15:22 +0000
Subject: [PATCH] 	* pcl/boot.lisp (parse-defmethod): Rewritten for
 clarity.  Signal 	an error for most cases of null qualifiers.

	Improve DESCRIBE on generic functions.

	* pcl/env.lisp (method-specialized-lambda-list): New function.
	(describe-object): Use it, and use generic-function-lambda-list.

	* pcl/methods.lisp (generic-function-pretty-arglist)
	(method-pretty-arglist): Remove.

	* pcl/generic-functions.lisp (generic-function-pretty-arglist)
	(method-pretty-arglist): Remove.


	AMOP compliance fixes: Reintroduce class METAOBJECT, make
	GENERIC-FUNCTION a subclass of STANDARD-OBJECT, remove STD-OBJECT.
	This basically reverts a change of dtc from 1998.

	* code/describe.lisp (describe-instance): Check for
	standard-object, not pcl::std-object.

	* pcl/pkg.lisp ("PCL", "CLOS-MOP"): Export more stuff.

	* pcl/generic-functions.lisp: Remove some of the useless comments.

	* pcl/slots.lisp (slot-value-using-class, setf slot-value-using-class)
	(slot-boundp-using-class, slot-makunbound-using-class): Specialize
	on standard-object.

	* pcl/slots-boot.lisp (get-optimized-std-accessor-method-function):
	Remove an std-class-p case.

	* pcl/methods.lisp (update-std-or-str-methods): Use
	standard-object instead of std-object.
	(mec-all-classes-internal): Use *the-class-standard-object*
	instead of *the-class-std-object*.
	(class-test): Don't consider *the-class-std-object*.

	* pcl/low.lisp (pcl-instance-p) [deftransform]: Use
	standard-object instead of std-object.

	* pcl/init.lisp (update-instance-for-different-class)
	(update-instance-for-redefined-class): Specialize on
	standard-object instead of std-object.

	* pcl/dfun.lisp (accessor-values-internal, make-accessor-table)
	(make-accessor-table): Use *the-class-standard-object* instead of
	*the-class-std-object*.

	* pcl/defs.lisp (toplevel): Don't declare *the-class-std-object*
	special.
	(standard-object): Single superclass slot-object.
	(metaobject): New class.
	(std-object): Class removed.
	(specializer): Superclass metaobject.
	(definition-source-mixin, plist-mixin): Superclass
	standard-object, no metaclass.
	(documentation-mixin, dependent-update-mixin): No metaclass.
	(slot-definition, method, generic-function, method-combination):
	Superclass metaobject.

	* pcl/cache.lisp (raise-metatype): Don't consider std-class.

	* pcl/braid.lisp (bootstrap-meta-braid): Don't braid std-class.
	(bootstrap-initialize-class): Don't consider std-class.
---
 code/describe.lisp         |  4 +--
 pcl/boot.lisp              | 25 ++++++++------
 pcl/braid.lisp             | 12 +++----
 pcl/cache.lisp             |  4 +--
 pcl/defs.lisp              | 39 +++++++++------------
 pcl/dfun.lisp              |  9 ++---
 pcl/env.lisp               | 15 ++++++---
 pcl/generic-functions.lisp | 18 +---------
 pcl/init.lisp              | 18 +++++-----
 pcl/low.lisp               | 21 ++++++------
 pcl/methods.lisp           | 69 ++------------------------------------
 pcl/pkg.lisp               |  9 +++--
 pcl/slots-boot.lisp        |  8 +----
 pcl/slots.lisp             | 10 +++---
 14 files changed, 86 insertions(+), 175 deletions(-)

diff --git a/code/describe.lisp b/code/describe.lisp
index f045c72bd..b2970c569 100644
--- a/code/describe.lisp
+++ b/code/describe.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/describe.lisp,v 1.41 2003/03/22 16:15:22 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/describe.lisp,v 1.42 2003/03/26 17:15:22 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -137,7 +137,7 @@
   (format t "~&~S is a ~S." x (type-of x)))
 
 (defun describe-instance (x &optional (kind :structure))
-  (cond ((let ((so-class (kernel::find-class 'pcl::std-object nil)))
+  (cond ((let ((so-class (kernel::find-class 'standard-object nil)))
 	   (and so-class (typep x so-class)))
 	 (fresh-line *standard-output*)
 	 (describe-object x *standard-output*))
diff --git a/pcl/boot.lisp b/pcl/boot.lisp
index 2d3f8b589..f2fe7f1e3 100644
--- a/pcl/boot.lisp
+++ b/pcl/boot.lisp
@@ -25,7 +25,7 @@
 ;;; *************************************************************************
 
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.48 2003/03/22 16:15:18 gerd Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.49 2003/03/26 17:15:22 gerd Exp $")
 
 (in-package :pcl)
 
@@ -2052,16 +2052,19 @@ work during bootstrapping.
 ;;; the 'real' arguments.  This is where the syntax of defmethod is really
 ;;; implemented.
 ;;; 
-(defun parse-defmethod (cdr-of-form)
-  (declare (list cdr-of-form))
-  (let ((name (pop cdr-of-form))
-	(qualifiers ())
-	(spec-ll ()))
-    (loop (if (and (car cdr-of-form) (atom (car cdr-of-form)))
-	      (push (pop cdr-of-form) qualifiers)
-	      (return (setq qualifiers (nreverse qualifiers)))))
-    (setq spec-ll (pop cdr-of-form))
-    (values name qualifiers spec-ll cdr-of-form)))
+(defun parse-defmethod (form)
+  (declare (list form))
+  (loop with original-form = form and name = (pop form)
+	while (and (car form) (atom (car form)))
+	  collect (pop form) into qualifiers
+	finally
+	  (let ((lambda-list (pop form)))
+	    (when (and (null lambda-list)
+		       (consp (car form))
+		       (consp (caar form)))
+	      (error "~@<Qualifiers must be non-null atoms: ~s~@:>"
+		     original-form))
+	    (return (values name qualifiers lambda-list form)))))
 
 (defun parse-specializers (specializers)
   (declare (list specializers))
diff --git a/pcl/braid.lisp b/pcl/braid.lisp
index d3e72692f..c071710c9 100644
--- a/pcl/braid.lisp
+++ b/pcl/braid.lisp
@@ -25,7 +25,7 @@
 ;;; *************************************************************************
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.29 2003/03/22 16:15:18 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.30 2003/03/26 17:15:22 gerd Exp $")
 
 ;;;
 ;;; Bootstrapping the meta-braid.
@@ -119,7 +119,6 @@
 
 (defun bootstrap-meta-braid ()
   (let* ((*create-classes-from-internal-structure-definitions-p* nil)
-	 std-class-wrapper std-class
 	 standard-class-wrapper standard-class
 	 funcallable-standard-class-wrapper funcallable-standard-class
 	 slot-class-wrapper slot-class
@@ -131,7 +130,7 @@
 	 standard-generic-function-wrapper standard-generic-function)
     (initial-classes-and-wrappers 
      standard-class funcallable-standard-class
-     slot-class built-in-class structure-class std-class
+     slot-class built-in-class structure-class
      standard-direct-slot-definition standard-effective-slot-definition 
      class-eq-specializer standard-generic-function)
     ;;
@@ -144,7 +143,6 @@
 	     (meta (ecd-metaclass definition))
 	     (wrapper (ecase meta
 			(slot-class slot-class-wrapper)
-			(std-class std-class-wrapper)
 			(standard-class standard-class-wrapper)
 			(funcallable-standard-class funcallable-standard-class-wrapper)
 			(built-in-class built-in-class-wrapper)
@@ -172,8 +170,6 @@
 	    (let* ((class (find-class name))
 		   (wrapper (cond ((eq class slot-class)
 				   slot-class-wrapper)
-				  ((eq class std-class) 
-				   std-class-wrapper)
 				  ((eq class standard-class) 
 				   standard-class-wrapper)
 				  ((eq class funcallable-standard-class) 
@@ -221,7 +217,7 @@
 		     standard-effective-slot-definition-wrapper t))
 	      
 	      (case meta
-		((std-class standard-class funcallable-standard-class)
+		((standard-class funcallable-standard-class)
 		 (bootstrap-initialize-class 
 		  meta
 		  class name class-eq-specializer-wrapper source
@@ -293,7 +289,7 @@
 		,@(and default-initargs
 		       `(default-initargs ,default-initargs))))
     (when (memq metaclass-name '(standard-class funcallable-standard-class
-				 structure-class slot-class std-class))
+				 structure-class slot-class))
       (set-slot 'direct-slots direct-slots)
       (set-slot 'slots slots)
       (set-slot 'initialize-info nil))
diff --git a/pcl/cache.lisp b/pcl/cache.lisp
index 5bbb63c01..2c6bd8d2b 100644
--- a/pcl/cache.lisp
+++ b/pcl/cache.lisp
@@ -25,7 +25,7 @@
 ;;; *************************************************************************
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cache.lisp,v 1.24 2003/03/22 16:15:18 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cache.lisp,v 1.25 2003/03/26 17:15:22 gerd Exp $")
 
 ;;;
 ;;; The basics of the PCL wrapper cache mechanism.
@@ -630,7 +630,6 @@
 ;;;  
 (defun raise-metatype (metatype new-specializer)
   (let ((slot      (find-class 'slot-class))
-	(std       (find-class 'std-class))
 	(standard  (find-class 'standard-class))
 	(fsc       (find-class 'funcallable-standard-class))
 	(structure (find-class 'structure-class))
@@ -642,7 +641,6 @@
 			 (class-of (specializer-class x))
 			 (class-of x))))
 	       (cond ((eq x *the-class-t*) t)
-		     ((*subtypep meta-specializer std)  'standard-instance)
 		     ((*subtypep meta-specializer standard)  'standard-instance)
 		     ((*subtypep meta-specializer fsc)       'standard-instance)
 		     ((*subtypep meta-specializer condition) 'condition-instance)
diff --git a/pcl/defs.lisp b/pcl/defs.lisp
index 6d4fa0c84..da1f135b1 100644
--- a/pcl/defs.lisp
+++ b/pcl/defs.lisp
@@ -88,15 +88,14 @@
 
 		  *the-class-slot-object*
 		  *the-class-structure-object*
-		  *the-class-std-object*
 		  *the-class-standard-object*
 		  *the-class-funcallable-standard-object*
 		  *the-class-class*
 		  *the-class-generic-function*
 		  *the-class-built-in-class*
 		  *the-class-slot-class*
-		  *the-class-structure-class*
 		  *the-class-std-class*
+		  *the-class-structure-class*
 		  *the-class-standard-class*
 		  *the-class-funcallable-standard-class*
 		  *the-class-method*
@@ -421,42 +420,33 @@
 (defstruct (dead-beef-structure-object
 	     (:constructor |STRUCTURE-OBJECT class constructor|)))
 
+(defclass standard-object (slot-object) ())
+(defclass metaobject (standard-object) ())
 
-(defclass std-object (slot-object) ()
-  (:metaclass std-class))
-
-(defclass standard-object (std-object kernel:instance) ())
-
-(defclass funcallable-standard-object (std-object
+(defclass funcallable-standard-object (standard-object
 				       kernel:funcallable-instance)
   ()
   (:metaclass funcallable-standard-class))
 
-(defclass specializer (standard-object) 
+(defclass specializer (metaobject) 
   ((type
     :initform nil
     :reader specializer-type)))
 
-(defclass definition-source-mixin (std-object)
+(defclass definition-source-mixin (standard-object)
   ((source
     :initform *load-pathname*
     :reader definition-source
-    :initarg :definition-source))
-  (:metaclass std-class))
+    :initarg :definition-source)))
 
-(defclass plist-mixin (std-object)
+(defclass plist-mixin (standard-object)
   ((plist
     :initform ()
-    :accessor object-plist))
-  (:metaclass std-class))
+    :accessor object-plist)))
 
-(defclass documentation-mixin (plist-mixin)
-  ()
-  (:metaclass std-class))
+(defclass documentation-mixin (plist-mixin) ())
 
-(defclass dependent-update-mixin (plist-mixin)
-  ()
-  (:metaclass std-class))
+(defclass dependent-update-mixin (plist-mixin) ())
 
 ;;;
 ;;; The class CLASS is a specified basic class.  It is the common superclass
@@ -592,7 +582,7 @@
 ;;;
 ;;; Slot definitions.
 ;;;
-(defclass slot-definition (standard-object) 
+(defclass slot-definition (metaobject) 
   ((name
     :initform nil
     :initarg :name
@@ -687,7 +677,7 @@ was inherited."
 					       effective-slot-definition)
   ())
 
-(defclass method (standard-object) ())
+(defclass method (metaobject) ())
 
 (defclass standard-method (definition-source-mixin documentation-mixin
 			      method)
@@ -729,6 +719,7 @@ was inherited."
 (defclass generic-function (dependent-update-mixin
 			    definition-source-mixin
 			    documentation-mixin
+			    metaobject
 			    funcallable-standard-object)
   ()
   (:metaclass funcallable-standard-class))
@@ -764,7 +755,7 @@ was inherited."
   (:default-initargs :method-class *the-class-standard-method*
     :method-combination *standard-method-combination*))
 
-(defclass method-combination (standard-object) ())
+(defclass method-combination (metaobject) ())
 
 (defclass standard-method-combination
     (definition-source-mixin method-combination)
diff --git a/pcl/dfun.lisp b/pcl/dfun.lisp
index 081b3921b..12d157ae6 100644
--- a/pcl/dfun.lisp
+++ b/pcl/dfun.lisp
@@ -25,7 +25,7 @@
 ;;; *************************************************************************
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.20 2003/03/25 13:37:54 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.21 2003/03/26 17:15:22 gerd Exp $")
 
 (in-package :pcl)
 
@@ -1146,7 +1146,7 @@ And so, we are saved.
 		      (if (consp meth)
 			  (and (early-method-standard-accessor-p meth)
 			       (early-method-standard-accessor-slot-name meth))
-			  (and (member *the-class-std-object*
+			  (and (member *the-class-standard-object*
 				       (cpl-maybe-early accessor-class))
 			       (if early-p
 				   (not (eq *the-class-standard-method*
@@ -1198,7 +1198,7 @@ And so, we are saved.
 			((reader boundp) (car specializers))
 			(writer (cadr specializers))))
 	       (specl-cpl (precedence specl))
-	       (so-p (member *the-class-std-object* specl-cpl))
+	       (so-p (member *the-class-standard-object* specl-cpl))
 	       (slot-name (slot-name method)))
 	  (when (or (null specl-cpl)
 		    (member *the-class-structure-object* specl-cpl))
@@ -1207,7 +1207,8 @@ And so, we are saved.
 		     (let ((cpl (precedence class)))
 		       (when (memq specl cpl)
 			 (unless (and (or so-p
-					  (member *the-class-std-object* cpl))
+					  (member *the-class-standard-object*
+						  cpl))
 				      (or early-p
 					  (slot-accessor-std-p slotd type)))
 			   (return-from make-accessor-table nil))
diff --git a/pcl/env.lisp b/pcl/env.lisp
index ff721b124..22d50fd87 100644
--- a/pcl/env.lisp
+++ b/pcl/env.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/env.lisp,v 1.19 2003/03/22 16:15:17 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/env.lisp,v 1.20 2003/03/26 17:15:22 gerd Exp $")
 ;;;
 ;;; Basic environmental stuff.
 ;;;
@@ -104,12 +104,19 @@
 
 (defvar *describe-metaobjects-as-objects-p* nil)
 
+(defun method-specialized-lambda-list (method)
+  (loop with specializers = (unparse-specializers method)
+	for elt in (method-lambda-list method)
+	collect (if specializers
+		    (list elt (pop specializers))
+		    elt)))
+
 (defmethod describe-object ((gf standard-generic-function) stream)
   (format stream "~A is a generic function.~%" gf)
   (let* ((gf-name (generic-function-name gf))
 	 (doc (documentation gf-name 'function)))
-    (format stream "Its arguments are:~%  ~S~%"
-	    (generic-function-pretty-arglist gf))
+    (format stream "Its lambda-list is:~%  ~S~%"
+	    (generic-function-lambda-list gf))
     (when doc
       (format stream "Generic function documentation:~%  ~s~%" doc))
     (format stream "Its methods are:~%")
@@ -117,7 +124,7 @@
 	  as doc = (plist-value method 'documentation) do
 	    (format stream "  ~d: ~a ~@[~{~s ~}~]~:s~%"
 		    i gf-name (method-qualifiers method)
-		    (unparse-specializers method))
+		    (method-specialized-lambda-list method))
 	    (when doc
 	      (format stream "    Method documentation: ~s~%" doc)))
     (when *describe-metaobjects-as-objects-p*
diff --git a/pcl/generic-functions.lisp b/pcl/generic-functions.lisp
index 4934838c7..7fdd4c913 100644
--- a/pcl/generic-functions.lisp
+++ b/pcl/generic-functions.lisp
@@ -1,7 +1,7 @@
 ;;;-*-Mode:LISP; Package:PCL; Base:10; Syntax:Common-lisp -*-
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/generic-functions.lisp,v 1.19 2003/03/25 12:40:04 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/generic-functions.lisp,v 1.20 2003/03/26 17:15:22 gerd Exp $")
 ;;;
 
 (in-package :pcl)
@@ -408,9 +408,6 @@
 (defgeneric generic-function-lambda-list (gf))
 ;          (generic-function)
 
-(defgeneric generic-function-pretty-arglist (generic-function))
-;          (standard-generic-function)
-
 (defgeneric gf-fast-method-function-p (gf))
 ;          (standard-generic-function)
 
@@ -429,9 +426,6 @@
 ;          (traced-method)
 ;          (standard-method)
 
-(defgeneric method-pretty-arglist (method))
-;          (standard-method)
-
 (defgeneric method-qualifiers (m))
 ;          (traced-method)
 ;          (standard-method)
@@ -686,19 +680,13 @@
 ;          (t effective-slot-definition t)
 
 (defgeneric slot-boundp-using-class (class object slotd))
-;          (std-class std-object standard-effective-slot-definition)
-;          (structure-class structure-object structure-effective-slot-definition)
 
 (defgeneric slot-makunbound-using-class (class object slotd))
-;          (std-class std-object standard-effective-slot-definition)
-;          (structure-class structure-object structure-effective-slot-definition)
 
 (defgeneric slot-unbound (class instance slot-name))
 ;          (t t t)
 
 (defgeneric slot-value-using-class (class object slotd))
-;          (std-class std-object standard-effective-slot-definition)
-;          (structure-class structure-object structure-effective-slot-definition)
 
 
 ;;; 4 arguments 
@@ -706,8 +694,6 @@
 ;          (standard-generic-function standard-method t t)
 
 (defgeneric (setf slot-value-using-class) (new-value class object slotd))
-;          (t std-class std-object standard-effective-slot-definition)
-;          (t structure-class structure-object structure-effective-slot-definition)
 
 
 ;;; 5 arguments 
@@ -784,10 +770,8 @@
 (defgeneric update-dependent (metaobject dependent &rest initargs))
 
 (defgeneric update-instance-for-different-class (previous current &rest initargs))
-;          (std-object std-object)
 
 (defgeneric update-instance-for-redefined-class (instance added-slots discarded-slots property-list &rest initargs))
-;          (std-object t t t)
 
 (defgeneric writer-method-class (class direct-slot &rest initargs))
 ;          (slot-class t)
diff --git a/pcl/init.lisp b/pcl/init.lisp
index 2976f679b..771929469 100644
--- a/pcl/init.lisp
+++ b/pcl/init.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/init.lisp,v 1.15 2003/03/22 16:15:16 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/init.lisp,v 1.16 2003/03/26 17:15:22 gerd Exp $")
 
 ;;;
 ;;; This file defines the initialization and related protocols.
@@ -81,9 +81,8 @@
   (apply #'shared-initialize instance nil initargs)
   instance)
 
-(defmethod update-instance-for-different-class ((previous std-object)
-						(current std-object)
-						&rest initargs)
+(defmethod update-instance-for-different-class
+    ((previous standard-object) (current standard-object) &rest initargs)
   ;; First we must compute the newly added slots.  The spec defines
   ;; newly added slots as "those local slots for which no slot of
   ;; the same name exists in the previous class."
@@ -101,11 +100,12 @@
 	   (list* 'shared-initialize current added-slots initargs)))
     (apply #'shared-initialize current added-slots initargs)))
 
-(defmethod update-instance-for-redefined-class ((instance std-object)
-						added-slots
-						discarded-slots
-						property-list
-						&rest initargs)
+(defmethod update-instance-for-redefined-class
+    ((instance standard-object)
+     added-slots
+     discarded-slots
+     property-list
+     &rest initargs)
   (check-initargs
    (class-of instance) initargs
    (list (list* 'update-instance-for-redefined-class
diff --git a/pcl/low.lisp b/pcl/low.lisp
index e8b7ae5e9..51f06f5b1 100644
--- a/pcl/low.lisp
+++ b/pcl/low.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/low.lisp,v 1.22 2003/03/22 16:15:16 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/low.lisp,v 1.23 2003/03/26 17:15:22 gerd Exp $")
 
 ;;; 
 ;;; This file contains optimized low-level constructs for PCL.
@@ -186,16 +186,15 @@ the compiler as completely as possible.  Currently this means that
   (movable foldable flushable explicit-check))
 
 (deftransform pcl::pcl-instance-p ((object))
-  (let* ((otype (continuation-type object))
-	 (std-obj (specifier-type 'pcl::std-object)))
-    ;; Flush tests whose result is known at compile time.
-    (cond ((csubtypep otype std-obj)
-	   't)
-	  ((not (types-intersect otype std-obj))
-	   'nil)
-	  ((and (kernel::standard-class-p otype)
-		(pcl::info-std-class-p (kernel:%class-name otype)))
-	   't)
+  (let* ((object-type (continuation-type object))
+	 (standard-object (specifier-type 'standard-object)))
+    (cond ((csubtypep object-type standard-object)
+	   t)
+	  ((not (types-intersect object-type standard-object))
+	   nil)
+	  ((and (kernel::standard-class-p object-type)
+		(pcl::info-std-class-p (kernel:%class-name object-type)))
+	   t)
 	  (t
 	   `(typep (kernel:layout-of object) 'pcl::wrapper)))))
 
diff --git a/pcl/methods.lisp b/pcl/methods.lisp
index 62626d7b3..6f7b7898a 100644
--- a/pcl/methods.lisp
+++ b/pcl/methods.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.25 2003/03/25 13:37:54 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.26 2003/03/26 17:15:21 gerd Exp $")
 
 (in-package :pcl)
 
@@ -828,7 +828,7 @@
 	(cond ((and (eq (class-name (car specls))
 			'std-class)
 		    (eq (class-name (cadr specls)) 
-			'std-object)
+			'standard-object)
 		    (eq (class-name (caddr specls)) 
 			'standard-effective-slot-definition))
 	       (set-standard-svuc-method type method))
@@ -846,7 +846,6 @@
 	     precompute-p
 	     (not (or (eq spec *the-class-t*)
 		      (eq spec *the-class-slot-object*)
-		      (eq spec *the-class-std-object*)
 		      (eq spec *the-class-standard-object*)
 		      (eq spec *the-class-structure-object*)))
 	     (let ((sc (class-direct-subclasses spec)))
@@ -910,8 +909,6 @@
 	 t)
 	((eq class *the-class-slot-object*)
 	 `(not (lisp:typep (kernel::class-of ,arg) 'kernel::built-in-class)))
-	((eq class *the-class-std-object*)
-	 `(or (std-instance-p ,arg) (fsc-instance-p ,arg)))
 	((eq class *the-class-standard-object*)
 	 `(std-instance-p ,arg))
 	((eq class *the-class-funcallable-standard-object*)
@@ -1463,65 +1460,3 @@
     (declare (ignore nreq nopt keysp restp))
     (values keywords allow-other-keys-p)))
 
-
-;;;
-;;; This is based on the rules of method lambda list congruency defined in
-;;; the spec.  The lambda list it constructs is the pretty union of the
-;;; lambda lists of all the methods.  It doesn't take method applicability
-;;; into account at all yet.
-;;; 
-(defmethod generic-function-pretty-arglist
-	   ((gf standard-generic-function))
-  (let ((methods (generic-function-methods gf))
-	(arglist ()))      
-    (when methods
-      (multiple-value-bind (required optional rest key allow-other-keys)
-	  (method-pretty-arglist (car methods))
-	(dolist (m (cdr methods))
-	  (multiple-value-bind (method-key-keywords
-				method-allow-other-keys
-				method-key)
-	      (function-keywords m)
-	    ;; we've modified function-keywords to return what we want as
-	    ;;  the third value, no other change here.
-	    (declare (ignore method-key-keywords))
-	    (setq key (union key method-key))
-	    (setq allow-other-keys (or allow-other-keys
-				       method-allow-other-keys))))
-	(when allow-other-keys
-	  (setq arglist '(&allow-other-keys)))
-	(when key
-	  (setq arglist (nconc (list '&key) key arglist)))
-	(when rest
-	  (setq arglist (nconc (list '&rest rest) arglist)))
-	(when optional
-	  (setq arglist (nconc (list '&optional) optional arglist)))
-	(nconc required arglist)))))
-  
-
-(defmethod method-pretty-arglist ((method standard-method))
-  (let ((required ())
-	(optional ())
-	(rest nil)
-	(key ())
-	(allow-other-keys nil)
-	(state 'required)
-	(arglist (method-lambda-list method)))
-    (dolist (arg arglist)
-      (cond ((eq arg '&optional)         (setq state 'optional))
-	    ((eq arg '&rest)             (setq state 'rest))
-	    ((eq arg '&key)              (setq state 'key))
-	    ((eq arg '&allow-other-keys) (setq allow-other-keys t))
-	    ((memq arg lambda-list-keywords))
-	    (t
-	     (ecase state
-	       (required (push arg required))
-	       (optional (push arg optional))
-	       (key      (push arg key))
-	       (rest     (setq rest arg))))))
-    (values (nreverse required)
-	    (nreverse optional)
-	    rest
-	    (nreverse key)
-	    allow-other-keys)))
-
diff --git a/pcl/pkg.lisp b/pcl/pkg.lisp
index 65dc64724..5c1e61782 100644
--- a/pcl/pkg.lisp
+++ b/pcl/pkg.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/pkg.lisp,v 1.24 2003/03/25 16:42:24 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/pkg.lisp,v 1.25 2003/03/26 17:15:21 gerd Exp $")
 ;;;
 ;;; CMUCL 18a: Jan-1998 -- Changing to DEFPACKAGE.
 
@@ -118,7 +118,8 @@
 	   "EQL-SPECIALIZER"
 	   "FORWARD-REFERENCED-CLASS"
 	   "FUNCALLABLE-STANDARD-CLASS"
-	   "FUNCALLABLE-STANDARD-OBJECT")
+	   "FUNCALLABLE-STANDARD-OBJECT"
+	   "METAOBJECT")
 
   ;;*chapter-6-exports*
   (:export "ADD-DEPENDENT"
@@ -256,7 +257,7 @@
 	   "MAKE-INSTANCE"
 	   "MAKE-METHOD-LAMBDA"
 	   "MAP-DEPENDENTS"
-	   ;"METAOBJECT"
+	   "METAOBJECT"
 	   "METHOD-FUNCTION"
 	   "METHOD-GENERIC-FUNCTION"
 	   "METHOD-LAMBDA-LIST"
@@ -287,7 +288,9 @@
 	   "STANDARD-ACCESSOR-METHOD" 
 	   "STANDARD-DIRECT-SLOT-DEFINITION" 
 	   "STANDARD-EFFECTIVE-SLOT-DEFINITION" 
+	   "STANDARD-GENERIC-FUNCTION"
 	   "STANDARD-INSTANCE-ACCESS"
+	   "STANDARD-METHOD"
 	   "STANDARD-READER-METHOD" 
 	   "STANDARD-SLOT-DEFINITION" 
 	   "STANDARD-WRITER-METHOD" 
diff --git a/pcl/slots-boot.lisp b/pcl/slots-boot.lisp
index a5ef1a727..c29de10ef 100644
--- a/pcl/slots-boot.lisp
+++ b/pcl/slots-boot.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots-boot.lisp,v 1.17 2003/03/22 16:15:15 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots-boot.lisp,v 1.18 2003/03/26 17:15:21 gerd Exp $")
 ;;;
 
 (in-package :pcl)
@@ -150,12 +150,6 @@
 	(boundp (make-structure-slot-boundp-function slotd)))
       (let* ((fsc-p (cond ((standard-class-p class) nil)
 			  ((funcallable-standard-class-p class) t)
-			  ((std-class-p class)
-			   ;; Shouldn't be using the optimized-std-accessors
-			   ;; in this case.
-			   #+nil (format t "* Warning: ~s ~s~%   ~s~%"
-				   name slotd class)
-			   nil)
 			  (t (error "~@<~S is not a standard-class.~@:>" class))))
 	     (slot-name (slot-definition-name slotd))
 	     (index (slot-definition-location slotd))
diff --git a/pcl/slots.lisp b/pcl/slots.lisp
index acf144452..aac337e37 100644
--- a/pcl/slots.lisp
+++ b/pcl/slots.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots.lisp,v 1.17 2003/03/22 16:15:15 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots.lisp,v 1.18 2003/03/26 17:15:21 gerd Exp $")
 ;;;
 
 (in-package :pcl)
@@ -154,7 +154,7 @@
   (%slot-ref (fsc-instance-slots instance) location))
 
 (defmethod slot-value-using-class ((class std-class)
-                                   (object std-object)
+                                   (object standard-object)
                                    (slotd standard-effective-slot-definition))
   (check-obsolete-instance object)
   (let* ((location (slot-definition-location slotd))
@@ -178,7 +178,7 @@
 
 (defmethod (setf slot-value-using-class)
 	   (new-value (class std-class)
-		      (object std-object)
+		      (object standard-object)
 		      (slotd standard-effective-slot-definition))
   (check-obsolete-instance object)
   (let ((location (slot-definition-location slotd)))
@@ -198,7 +198,7 @@
 
 (defmethod slot-boundp-using-class
 	   ((class std-class) 
-	    (object std-object) 
+	    (object standard-object) 
 	    (slotd standard-effective-slot-definition))
   (check-obsolete-instance object)
   (let* ((location (slot-definition-location slotd))
@@ -220,7 +220,7 @@
 
 (defmethod slot-makunbound-using-class
 	   ((class std-class)
-	    (object std-object) 
+	    (object standard-object) 
 	    (slotd standard-effective-slot-definition))
   (check-obsolete-instance object)
   (let ((location (slot-definition-location slotd)))
-- 
GitLab