;; Display that handles circular lists. (2.01)
;; @see TX5DMj

(use srfi-1)

(define (my-display x)
  (define (display-atom x prefix)
    (display prefix)
    (display x))

  (define (display-cycle x seen prefix)
    (display prefix)
    (display "#")
    (display (- (list-index (lambda (y) (eq? x y)) seen)))
    (display "#"))

  (define (try-display x seen prefix)
    (cond
     ((not (pair? x))
      (display-atom x prefix)
      #t)
     ((memq x seen)
      (display-cycle x seen prefix)
      #t)
     (else
      #f)))

  (define (loop-outer x seen)
    (if (not (try-display x seen ""))
        (begin
         (display "(")
         (loop-inner x seen "")
         (display ")"))))

  (define (loop-inner x seen separator)
    (if (and (not (null? x))
             (not (try-display x seen " . ")))
        (let ((next-seen (cons x seen)))
          (display separator)
          (loop-outer (car x) next-seen)
          (loop-inner (cdr x) next-seen " "))))

  (loop-outer x '()))

(define (display-nl first . rest)
  (my-display first)
  (for-each (lambda (x) (my-display ", ") (my-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#))