0.7.9.53:

[sbcl.git] / src / pcl / slots.lisp

diff --git a/src/pcl/slots.lisp b/src/pcl/slots.lisp
index 11ffc16..a19070b 100644 (file)
--- a/src/pcl/slots.lisp
+++ b/src/pcl/slots.lisp
@@ -116,14 +116,11 @@
        (slot-missing class object slot-name 'slot-value)
        (slot-value-using-class class object slot-definition))))
 
-(setf (gdefinition 'slot-value-normal) #'slot-value)
-
-(define-compiler-macro slot-value (object-form slot-name-form)
-  (if (and (constantp slot-name-form)
-          (let ((slot-name (eval slot-name-form)))
-            (and (symbolp slot-name) (symbol-package slot-name))))
-      `(accessor-slot-value ,object-form ,slot-name-form)
-      `(slot-value-normal ,object-form ,slot-name-form)))
+(define-compiler-macro slot-value (&whole form object slot-name)
+  (if (and (constantp slot-name)
+          (interned-symbol-p (eval slot-name)))
+      `(accessor-slot-value ,object ,slot-name)
+      form))
 
 (defun set-slot-value (object slot-name new-value)
   (let* ((class (class-of object))
@@ -133,16 +130,11 @@
        (setf (slot-value-using-class class object slot-definition)
              new-value))))
 
-(setf (gdefinition 'set-slot-value-normal) #'set-slot-value)
-
-(define-compiler-macro set-slot-value (object-form
-                                      slot-name-form
-                                      new-value-form)
-  (if (and (constantp slot-name-form)
-          (let ((slot-name (eval slot-name-form)))
-            (and (symbolp slot-name) (symbol-package slot-name))))
-      `(accessor-set-slot-value ,object-form ,slot-name-form ,new-value-form)
-      `(set-slot-value-normal ,object-form ,slot-name-form ,new-value-form)))
+(define-compiler-macro set-slot-value (&whole form object slot-name new-value)
+  (if (and (constantp slot-name)
+          (interned-symbol-p (eval slot-name)))
+      `(accessor-set-slot-value ,object ,slot-name ,new-value)
+      form))
 
 (defun slot-boundp (object slot-name)
   (let* ((class (class-of object))
@@ -153,12 +145,11 @@
 
 (setf (gdefinition 'slot-boundp-normal) #'slot-boundp)
 
-(define-compiler-macro slot-boundp (object-form slot-name-form)
-  (if (and (constantp slot-name-form)
-          (let ((slot-name (eval slot-name-form)))
-            (and (symbolp slot-name) (symbol-package slot-name))))
-      `(accessor-slot-boundp ,object-form ,slot-name-form)
-      `(slot-boundp-normal ,object-form ,slot-name-form)))
+(define-compiler-macro slot-boundp (&whole form object slot-name)
+  (if (and (constantp slot-name)
+          (interned-symbol-p (eval slot-name)))
+      `(accessor-slot-boundp ,object ,slot-name)
+      form))
 
 (defun slot-makunbound (object slot-name)
   (let* ((class (class-of object))
@@ -187,21 +178,14 @@
 (defmethod slot-value-using-class ((class std-class)
                                   (object std-object)
                                   (slotd standard-effective-slot-definition))
+  (check-obsolete-instance object)
   (let* ((location (slot-definition-location slotd))
         (value (typecase location
                  (fixnum
                   (cond ((std-instance-p object)
-                         ;; FIXME: EQ T (WRAPPER-STATE ..) is better done
-                         ;; through INVALID-WRAPPER-P (here and below).
-                         (unless (eq t (wrapper-state (std-instance-wrapper
-                                                       object)))
-                           (check-wrapper-validity object))
                          (clos-slots-ref (std-instance-slots object)
                                          location))
                         ((fsc-instance-p object)
-                         (unless (eq t (wrapper-state (fsc-instance-wrapper
-                                                       object)))
-                           (check-wrapper-validity object))
                          (clos-slots-ref (fsc-instance-slots object)
                                          location))
                         (t (error "unrecognized instance type"))))
@@ -220,19 +204,16 @@
           (new-value (class std-class)
                      (object std-object)
                      (slotd standard-effective-slot-definition))
+  (check-obsolete-instance object)
   (let ((location (slot-definition-location slotd)))
     (typecase location
       (fixnum
        (cond ((std-instance-p object)
-             (unless (eq t (wrapper-state (std-instance-wrapper object)))
-               (check-wrapper-validity object))
-               (setf (clos-slots-ref (std-instance-slots object) location)
-                    new-value))
+             (setf (clos-slots-ref (std-instance-slots object) location)
+                   new-value))
             ((fsc-instance-p object)
-             (unless (eq t (wrapper-state (fsc-instance-wrapper object)))
-               (check-wrapper-validity object))
-               (setf (clos-slots-ref (fsc-instance-slots object) location)
-                    new-value))
+             (setf (clos-slots-ref (fsc-instance-slots object) location)
+                   new-value))
             (t (error "unrecognized instance type"))))
       (cons
        (setf (cdr location) new-value))
@@ -245,19 +226,14 @@
           ((class std-class)
            (object std-object)
            (slotd standard-effective-slot-definition))
+  (check-obsolete-instance object)
   (let* ((location (slot-definition-location slotd))
         (value (typecase location
                  (fixnum
                   (cond ((std-instance-p object)
-                         (unless (eq t (wrapper-state (std-instance-wrapper
-                                                       object)))
-                           (check-wrapper-validity object))
                          (clos-slots-ref (std-instance-slots object)
                                          location))
                         ((fsc-instance-p object)
-                         (unless (eq t (wrapper-state (fsc-instance-wrapper
-                                                       object)))
-                           (check-wrapper-validity object))
                          (clos-slots-ref (fsc-instance-slots object)
                                          location))
                         (t (error "unrecognized instance type"))))
@@ -274,19 +250,16 @@
           ((class std-class)
            (object std-object)
            (slotd standard-effective-slot-definition))
+  (check-obsolete-instance object)
   (let ((location (slot-definition-location slotd)))
     (typecase location
       (fixnum
        (cond ((std-instance-p object)
-             (unless (eq t (wrapper-state (std-instance-wrapper object)))
-               (check-wrapper-validity object))
-               (setf (clos-slots-ref (std-instance-slots object) location)
-                    +slot-unbound+))
+             (setf (clos-slots-ref (std-instance-slots object) location)
+                   +slot-unbound+))
             ((fsc-instance-p object)
-             (unless (eq t (wrapper-state (fsc-instance-wrapper object)))
-               (check-wrapper-validity object))
-               (setf (clos-slots-ref (fsc-instance-slots object) location)
-                    +slot-unbound+))
+             (setf (clos-slots-ref (fsc-instance-slots object) location)
+                   +slot-unbound+))
             (t (error "unrecognized instance type"))))
       (cons
        (setf (cdr location) +slot-unbound+))