Changeset 421

Timestamp:

Jan 30, 2004, 11:34:07 AM (21 years ago)

Author:

Gary Byers

Message:

ADD-READER/WRITER-METHOD: less specialized. Turn a few early accessors
into GFs; writer methods on some slots.

File:

• trunk/ccl/level-1/l1-clos.lisp (modified) (6 diffs)

trunk/ccl/level-1/l1-clos.lisp

@@ -771 +771 @@
   *standard-reader-method-class*)
 
-(defmethod add-reader-method ((class std-class) gf dslotd)
+(defmethod add-reader-method ((class slots-class) gf dslotd)
   (let* ((initargs
           `(:qualifiers nil
@@ -805 +805 @@
 
 
-(defmethod add-writer-method ((class std-class) gf dslotd)
+(defmethod add-writer-method ((class slots-class) gf dslotd)
   (let* ((initargs
           `(:qualifiers nil
@@ -870 +870 @@
    (:name name :initargs (:name) :initform nil :initfunction ,#'false :readers (class-name))
    (:name precedence-list :initargs (:precedence-list) :initform nil  :initfunction ,#'false)
-   (:name own-wrapper :initargs (:own-wrapper) :initform nil  :initfunction ,#'false :readers (class-own-wrapper))
+   (:name own-wrapper :initargs (:own-wrapper) :initform nil  :initfunction ,#'false :readers (class-own-wrapper) :writers ((setf class-own-wrapper)))
    (:name direct-superclasses :initargs (:direct-superclasses) :initform nil  :initfunction ,#'false :readers (class-direct-superclasses))
    (:name direct-subclasses :initargs (:direct-subclasses) :initform nil  :initfunction ,#'false :readers (class-direct-subclasses))
@@ -893 +893 @@
  :direct-superclasses '(class)
  :direct-slots `((:name direct-slots :initform nil :initfunction ,#'false
-                  :initargs (:direct-slots) :readers (class-direct-slots))
+                  :initargs (:direct-slots) :readers (class-direct-slots)
+                  :writers ((setf class-direct-slots)))
                  (:name slots :initform nil :initfunction ,#'false
                    :readers (class-slots))
@@ -1165 +1166 @@
       (fdefinition '%class-direct-slots) #'class-direct-slots
       (fdefinition '(setf %class-direct-slots))
-                   #'(lambda (new class)
-                       (if (typep class 'slots-class)
-                         (setf (slot-value class 'direct-slots) new)
-                         new))
+                   #'(setf class-direct-slots)
       (fdefinition '%class-slots) #'class-slots
       (fdefinition '%class-direct-superclasses) #'class-direct-superclasses
@@ -1175 +1173 @@
           (setf (slot-value class 'direct-superclasses) new))
       (fdefinition '%class-direct-subclasses) #'class-direct-subclasses
+      (fdefinition '%class-own-wrapper) #'class-own-wrapper
+      (fdefinition '(setf %class-own-wrapper)) #'(setf class-own-wrapper)
 )
 
-  
+
+
 (setf (fdefinition '%slot-definition-name) #'slot-definition-name
       (fdefinition '%slot-definition-type) #'slot-definition-type