* format.scm (format:obj->str): Handle circular references. Also,

print improper lists with (x y . z) syntax rather than as
individual pairs.  (This code should probably be integrated into C
level facilities.  It is currently terribly slow.)

ice-9/format.scm

@@ -775,68 +775,94 @@
 ;; quoted strings so that the output can always be processed by (read)
 
 (define (format:obj->str obj slashify)
-  (cond
+  (define (obj->str obj slashify visited)
-   ((string? obj)
+    (if (memq obj (cdr visited))
-    (if slashify
+	(let ((n (- (list-index (cdr visited) (cdr obj)))))
-	(let ((obj-len (string-length obj)))
+	  (string-append "#" (number->string n) "#"))
-	  (string-append
+	(cond
-	   "\""
+	 ((string? obj)
-	   (let loop ((i 0) (j 0))	; taken from Marc Feeley's pp.scm
+	  (if slashify
-	     (if (= j obj-len)
+	      (let ((obj-len (string-length obj)))
-		 (string-append (substring obj i j) "\"")
+		(string-append
-		 (let ((c (string-ref obj j)))
+		 "\""
-		   (if (or (char=? c #\\)
+		 (let loop ((i 0) (j 0)) ; taken from Marc Feeley's pp.scm
-			   (char=? c #\"))
+		   (if (= j obj-len)
-		       (string-append (substring obj i j) "\\"
+		       (string-append (substring obj i j) "\"")
-				      (loop j (+ j 1)))
+		       (let ((c (string-ref obj j)))
-		       (loop i (+ j 1))))))))
+			 (if (or (char=? c #\\)
-	obj))
+				 (char=? c #\"))
+			     (string-append (substring obj i j) "\\"
+					    (loop j (+ j 1)))
+			     (loop i (+ j 1))))))))
+	      obj))
    
-   ((boolean? obj) (if obj "#t" "#f"))
+	 ((boolean? obj) (if obj "#t" "#f"))
    
-   ((number? obj) (number->string obj))
+	 ((number? obj) (number->string obj))
 
-   ((symbol? obj) 
+	 ((symbol? obj) 
-    (if format:symbol-case-conv
+	  (if format:symbol-case-conv
-	(format:symbol-case-conv (symbol->string obj))
+	      (format:symbol-case-conv (symbol->string obj))
-	(symbol->string obj)))
+	      (symbol->string obj)))
    
-   ((char? obj)
+	 ((char? obj)
-    (if slashify
+	  (if slashify
-	(format:char->str obj)
+	      (format:char->str obj)
-	(string obj)))
+	      (string obj)))
    
-   ((null? obj) "()")
+	 ((null? obj) "()")
 
-   ((input-port? obj)
+	 ((input-port? obj)
-    (format:iobj->str obj))
+	  (format:iobj->str obj))
    
-   ((output-port? obj)
+	 ((output-port? obj)
-    (format:iobj->str obj))
+	  (format:iobj->str obj))
      
-   ((list? obj)
+	 ((pair? obj)
-    (string-append "("
+	  (string-append "("
-		   (let loop ((obj-list obj))
+			 (let loop ((obj-list obj)
-		     (if (null? (cdr obj-list))
+				    (visited visited)
-			 (format:obj->str (car obj-list) #t)
+				    (offset 0))
-			 (string-append
+			   (cond ((null? (cdr obj-list))
-			  (format:obj->str (car obj-list) #t)
+				  (obj->str (car obj-list)
-			  " "
+					    #t
-			  (loop (cdr obj-list)))))
+					    (cons (car obj-list) visited)))
-		   ")"))
+				 ((memq (cdr obj-list) visited)
+				  (string-append
+				   (obj->str (car obj-list)
+					     #t
+					     (cons (car obj-list) visited))
+				   " . #"
+				   (number->string
+				    (- offset
+				       (list-index visited (cdr obj-list))))
+				   "#"))
+				 ((pair? (cdr obj-list))
+				  (string-append
+				   (obj->str (car obj-list)
+					     #t
+					     (cons (car obj-list) visited))
+				   " "
+				   (loop (cdr obj-list)
+					 (cons (cdr obj-list) visited)
+					 (+ 1 offset))))
+				 (else
+				  (string-append
+				   (obj->str (car obj-list)
+					     #t
+					     (cons (car obj-list) visited))
+				   " . "
+				   (obj->str (cdr obj-list)
+					     #t
+					     (cons (cdr obj-list) visited))))))
+			 ")"))
 
-   ((pair? obj)
+	 ((vector? obj)
-    (string-append "("
+	  (string-append "#" (obj->str (vector->list obj) #t visited)))
-		   (format:obj->str (car obj) #t)
-		   " . "
-		   (format:obj->str (cdr obj) #t)
-		   ")"))
-   
-   ((vector? obj)
-    (string-append "#" (format:obj->str (vector->list obj) #t)))
 
-   (else				; only objects with an #<...> 
+	 (else				; only objects with an #<...> 
-    (format:iobj->str obj))))		; representation should fall in here
+	  (format:iobj->str obj)))))	; representation should fall in here
+  (obj->str obj slashify (list obj)))
 
 ;; format:iobj->str reveals the implementation dependent representation of 
 ;; #<...> objects with the use of display and call-with-output-string.