0.9.10.2:

[sbcl.git] / src / pcl / std-class.lisp

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index cf2eb6e..83e16de 100644 (file)
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -72,7 +72,7 @@
 (defmethod initialize-internal-slot-functions ((slotd
                                                 effective-slot-definition))
   (let* ((name (slot-value slotd 'name))
-         (class (slot-value slotd 'class)))
+         (class (slot-value slotd '%class)))
     (let ((table (or (gethash name *name->class->slotd-table*)
                      (setf (gethash name *name->class->slotd-table*)
                            (make-hash-table :test 'eq :size 5)))))
@@ -83,8 +83,7 @@
                               (writer '(setf slot-value-using-class))
                               (boundp 'slot-boundp-using-class)))
              (gf (gdefinition gf-name)))
-        (compute-slot-accessor-info slotd type gf)))
-    (initialize-internal-slot-gfs name)))
+        (compute-slot-accessor-info slotd type gf)))))
 
 ;;; CMUCL (Gerd PCL 2003-04-25) comment:
 ;;;
@@ -103,7 +102,7 @@
 (defmethod compute-slot-accessor-info ((slotd effective-slot-definition)
                                        type gf)
   (let* ((name (slot-value slotd 'name))
-         (class (slot-value slotd 'class))
+         (class (slot-value slotd '%class))
          (old-slotd (find-slot-definition class name))
          (old-std-p (and old-slotd (slot-accessor-std-p old-slotd 'all))))
     (multiple-value-bind (function std-p)
@@ -281,11 +280,11 @@
                                      slot-names
                                      &key)
   (declare (ignore slot-names))
-  (setf (slot-value specl 'type) `(class-eq ,(specializer-class specl))))
+  (setf (slot-value specl '%type) `(class-eq ,(specializer-class specl))))
 
 (defmethod shared-initialize :after ((specl eql-specializer) slot-names &key)
   (declare (ignore slot-names))
-  (setf (slot-value specl 'type)
+  (setf (slot-value specl '%type)
         `(eql ,(specializer-object specl)))
   (setf (info :type :translator specl)
         (constantly (make-member-type :members (list (specializer-object specl))))))
@@ -364,7 +363,7 @@
 
 \f
 (defmethod shared-initialize :after
-    ((class std-class) slot-names &key 
+    ((class std-class) slot-names &key
      (direct-superclasses nil direct-superclasses-p)
      (direct-slots nil direct-slots-p)
      (direct-default-initargs nil direct-default-initargs-p))
@@ -485,7 +484,7 @@
   (declare (ignore slot-names name))
   ;; FIXME: Could this just be CLASS instead of `(CLASS ,CLASS)? If not,
   ;; why not? (See also similar expression in !BOOTSTRAP-INITIALIZE-CLASS.)
-  (setf (slot-value class 'type) `(class ,class))
+  (setf (slot-value class '%type) `(class ,class))
   (setf (slot-value class 'class-eq-specializer)
         (make-instance 'class-eq-specializer :class class)))
 
@@ -520,7 +519,7 @@
                                      &key direct-slots direct-superclasses)
   (declare (ignore slot-names))
   (let ((classoid (find-classoid (class-name class))))
-    (with-slots (wrapper class-precedence-list cpl-available-p
+    (with-slots (wrapper %class-precedence-list cpl-available-p
                          prototype (direct-supers direct-superclasses))
         class
       (setf (slot-value class 'direct-slots)
@@ -530,7 +529,7 @@
       (setf (classoid-pcl-class classoid) class)
       (setq direct-supers direct-superclasses)
       (setq wrapper (classoid-layout classoid))
-      (setq class-precedence-list (compute-class-precedence-list class))
+      (setq %class-precedence-list (compute-class-precedence-list class))
       (setq cpl-available-p t)
       (add-direct-subclasses class direct-superclasses)
       (setf (slot-value class 'slots) (compute-slots class))))
@@ -590,7 +589,7 @@
                       (compute-effective-slot-definition
                        class (slot-definition-name dslotd) (list dslotd)))
                     (class-direct-slots superclass)))
-          (reverse (slot-value class 'class-precedence-list))))
+          (reverse (slot-value class '%class-precedence-list))))
 
 (defmethod compute-slots :around ((class condition-class))
   (let ((eslotds (call-next-method)))
@@ -660,7 +659,7 @@
        (sb-kernel::compiler-layout-or-lose (dd-name dd))))))
 
 (defmethod shared-initialize :after
-    ((class structure-class) slot-names &key 
+    ((class structure-class) slot-names &key
      (direct-superclasses nil direct-superclasses-p)
      (direct-slots nil direct-slots-p)
      direct-default-initargs)
@@ -709,7 +708,7 @@
         (setf (slot-value class 'defstruct-constructor)
               (make-defstruct-allocation-function class)))
     (add-direct-subclasses class direct-superclasses)
-    (setf (slot-value class 'class-precedence-list)
+    (setf (slot-value class '%class-precedence-list)
           (compute-class-precedence-list class))
     (setf (slot-value class 'cpl-available-p) t)
     (setf (slot-value class 'slots) (compute-slots class))
@@ -849,11 +848,11 @@
         ;; comment from the old CMU CL sources:
         ;;   Need to have the cpl setup before update-lisp-class-layout
         ;;   is called on CMU CL.
-        (setf (slot-value class 'class-precedence-list) cpl)
+        (setf (slot-value class '%class-precedence-list) cpl)
         (setf (slot-value class 'cpl-available-p) t)
         (force-cache-flushes class))
       (progn
-        (setf (slot-value class 'class-precedence-list) cpl)
+        (setf (slot-value class '%class-precedence-list) cpl)
         (setf (slot-value class 'cpl-available-p) t)))
   (update-class-can-precede-p cpl))
 
@@ -1045,7 +1044,7 @@
                        (slot-definition-name dslotd)
                        (list dslotd)))
                     (class-direct-slots superclass)))
-          (reverse (slot-value class 'class-precedence-list))))
+          (reverse (slot-value class '%class-precedence-list))))
 
 (defmethod compute-slots :around ((class structure-class))
   (let ((eslotds (call-next-method)))