- (destructuring-bind
- ;; FIXME: In CMU CL ca. 19991205, this binding list had a
- ;; fourth element in it, NEW-VALUE. It's hard to see how
- ;; that could possibly be right, since SLOT-BOUNDP has no
- ;; NEW-VALUE. Since it was causing a failure in building PCL
- ;; for SBCL, so I changed it to match the definition of
- ;; SLOT-BOUNDP (and also to match the list used in the
- ;; similar OPTIMIZE-SLOT-VALUE, above). However, I'm weirded
- ;; out by this, since this is old code which has worked for
- ;; ages to build PCL for CMU CL, so it's hard to see why it
- ;; should need a patch like this in order to build PCL for
- ;; SBCL. I'd like to return to this and find a test case
- ;; which exercises this function both in CMU CL, to see
- ;; whether it's really a previously-unexercised bug or
- ;; whether I've misunderstood something (and, presumably,
- ;; patched it wrong).
- (slot-boundp-symbol instance slot-name-form)
- form
- (declare (ignore slot-boundp-symbol instance))
- (let ((slot-name (eval slot-name-form)))
- (optimize-instance-access slots
- :boundp
- sparameter
- slot-name
- nil)))
+ (let ((optimized-form
+ (destructuring-bind
+ ;; FIXME: In CMU CL ca. 19991205, this binding list
+ ;; had a fourth element in it, NEW-VALUE. It's hard
+ ;; to see how that could possibly be right, since
+ ;; SLOT-BOUNDP has no NEW-VALUE. Since it was
+ ;; causing a failure in building PCL for SBCL, so I
+ ;; changed it to match the definition of
+ ;; SLOT-BOUNDP (and also to match the list used in
+ ;; the similar OPTIMIZE-SLOT-VALUE,
+ ;; above). However, I'm weirded out by this, since
+ ;; this is old code which has worked for ages to
+ ;; build PCL for CMU CL, so it's hard to see why it
+ ;; should need a patch like this in order to build
+ ;; PCL for SBCL. I'd like to return to this and
+ ;; find a test case which exercises this function
+ ;; both in CMU CL, to see whether it's really a
+ ;; previously-unexercised bug or whether I've
+ ;; misunderstood something (and, presumably,
+ ;; patched it wrong).
+ (slot-boundp-symbol instance slot-name-form)
+ form
+ (declare (ignore slot-boundp-symbol instance))
+ (let ((slot-name (eval slot-name-form)))
+ (optimize-instance-access slots
+ :boundp
+ sparameter
+ slot-name
+ nil)))))
+ ;; See OPTIMIZE-SLOT-VALUE
+ `(optimized-slot-boundp ,form ,(car sparameter) ,optimized-form))