;; Display that handles circular lists. (2.02)

(use srfi-1)

(define (safe-display x)
  (define (display-atom-or-cycle x seen prefix)
    (cond
     ((not (pair? x))
      (display prefix)
      (display x)
      #t)
     ((memq x seen)
      (display prefix)
      (display "#")
      (display (- (list-index (lambda (y) (eq? x y)) seen)))
      (display "#")
      #t)
     (else
      #f)))

  (define (loop-outer x seen)
    (if (not (display-atom-or-cycle x seen ""))
        (begin
         (display "(")
         (if (not (null? x))
             (loop-inner x (cons x seen)))
         (display ")"))))

  (define (loop-inner x seen)
    (loop-outer (car x) seen)
    (let ((y (cdr x)))
      (if (not (or (null? y)
                   (display-atom-or-cycle y seen " . ")))
          (begin
           (display " ")
           (loop-inner y (cons y seen))))))

  (loop-outer x '()))

(define (display-nl first . rest)
  (safe-display first)
  (for-each (lambda (x) (display " ") (safe-display x)) rest)
  (newline))

;; Show.

(define (make-cycle x)
  (set-cdr! (last-pair x) x)
  x)

(display-nl (list))
(display-nl (list (list)))
(display-nl (list (list (list))))
(display-nl (cons 1 2))

(define x (iota 1))
(define y (iota 2))
(define z (iota 3))

(display-nl x y z)
(display-nl (make-cycle x))
(display-nl (make-cycle y))
(display-nl (make-cycle z))

(define x (iota 1))
(set-car! x x)
(display-nl x)

(define x (iota 2))
(set-car! x x)
(display-nl x)

(define x (iota 2))
(set-car! (cdr x) x)
(display-nl x)

(define x (iota 2))
(set-car! (cdr x) (cdr x))
(display-nl x)

(define x (iota 3))
(set-car! (cddr x) x)
(display-nl x)

(define x (iota 3))
(set-car! (cddr x) (cdr x))
(display-nl x)

(define x (iota 3))
(define y (iota 3))
(set-cdr! (cddr x) y)
(set-car! (cddr x) x)
(display-nl x)

(define x (iota 3))
(define y (iota 3))
(set-cdr! (cddr x) y)
(set-car! (cddr y) x)
(display-nl x)
(display-nl y)

;; Expected output.

;()
;(())
;((()))
;(1 . 2)
;(0) (0 1) (0 1 2)
;(0 . #0#)
;(0 1 . #-1#)
;(0 1 2 . #-2#)
;(#0#)
;(#0# 1)
;(0 #-1#)
;(0 #0#)
;(0 1 #-2#)
;(0 1 #-1#)
;(0 1 #-2# 0 1 2)
;(0 1 2 0 1 #-5#)
;(0 1 (0 1 2 . #-5#))