;; Display that handles circular lists. (2.04)

(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 "(")
         (loop-inner x seen)
         (display ")"))))

  (define (loop-inner x seen)
    (let ((next-seen (cons x seen)))
      (loop-outer (car x) next-seen)
      (next-inner (cdr x) next-seen)))

  (define (next-inner x seen)
    (if (not (or (null? x)
                 (display-atom-or-cycle x seen " . ")))
        (begin
         (display " ")
         (loop-inner x 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#))