- (let* ((pv-table-symbol (gensym))
- (initargs (copy-tree
- (make-method-function
- (lambda (instance)
- (pv-binding1 (.pv. .calls.
- (symbol-value pv-table-symbol)
- (instance) (instance-slots))
- (instance-boundp-internal
- .pv. instance-slots 1
- (slot-boundp instance slot-name))))))))
- (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)))
-
-(defun initialize-internal-slot-gfs (slot-name &optional type)
- (macrolet ((frob (type name-fun add-fun)
- `(when (or (null type) (eq type ',type))
- (let* ((name (,name-fun slot-name))
- (gf (ensure-generic-function name))
- (methods (generic-function-methods gf)))
- (when (or (null methods)
- (plist-value gf 'slot-missing-method))
- (setf (plist-value gf 'slot-missing-method) nil)
- (,add-fun *the-class-slot-object* gf slot-name))))))
- (frob reader slot-reader-name add-reader-method)
- (frob writer slot-writer-name add-writer-method)
- (frob boundp slot-boundp-name add-boundp-method)))
+ (let* ((initargs (copy-tree
+ (make-method-function
+ (lambda (instance)
+ (pv-binding1 (.pv. .calls.
+ (bug "Please report this")
+ (instance) (instance-slots))
+ (instance-boundp-internal
+ .pv. instance-slots 0
+ (slot-boundp instance slot-name))))))))
+ (setf (getf (getf initargs 'plist) :slot-name-lists)
+ (list (list nil slot-name)))
+ initargs))