X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fstd-class.lisp;h=5e0249a7f1a70e443c063d13ff362246d9a5d1d6;hb=4ed3f0d08c3a57a6762018d9622f253ab9d0f2b6;hp=50fd53a2f643bbadd133b239276609d4c6e8b248;hpb=7f13323739a0d2b474bfd5c740942db5a78349d6;p=sbcl.git

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index 50fd53a..5e0249a 100644
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -118,50 +118,6 @@
 (defmethod slot-definition-allocation ((slotd structure-slot-definition))
   :instance)
 
-(defmethod shared-initialize :after ((object documentation-mixin)
-				     slot-names
-				     &key (documentation nil documentation-p))
-  (declare (ignore slot-names))
-  (when documentation-p
-    (setf (plist-value object 'documentation) documentation)))
-
-;;; default if DOC-TYPE doesn't match one of the specified types
-(defmethod documentation (object doc-type)
-  (warn "unsupported DOCUMENTATION: type ~S for object ~S"
-	doc-type
-	(type-of object))
-  nil)
-
-;;; default if DOC-TYPE doesn't match one of the specified types
-(defmethod (setf documentation) (new-value object doc-type)
-  ;; CMU CL made this an error, but since ANSI says that even for supported
-  ;; doc types an implementation is permitted to discard docs at any time
-  ;; for any reason, this feels to me more like a warning. -- WHN 19991214
-  (warn "discarding unsupported DOCUMENTATION of type ~S for object ~S"
-	doc-type
-	(type-of object))
-  new-value)
-
-(defmethod documentation ((object documentation-mixin) doc-type)
-  (declare (ignore doc-type))
-  (plist-value object 'documentation))
-
-(defmethod (setf documentation) (new-value
-				 (object documentation-mixin)
-				 doc-type)
-  (declare (ignore doc-type))
-  (setf (plist-value object 'documentation) new-value))
-
-(defmethod documentation ((slotd standard-slot-definition) doc-type)
-  (declare (ignore doc-type))
-  (slot-value slotd 'documentation))
-
-(defmethod (setf documentation) (new-value
-				 (slotd standard-slot-definition)
-				 doc-type)
-  (declare (ignore doc-type))
-  (setf (slot-value slotd 'documentation) new-value))
-
 ;;;; various class accessors that are a little more complicated than can be
 ;;;; done with automatically generated reader methods
 
@@ -661,7 +617,7 @@
 	      ;; FIXME: FIND-SLOT-DEFAULT throws an error if the slot
 	      ;; is unbound; maybe it should be a CELL-ERROR of some
 	      ;; sort?
-	      (error () (slot-unbound class x slot-name)))))
+	      (error () (values (slot-unbound class x slot-name))))))
     (setf (slot-definition-writer-function slotd)
 	  (lambda (v x)
 	    (condition-writer-function x v slot-name)))
@@ -841,7 +797,10 @@
 
 (defun fix-slot-accessors (class dslotds add/remove)
   (flet ((fix (gfspec name r/w)
-	   (let ((gf (ensure-generic-function gfspec)))
+	   (let* ((ll (case r/w (r '(object)) (w '(new-value object))))
+		  (gf (if (fboundp gfspec)
+			  (ensure-generic-function gfspec)
+			  (ensure-generic-function gfspec :lambda-list ll))))
 	     (case r/w
 	       (r (if (eq add/remove 'add)
 		      (add-reader-method class gf name)