Skip to content
Snippets Groups Projects
Commit f6f272eb authored by wlott's avatar wlott
Browse files

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.
parent 41d26b9e
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -248,27 +248,30 @@
((null (gethash tree *sharp-equal-circle-table*)) ((null (gethash tree *sharp-equal-circle-table*))
(setf (gethash tree *sharp-equal-circle-table*) t) (setf (gethash tree *sharp-equal-circle-table*) t)
(cond ((typep tree 'structure-object) (cond ((typep tree 'structure-object)
(dotimes (i (%instance-length tree) tree) (do ((i 1 (1+ i))
(setf (%instance-ref tree i) (end (%instance-length tree)))
(circle-subst old-new-alist (%instance-ref tree i))))) ((= 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) ((arrayp tree)
(with-array-data ((data tree) (start) (end)) (with-array-data ((data tree) (start) (end))
(declare (fixnum start end)) (declare (fixnum start end))
(do ((i start (1+ i))) (do ((i start (1+ i)))
((>= i end)) ((>= i end))
(setf (aref data i) (let* ((old (aref data i))
(circle-subst old-new-alist (aref data i))))) (new (circle-subst old-new-alist old)))
tree) (unless (eq old new)
(setf (aref data i) new))))))
(t (t
(let ((a (circle-subst old-new-alist (car tree))) (let ((a (circle-subst old-new-alist (car tree)))
(d (circle-subst old-new-alist (cdr tree)))) (d (circle-subst old-new-alist (cdr tree))))
(if (eq a (car tree)) (unless (eq a (car tree))
tree (rplaca tree a))
(rplaca tree a)) (unless (eq d (cdr tree))
(if (eq d (cdr tree)) (rplacd tree d)))))
tree tree)
(rplacd tree d)))
tree)))
(t tree))) (t tree)))
;;; Sharp-equal works as follows. When a label is assigned (ie when #= is ;;; Sharp-equal works as follows. When a label is assigned (ie when #= is
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment