- (cond ((not (typep tree
- '(or cons (array t) structure-object standard-object)))
- (let ((entry (find tree old-new-alist :key #'second)))
- (if entry (third entry) tree)))
- ((null (gethash tree *sharp-equal-circle-table*))
- (setf (gethash tree *sharp-equal-circle-table*) t)
- (cond ((typep tree '(or structure-object standard-object))
- (do ((i 1 (1+ i))
- (end (%instance-length tree)))
- ((= i end))
- (let* ((old (%instance-ref tree i))
- (new (circle-subst old-new-alist old)))
- (unless (eq old new)
- (setf (%instance-ref tree i) new)))))
- ((arrayp tree)
- (with-array-data ((data tree) (start) (end))
- (declare (fixnum start end))
- (do ((i start (1+ i)))
- ((>= i end))
- (let* ((old (aref data i))
- (new (circle-subst old-new-alist old)))
- (unless (eq old new)
- (setf (aref data i) new))))))
- (t
- (let ((a (circle-subst old-new-alist (car tree)))
- (d (circle-subst old-new-alist (cdr tree))))
- (unless (eq a (car tree))
- (rplaca tree a))
- (unless (eq d (cdr tree))
- (rplacd tree d)))))
- tree)
- (t tree)))
+ (cond ((not (typep tree '(or cons (array t) instance funcallable-instance)))
+ (let ((entry (find tree old-new-alist :key #'second)))
+ (if entry (third entry) tree)))
+ ((null (gethash tree *sharp-equal-circle-table*))
+ (setf (gethash tree *sharp-equal-circle-table*) t)
+ (cond ((consp tree)
+ (let ((a (circle-subst old-new-alist (car tree)))
+ (d (circle-subst old-new-alist (cdr tree))))
+ (unless (eq a (car tree))
+ (rplaca tree a))
+ (unless (eq d (cdr tree))
+ (rplacd tree d))))
+ ((arrayp tree)
+ (with-array-data ((data tree) (start) (end))
+ (declare (fixnum start end))
+ (do ((i start (1+ i)))
+ ((>= i end))
+ (let* ((old (aref data i))
+ (new (circle-subst old-new-alist old)))
+ (unless (eq old new)
+ (setf (aref data i) new))))))
+ ((typep tree 'instance)
+ (let* ((n-untagged (layout-n-untagged-slots (%instance-layout tree)))
+ (n-tagged (- (%instance-length tree) n-untagged)))
+ ;; N-TAGGED includes the layout as well (at index 0), which
+ ;; we don't grovel.
+ (do ((i 1 (1+ i)))
+ ((= i n-tagged))
+ (let* ((old (%instance-ref tree i))
+ (new (circle-subst old-new-alist old)))
+ (unless (eq old new)
+ (setf (%instance-ref tree i) new))))
+ (do ((i 0 (1+ i)))
+ ((= i n-untagged))
+ (let* ((old (%raw-instance-ref/word tree i))
+ (new (circle-subst old-new-alist old)))
+ (unless (= old new)
+ (setf (%raw-instance-ref/word tree i) new))))))
+ ((typep tree 'funcallable-instance)
+ (do ((i 1 (1+ i))
+ (end (- (1+ (get-closure-length tree)) sb!vm:funcallable-instance-info-offset)))
+ ((= i end))
+ (let* ((old (%funcallable-instance-info tree i))
+ (new (circle-subst old-new-alist old)))
+ (unless (eq old new)
+ (setf (%funcallable-instance-info tree i) new))))))
+ tree)
+ (t tree)))