- ;; We disable package locks here, since defining a class can trigger
- ;; the update of the accessors of another class -- which might lead
- ;; to package lock violations if we didn't.
- (without-package-locks
- (flet ((fix (gfspec name r/w)
- (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)
- (remove-reader-method class gf)))
- (w (if (eq add/remove 'add)
- (add-writer-method class gf name)
- (remove-writer-method class gf)))))))
- (dolist (dslotd dslotds)
- (let ((slot-name (slot-definition-name dslotd)))
- (dolist (r (slot-definition-readers dslotd))
- (fix r slot-name 'r))
- (dolist (w (slot-definition-writers dslotd))
- (fix w slot-name 'w)))))))
+ (flet ((fix (gfspec name r/w)
+ (let ((gf (if (fboundp gfspec)
+ (without-package-locks
+ (ensure-generic-function gfspec))
+ (ensure-generic-function
+ gfspec :lambda-list (case r/w
+ (r '(object))
+ (w '(new-value object)))))))
+ (case r/w
+ (r (if (eq add/remove 'add)
+ (add-reader-method class gf name)
+ (remove-reader-method class gf)))
+ (w (if (eq add/remove 'add)
+ (add-writer-method class gf name)
+ (remove-writer-method class gf)))))))
+ (dolist (dslotd dslotds)
+ (let ((slot-name (slot-definition-name dslotd)))
+ (dolist (r (slot-definition-readers dslotd))
+ (fix r slot-name 'r))
+ (dolist (w (slot-definition-writers dslotd))
+ (fix w slot-name 'w))))))