From f6f272ebbf3f59644c4b15682364b7d0d34ed881 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Mon, 15 Mar 1993 00:13:33 +0000
Subject: [PATCH] Fixed CIRCLE-SUBST to not bother looking down the
 instance-layout slot so that splicing structures into the read input doesn't
 result in CIRCLE-SUBST searching though the entire type system for places to
 fix up #n#'s.

---
 code/sharpm.lisp | 31 +++++++++++++++++--------------
 1 file changed, 17 insertions(+), 14 deletions(-)

diff --git a/code/sharpm.lisp b/code/sharpm.lisp
index f9b3aff2e..007b43657 100644
--- a/code/sharpm.lisp
+++ b/code/sharpm.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sharpm.lisp,v 1.11 1993/02/26 08:26:14 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sharpm.lisp,v 1.12 1993/03/15 00:13:33 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -248,27 +248,30 @@
 	((null (gethash tree *sharp-equal-circle-table*))
 	 (setf (gethash tree *sharp-equal-circle-table*) t)
 	 (cond ((typep tree 'structure-object)
-		(dotimes (i (%instance-length tree) tree)
-		  (setf (%instance-ref tree i)
-			(circle-subst old-new-alist (%instance-ref tree i)))))
+		(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))
-		    (setf (aref data i)
-			  (circle-subst old-new-alist (aref data i)))))
-		tree)
+		    (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))))
-		  (if (eq a (car tree))
-		      tree
-		      (rplaca tree a))
-		  (if (eq d (cdr tree))
-		      tree
-		      (rplacd tree d)))
-		  tree)))
+		  (unless (eq a (car tree))
+		    (rplaca tree a))
+		  (unless (eq d (cdr tree))
+		    (rplacd tree d)))))
+	 tree)
 	(t tree)))
 
 ;;; Sharp-equal works as follows.  When a label is assigned (ie when #= is
-- 
GitLab