From 1a405defbd26ca767e71494b67127fcc00a8af12 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 9 Sep 2005 16:09:51 +0000 Subject: [PATCH] 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 --- doc/manual/beyond-ansi.texinfo | 6 ------ src/pcl/braid.lisp | 10 +++------- src/pcl/cache.lisp | 2 -- src/pcl/compiler-support.lisp | 6 +++--- src/pcl/defs.lisp | 29 ++++++++--------------------- src/pcl/dfun.lisp | 7 ++++--- src/pcl/early-low.lisp | 1 - src/pcl/init.lisp | 13 +++++-------- src/pcl/methods.lisp | 26 +++++++++++--------------- src/pcl/slots.lisp | 8 ++++---- tests/mop.pure.lisp | 2 +- tests/type.impure.lisp | 2 -- version.lisp-expr | 2 +- 13 files changed, 40 insertions(+), 74 deletions(-) diff --git a/doc/manual/beyond-ansi.texinfo b/doc/manual/beyond-ansi.texinfo index 6e44f7d..2c01c35 100644 --- a/doc/manual/beyond-ansi.texinfo +++ b/doc/manual/beyond-ansi.texinfo @@ -50,12 +50,6 @@ the abstract @code{metaobject} class is not present in the class hierarchy; @item -@tindex standard-object -@tindex funcallable-standard-object -the @code{standard-object} and @code{funcallable-standard-object} -classes are disjoint; - -@item @findex compute-effective-method @findex sb-mop:compute-effective-method @code{compute-effective-method} only returns one value, not two; diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp index 98c0c8f..776822f 100644 --- a/src/pcl/braid.lisp +++ b/src/pcl/braid.lisp @@ -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)) diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp index 5b19884..9a65def 100644 --- a/src/pcl/cache.lisp +++ b/src/pcl/cache.lisp @@ -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) diff --git a/src/pcl/compiler-support.lisp b/src/pcl/compiler-support.lisp index 3fe2083..58e462f 100644 --- a/src/pcl/compiler-support.lisp +++ b/src/pcl/compiler-support.lisp @@ -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))))) diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp index 251e67a..5b181e1 100644 --- a/src/pcl/defs.lisp +++ b/src/pcl/defs.lisp @@ -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 diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp index 51bcea8..ae44d78 100644 --- a/src/pcl/dfun.lisp +++ b/src/pcl/dfun.lisp @@ -1261,7 +1261,7 @@ Except see also BREAK-VICIOUS-METACIRCLE. -- CSR, 2003-05-28 (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 @@ Except see also BREAK-VICIOUS-METACIRCLE. -- CSR, 2003-05-28 (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 @@ Except see also BREAK-VICIOUS-METACIRCLE. -- CSR, 2003-05-28 (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)) diff --git a/src/pcl/early-low.lisp b/src/pcl/early-low.lisp index d762907..e80284a 100644 --- a/src/pcl/early-low.lisp +++ b/src/pcl/early-low.lisp @@ -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* diff --git a/src/pcl/init.lisp b/src/pcl/init.lisp index 8b55efa..4306079 100644 --- a/src/pcl/init.lisp +++ b/src/pcl/init.lisp @@ -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 diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp index 8db6b37..35d6af1 100644 --- a/src/pcl/methods.lisp +++ b/src/pcl/methods.lisp @@ -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)) diff --git a/src/pcl/slots.lisp b/src/pcl/slots.lisp index f833fce..6b7b120 100644 --- a/src/pcl/slots.lisp +++ b/src/pcl/slots.lisp @@ -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))) diff --git a/tests/mop.pure.lisp b/tests/mop.pure.lisp index 22fe7cc..5cb1167 100644 --- a/tests/mop.pure.lisp +++ b/tests/mop.pure.lisp @@ -21,5 +21,5 @@ (sb-mop:class-direct-subclasses (find-class 'standard-object)))) (assert (find (find-class 'standard-object) - (sb-mop:class-direct-superclasses + (sb-mop:class-direct-superclasses (find-class 'sb-mop:funcallable-standard-object)))) diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp index da30191..1e5acd9 100644 --- a/tests/type.impure.lisp +++ b/tests/type.impure.lisp @@ -371,7 +371,6 @@ 'fundamental-stream)) (mapcar #'find-class '(fundamental-stream standard-object - sb-pcl::std-object sb-pcl::slot-object stream t)))) @@ -379,7 +378,6 @@ 'fundamental-stream)) (mapcar #'find-class '(fundamental-stream standard-object - sb-pcl::std-object sb-pcl::slot-object stream t)))) (assert (subtypep (find-class 'stream) (find-class t))) diff --git a/version.lisp-expr b/version.lisp-expr index b0473e6..3903ab8 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.4.54" +"0.9.4.55" -- 1.7.10.4