X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fslots-boot.lisp;h=60d3cec6c796fb2da5c9a043833091252abbd42f;hb=f4820c2cd6eb6af8f21312e2e2ca19af42de4be6;hp=121b97aa7131259fb31451fbc8b512d419fb233d;hpb=c70ef5922e4e5290fab52b90c3614be83c0b8f8b;p=sbcl.git

diff --git a/src/pcl/slots-boot.lisp b/src/pcl/slots-boot.lisp
index 121b97a..60d3cec 100644
--- a/src/pcl/slots-boot.lisp
+++ b/src/pcl/slots-boot.lisp
@@ -403,86 +403,45 @@
        (boundp (lambda (instance)
                  (emf-funcall sdfun class instance slotd))))
      `(,name ,(class-name class) ,(slot-definition-name slotd)))))
-
-(defun make-internal-reader-method-function (class-name slot-name)
-  (list* :method-spec `(internal-reader-method ,class-name ,slot-name)
-         (make-method-function
-          (lambda (instance)
-            (let ((wrapper (get-instance-wrapper-or-nil instance)))
-              (if wrapper
-                  (let* ((class (wrapper-class* wrapper))
-                         (index (or (instance-slot-index wrapper slot-name)
-                                    (assq slot-name
-                                          (wrapper-class-slots wrapper)))))
-                    (typecase index
-                      (fixnum
-                       (let ((value (clos-slots-ref (get-slots instance)
-                                                    index)))
-                         (if (eq value +slot-unbound+)
-                             (values (slot-unbound (class-of instance)
-                                                   instance
-                                                   slot-name))
-                             value)))
-                      (cons
-                       (let ((value (cdr index)))
-                         (if (eq value +slot-unbound+)
-                             (values (slot-unbound (class-of instance)
-                                                   instance
-                                                   slot-name))
-                             value)))
-                      (t
-                       (error "~@<The wrapper for class ~S does not have ~
-                               the slot ~S~@:>"
-                              class slot-name))))
-                  (slot-value instance slot-name)))))))
 
 (defun make-std-reader-method-function (class-name slot-name)
-  (let* ((pv-table-symbol (gensym))
-         (initargs (copy-tree
+  (let* ((initargs (copy-tree
                     (make-method-function
                      (lambda (instance)
                        (pv-binding1 (.pv. .calls.
-                                          (symbol-value pv-table-symbol)
+                                          (bug "Please report this")
                                           (instance) (instance-slots))
                          (instance-read-internal
-                          .pv. instance-slots 1
+                          .pv. instance-slots 0
                           (slot-value instance slot-name))))))))
-    (setf (getf (getf initargs :plist) :slot-name-lists)
+    (setf (getf (getf initargs 'plist) :slot-name-lists)
           (list (list nil slot-name)))
-    (setf (getf (getf initargs :plist) :pv-table-symbol) pv-table-symbol)
-    (list* :method-spec `(reader-method ,class-name ,slot-name)
-           initargs)))
+    initargs))
 
 (defun make-std-writer-method-function (class-name slot-name)
-  (let* ((pv-table-symbol (gensym))
-         (initargs (copy-tree
+  (let* ((initargs (copy-tree
                     (make-method-function
                      (lambda (nv instance)
                        (pv-binding1 (.pv. .calls.
-                                          (symbol-value pv-table-symbol)
+                                          (bug "Please report this")
                                           (instance) (instance-slots))
                          (instance-write-internal
-                          .pv. instance-slots 1 nv
+                          .pv. instance-slots 0 nv
                           (setf (slot-value instance slot-name) nv))))))))
-    (setf (getf (getf initargs :plist) :slot-name-lists)
+    (setf (getf (getf initargs 'plist) :slot-name-lists)
           (list nil (list nil slot-name)))
-    (setf (getf (getf initargs :plist) :pv-table-symbol) pv-table-symbol)
-    (list* :method-spec `(writer-method ,class-name ,slot-name)
-           initargs)))
+    initargs))
 
 (defun make-std-boundp-method-function (class-name slot-name)
-  (let* ((pv-table-symbol (gensym))
-         (initargs (copy-tree
+  (let* ((initargs (copy-tree
                     (make-method-function
                      (lambda (instance)
                        (pv-binding1 (.pv. .calls.
-                                          (symbol-value pv-table-symbol)
+                                          (bug "Please report this")
                                           (instance) (instance-slots))
                           (instance-boundp-internal
-                           .pv. instance-slots 1
+                           .pv. instance-slots 0
                            (slot-boundp instance slot-name))))))))
-    (setf (getf (getf initargs :plist) :slot-name-lists)
+    (setf (getf (getf initargs 'plist) :slot-name-lists)
           (list (list nil slot-name)))
-    (setf (getf (getf initargs :plist) :pv-table-symbol) pv-table-symbol)
-    (list* :method-spec `(boundp-method ,class-name ,slot-name)
-           initargs)))
+    initargs))