From 9fae17c411bdcb5221933576b0a0f8251937b09e Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 22 Nov 2005 15:08:23 +0000
Subject: [PATCH] pretty-print needs to combine custom-write? with
 not-struct-type?

svn: r1370
---
 collects/mzlib/pretty.ss | 21 ++++++++++++++-------
 1 file changed, 14 insertions(+), 7 deletions(-)

diff --git a/collects/mzlib/pretty.ss b/collects/mzlib/pretty.ss
index 236dfce9d3..46f3381dff 100644
--- a/collects/mzlib/pretty.ss
+++ b/collects/mzlib/pretty.ss
@@ -411,7 +411,8 @@
 	     (and (or (vector? obj)
 		      (pair? obj)
 		      (box? obj)
-		      (custom-write? obj)
+		      (and (custom-write? obj)
+			   (not (struct-type? obj)))
 		      (and (struct? obj) print-struct?)
 		      (and (hash-table? obj) print-hash-table?))
 		  (or (hash-table-get table obj (lambda () #f))
@@ -430,7 +431,8 @@
 				 (or (loop (car obj))
 				     (loop (cdr obj)))]
 				[(box? obj) (loop (unbox obj))]
-				[(custom-write? obj)
+				[(and (custom-write? obj)
+				      (not (struct-type? obj)))
 				 (loop (extract-sub-objects obj pport))]
 				[(struct? obj)
 				 (ormap loop 
@@ -453,7 +455,8 @@
 	   (if (or (vector? obj)
 		   (pair? obj)
 		   (box? obj)
-		   (custom-write? obj)
+		   (and (custom-write? obj)
+			(not (struct-type? obj)))
 		   (and (struct? obj) print-struct?)
 		   (and (hash-table? obj) print-hash-table?))
 	       ;; A little confusing: use #t for not-found
@@ -473,7 +476,8 @@
 			   (loop (car obj))
 			   (loop (cdr obj))]
 			  [(box? obj) (loop (unbox obj))]
-			  [(custom-write? obj)
+			  [(and (custom-write? obj)
+				(not (struct-type? obj)))
 			   (loop (extract-sub-objects obj pport))]
 			  [(struct? obj)
 			   (for-each loop 
@@ -640,7 +644,8 @@
 	      (lambda ()
 		(out "#&") 
 		(wr (unbox obj) (dsub1 depth))))]
-	    [(custom-write? obj) 
+	    [(and (custom-write? obj) 
+		  (not (struct-type? obj)))
 	     (check-expr-found
 	      obj pport #t
 	      #f #f
@@ -718,7 +723,8 @@
 	 (let* ([can-multi (and width
 				(or (pair? obj) (vector? obj) 
 				    (box? obj) 
-				    (custom-write? obj)
+				    (and (custom-write? obj)
+					 (not (struct-type? obj)))
 				    (and (struct? obj) print-struct?)
 				    (and (hash-table? obj) print-hash-table?)))]
 		[graph-ref (if can-multi
@@ -757,7 +763,8 @@
 			   (when print-vec-length?
 			     (out (number->string (vector-length obj))))
 			   (pp-list (vector->repeatless-list obj) extra pp-expr #f depth)]
-			  [(custom-write? obj)
+			  [(and (custom-write? obj)
+				(not (struct-type? obj)))
 			   (write-custom pp* obj pport depth display? width)]
 			  [(struct? obj) ; print-struct is on if we got here
 			   (out "#")