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;
(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
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
(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)
(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)
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
`(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))
;;; 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))
(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)
(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)))))
(: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
(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)
(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
(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))
*the-class-slot-object*
*the-class-structure-object*
- *the-class-std-object*
*the-class-standard-object*
*the-class-funcallable-standard-object*
*the-class-class*
(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."
(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
(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))
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)))
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))
(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))
(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)))
(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))
(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)))
(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))))
'fundamental-stream))
(mapcar #'find-class '(fundamental-stream
standard-object
- sb-pcl::std-object
sb-pcl::slot-object
stream
t))))
'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)))
;;; 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"
projects / sbcl.git / commitdiff