(values defstruct-form constructor reader-names writer-names)))
(defun make-defstruct-allocation-function (class)
- (let ((dd (get-structure-dd (class-name class))))
+ ;; FIXME: Why don't we go class->layout->info == dd
+ (let ((dd (find-defstruct-description (class-name class))))
(lambda ()
(sb-kernel::%make-instance-with-layout
(sb-kernel::compiler-layout-or-lose (dd-name dd))))))
(fix-slot-accessors class dslotds 'remove))
(defun fix-slot-accessors (class dslotds add/remove)
- (flet ((fix (gfspec name r/w)
+ (flet ((fix (gfspec name r/w doc)
(let ((gf (cond ((eq add/remove 'add)
(or (find-generic-function gfspec nil)
(ensure-generic-function
(when gf
(case r/w
(r (if (eq add/remove 'add)
- (add-reader-method class gf name)
+ (add-reader-method class gf name doc)
(remove-reader-method class gf)))
(w (if (eq add/remove 'add)
- (add-writer-method class gf name)
+ (add-writer-method class gf name doc)
(remove-writer-method class gf))))))))
(dolist (dslotd dslotds)
- (let ((slot-name (slot-definition-name dslotd)))
+ (let ((slot-name (slot-definition-name dslotd))
+ (slot-doc (%slot-definition-documentation dslotd)))
(dolist (r (slot-definition-readers dslotd))
- (fix r slot-name 'r))
+ (fix r slot-name 'r slot-doc))
(dolist (w (slot-definition-writers dslotd))
- (fix w slot-name 'w))))))
+ (fix w slot-name 'w slot-doc))))))
\f
(defun add-direct-subclasses (class supers)
(dolist (super supers)
(declare (ignore direct-slot initargs))
(find-class 'standard-reader-method))
-(defmethod add-reader-method ((class slot-class) generic-function slot-name)
+(defmethod add-reader-method ((class slot-class) generic-function slot-name slot-documentation)
(add-method generic-function
(make-a-method 'standard-reader-method
()
(list (or (class-name class) 'object))
(list class)
(make-reader-method-function class slot-name)
- "automatically generated reader method"
+ (or slot-documentation "automatically generated reader method")
:slot-name slot-name
:object-class class
:method-class-function #'reader-method-class)))
(declare (ignore direct-slot initargs))
(find-class 'standard-writer-method))
-(defmethod add-writer-method ((class slot-class) generic-function slot-name)
+(defmethod add-writer-method ((class slot-class) generic-function slot-name slot-documentation)
(add-method generic-function
(make-a-method 'standard-writer-method
()
(list 'new-value (or (class-name class) 'object))
(list *the-class-t* class)
(make-writer-method-function class slot-name)
- "automatically generated writer method"
+ (or slot-documentation "automatically generated writer method")
:slot-name slot-name
:object-class class
:method-class-function #'writer-method-class)))
-(defmethod add-boundp-method ((class slot-class) generic-function slot-name)
+(defmethod add-boundp-method ((class slot-class) generic-function slot-name slot-documentation)
(add-method generic-function
(make-a-method (constantly (find-class 'standard-boundp-method))
class
(list (or (class-name class) 'object))
(list class)
(make-boundp-method-function class slot-name)
- "automatically generated boundp method"
+ (or slot-documentation "automatically generated boundp method")
slot-name)))
(defmethod remove-reader-method ((class slot-class) generic-function)
;; layout-depthoid). Is there any way we can provide a useful
;; error message? -- CSR, 2005-05-03
(eq s *the-class-file-stream*) (eq s *the-class-string-stream*)
- ;; TODO
+ ;; This probably shouldn't be mixed in with certain other
+ ;; classes, too, but it seems to work both with STANDARD-OBJECT
+ ;; and FUNCALLABLE-STANDARD-OBJECT
(eq s *the-class-sequence*)))
\f
;;; Some necessary methods for FORWARD-REFERENCED-CLASS