Update of /cvsroot/sbcl/sbcl/src/pcl In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26496/src/pcl Modified Files: braid.lisp cache.lisp compiler-support.lisp defs.lisp dfun.lisp early-low.lisp init.lisp methods.lisp slots.lisp Log Message: 0.9.4.55: The class SB-PCL::STD-OBJECT is now useless: delete it mercilessly. ... this means that there are no direct instances of STD-CLASS any more: so it can be removed from the braid. ... document that we're no longer nonconforming wrt {,funcallable-}standard-object Index: braid.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/braid.lisp,v retrieving revision 1.49 retrieving revision 1.50 diff -u -d -r1.49 -r1.50 --- braid.lisp 6 Aug 2005 11:31:18 -0000 1.49 +++ braid.lisp 9 Sep 2005 16:09:51 -0000 1.50 @@ -113,7 +113,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 @@ -128,7 +127,7 @@ standard-generic-function-wrapper standard-generic-function) (!initial-classes-and-wrappers standard-class funcallable-standard-class - slot-class built-in-class structure-class condition-class std-class + slot-class built-in-class structure-class condition-class standard-direct-slot-definition standard-effective-slot-definition class-eq-specializer standard-generic-function) ;; First, make a class metaobject for each of the early classes. For @@ -139,7 +138,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) @@ -163,8 +161,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) @@ -214,7 +210,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 @@ -302,7 +298,7 @@ `(default-initargs ,default-initargs)))) (when (memq metaclass-name '(standard-class funcallable-standard-class structure-class condition-class - slot-class std-class)) + slot-class)) (set-slot 'direct-slots direct-slots) (set-slot 'slots slots)) Index: cache.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/cache.lisp,v retrieving revision 1.35 retrieving revision 1.36 diff -u -d -r1.35 -r1.36 --- cache.lisp 14 Jul 2005 19:28:17 -0000 1.35 +++ cache.lisp 9 Sep 2005 16:09:51 -0000 1.36 @@ -557,7 +557,6 @@ ;;; STRUCTURE-CLASS seen only structure classes (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)) (condition (find-class 'condition-class)) @@ -570,7 +569,6 @@ (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) Index: compiler-support.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/compiler-support.lisp,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- compiler-support.lisp 16 Aug 2005 13:46:59 -0000 1.14 +++ compiler-support.lisp 9 Sep 2005 16:09:51 -0000 1.15 @@ -39,11 +39,11 @@ (deftransform sb-pcl::pcl-instance-p ((object)) (let* ((otype (lvar-type object)) - (std-obj (specifier-type 'sb-pcl::std-object))) + (standard-object (specifier-type 'standard-object))) (cond ;; Flush tests whose result is known at compile time. - ((csubtypep otype std-obj) t) - ((not (types-equal-or-intersect otype std-obj)) nil) + ((csubtypep otype standard-object) t) + ((not (types-equal-or-intersect otype standard-object)) nil) (t `(typep (layout-of object) 'sb-pcl::wrapper))))) Index: defs.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/defs.lisp,v retrieving revision 1.40 retrieving revision 1.41 diff -u -d -r1.40 -r1.41 --- defs.lisp 9 Sep 2005 14:16:18 -0000 1.40 +++ defs.lisp 9 Sep 2005 16:09:51 -0000 1.41 @@ -339,36 +339,23 @@ (:constructor |STRUCTURE-OBJECT class constructor|) (:copier nil))) -(defclass std-object (slot-object) () - (:metaclass std-class)) - -(defclass standard-object (std-object) ()) +(defclass standard-object (slot-object) ()) (defclass funcallable-standard-object (standard-object function) () (:metaclass funcallable-standard-class)) (defclass specializer (standard-object) - ((type - :initform nil - :reader specializer-type))) + ((type :initform nil :reader specializer-type))) -(defclass definition-source-mixin (std-object) - ((source - :initform *load-pathname* - :reader definition-source - :initarg :definition-source)) - (:metaclass std-class)) +(defclass definition-source-mixin (standard-object) + ((source :initform *load-pathname* :reader definition-source + :initarg :definition-source))) -(defclass plist-mixin (std-object) - ((plist - :initform () - :accessor object-plist)) - (:metaclass std-class)) +(defclass plist-mixin (standard-object) + ((plist :initform () :accessor object-plist))) -(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 of any kind of class. That is, any class that can be a Index: dfun.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/dfun.lisp,v retrieving revision 1.38 retrieving revision 1.39 diff -u -d -r1.38 -r1.39 --- dfun.lisp 9 Aug 2005 13:57:50 -0000 1.38 +++ dfun.lisp 9 Sep 2005 16:09:51 -0000 1.39 @@ -1261,7 +1261,7 @@ (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* (if early-p (early-class-precedence-list accessor-class) @@ -1311,7 +1311,7 @@ (early-class-precedence-list specl) (and (class-finalized-p specl) (class-precedence-list specl)))) - (so-p (member *the-class-std-object* specl-cpl)) + (so-p (member *the-class-standard-object* specl-cpl)) (slot-name (if (consp method) (and (early-method-standard-accessor-p method) (early-method-standard-accessor-slot-name @@ -1326,7 +1326,8 @@ (class-precedence-list 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)) Index: early-low.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/early-low.lisp,v retrieving revision 1.10 retrieving revision 1.11 diff -u -d -r1.10 -r1.11 --- early-low.lisp 14 Jul 2005 19:28:18 -0000 1.10 +++ early-low.lisp 9 Sep 2005 16:09:51 -0000 1.11 @@ -88,7 +88,6 @@ *the-class-slot-object* *the-class-structure-object* - *the-class-std-object* *the-class-standard-object* *the-class-funcallable-standard-object* *the-class-class* Index: init.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/init.lisp,v retrieving revision 1.17 retrieving revision 1.18 diff -u -d -r1.17 -r1.18 --- init.lisp 14 Jul 2005 19:45:36 -0000 1.17 +++ init.lisp 9 Sep 2005 16:09:51 -0000 1.18 @@ -68,9 +68,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." @@ -88,11 +87,9 @@ (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-1 (class-of instance) initargs (list (list* 'update-instance-for-redefined-class Index: methods.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/methods.lisp,v retrieving revision 1.41 retrieving revision 1.42 diff -u -d -r1.41 -r1.42 --- methods.lisp 9 Aug 2005 13:57:51 -0000 1.41 +++ methods.lisp 9 Sep 2005 16:09:51 -0000 1.42 @@ -909,7 +909,7 @@ (eq (pop specls) *the-class-t*)) (every #'classp specls)) (cond ((and (eq (class-name (car specls)) 'std-class) - (eq (class-name (cadr specls)) 'std-object) + (eq (class-name (cadr specls)) 'standard-object) (eq (class-name (caddr specls)) 'standard-effective-slot-definition)) (set-standard-svuc-method type method)) @@ -930,7 +930,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))) @@ -994,19 +993,16 @@ cache))) (defmacro class-test (arg class) - (cond ((eq class *the-class-t*) - t) - ((eq class *the-class-slot-object*) - `(not (typep (classoid-of ,arg) - 'built-in-classoid))) - ((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*) - `(fsc-instance-p ,arg)) - (t - `(typep ,arg ',(class-name class))))) + (cond + ((eq class *the-class-t*) t) + ((eq class *the-class-slot-object*) + `(not (typep (classoid-of ,arg) 'built-in-classoid))) + ((eq class *the-class-standard-object*) + `(or (std-instance-p ,arg) (fsc-instance-p ,arg))) + ((eq class *the-class-funcallable-standard-object*) + `(fsc-instance-p ,arg)) + (t + `(typep ,arg ',(class-name class))))) (defmacro class-eq-test (arg class) `(eq (class-of ,arg) ',class)) Index: slots.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/slots.lisp,v retrieving revision 1.21 retrieving revision 1.22 diff -u -d -r1.21 -r1.22 --- slots.lisp 14 Jul 2005 19:45:42 -0000 1.21 +++ slots.lisp 9 Sep 2005 16:09:51 -0000 1.22 @@ -150,7 +150,7 @@ (clos-slots-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)) @@ -176,7 +176,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)) @@ -222,7 +222,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))) |