From 019d9624bd9144880ce5fae028d180bf1212d646 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Sun, 14 Jun 1992 07:29:18 +0000
Subject: [PATCH] Changed DEFAULT-STRUCTURE-PRINTER to conform to changes to
 the printer.

---
 code/defstruct.lisp | 81 ++++++++++++++++++++++-----------------------
 1 file changed, 40 insertions(+), 41 deletions(-)

diff --git a/code/defstruct.lisp b/code/defstruct.lisp
index 5d5521c85..771d15c1d 100644
--- a/code/defstruct.lisp
+++ b/code/defstruct.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/defstruct.lisp,v 1.33 1992/04/02 02:28:34 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.34 1992/06/14 07:29:18 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -678,46 +678,45 @@
   (declare (ignore depth))
   (let* ((type (structure-ref structure 0))
 	 (dd (info type defined-structure-info type)))
-    (cond (*print-pretty*
-	   (pprint-logical-block (stream structure :allow-atoms t
-					 :prefix "#S(" :suffix ")")
-	     (prin1 type stream)
-	     (let ((slots (dd-slots dd)))
-	       (when slots
-		 (write-char #\space stream)
-		 (pprint-indent :block 2 stream)
-		 (pprint-newline :linear stream)
-		 (loop
-		   (pprint-pop)
-		   (let ((slot (pop slots)))
-		     (write-char #\: stream)
-		     (output-symbol-name (dsd-%name slot) stream)
-		     (write-char #\space stream)
-		     (pprint-newline :miser stream)
-		     (output-object (structure-ref structure (dsd-index slot))
-				    stream)
-		     (when (null slots)
-		       (return))
-		     (write-char #\space stream)
-		     (pprint-newline :linear stream)))))))
-	  (t
-	   (write-string "#S(" stream)
-	   (prin1 type stream)
-	   (do ((index 1 (1+ index))
-		(length (structure-length structure))
-		(slots (dd-slots dd) (cdr slots)))
-	       ((or (= index length)
-		    (and *print-length*
-			 (= index *print-length*)))
-		(if (= index length)
-		    (write-string ")" stream)
-		    (write-string "...)" stream)))
-	     (declare (type index index))
-	     (write-char #\space stream)
-	     (write-char #\: stream)
-	     (output-symbol-name (dsd-%name (car slots)) stream)
-	     (write-char #\space stream)
-	     (output-object (structure-ref structure index) stream))))))
+    (if *print-pretty*
+	(pprint-logical-block (stream nil :prefix "#S(" :suffix ")")
+	  (prin1 type stream)
+	  (let ((slots (dd-slots dd)))
+	    (when slots
+	      (write-char #\space stream)
+	      (pprint-indent :block 2 stream)
+	      (pprint-newline :linear stream)
+	      (loop
+		(pprint-pop)
+		(let ((slot (pop slots)))
+		  (write-char #\: stream)
+		  (output-symbol-name (dsd-%name slot) stream)
+		  (write-char #\space stream)
+		  (pprint-newline :miser stream)
+		  (output-object (structure-ref structure (dsd-index slot))
+				 stream)
+		  (when (null slots)
+		    (return))
+		  (write-char #\space stream)
+		  (pprint-newline :linear stream))))))
+	(descend-into (stream)
+	  (write-string "#S(" stream)
+	  (prin1 type stream)
+	  (do ((index 1 (1+ index))
+	       (length (structure-length structure))
+	       (slots (dd-slots dd) (cdr slots)))
+	      ((or (= index length)
+		   (and *print-length*
+			(= index *print-length*)))
+	       (if (= index length)
+		   (write-string ")" stream)
+		   (write-string "...)" stream)))
+	    (declare (type index index))
+	    (write-char #\space stream)
+	    (write-char #\: stream)
+	    (output-symbol-name (dsd-%name (car slots)) stream)
+	    (write-char #\space stream)
+	    (output-object (structure-ref structure index) stream))))))
 
 
 (defun make-structure-load-form (structure)
-- 
GitLab