fork(1) download
copy 
  1. ;; Display that handles circular lists. (2.02)
  2.  
  3. (use srfi-1)
  4.  
  5. (define (safe-display x)
  6.   (define (display-atom-or-cycle x seen prefix)
  7.     (cond
  8.      ((not (pair? x))
  9.       (display prefix)
  10.       (display x)
  11.       #t)
  12.      ((memq x seen)
  13.       (display prefix)
  14.       (display "#")
  15.       (display (- (list-index (lambda (y) (eq? x y)) seen)))
  16.       (display "#")
  17.       #t)
  18.      (else
  19.       #f)))
  20.  
  21.   (define (loop-outer x seen)
  22.     (if (not (display-atom-or-cycle x seen ""))
  23.         (begin
  24.          (display "(")
  25.          (if (not (null? x))
  26.              (loop-inner x (cons x seen)))
  27.          (display ")"))))
  28.  
  29.   (define (loop-inner x seen)
  30.     (loop-outer (car x) seen)
  31.     (let ((y (cdr x)))
  32.       (if (not (or (null? y)
  33.                    (display-atom-or-cycle y seen " . ")))
  34.           (begin
  35.            (display " ")
  36.            (loop-inner y (cons y seen))))))
  37.  
  38.   (loop-outer x '()))
  39.  
  40. (define (display-nl first . rest)
  41.   (safe-display first)
  42.   (for-each (lambda (x) (display " ") (safe-display x)) rest)
  43.   (newline))
  44.  
  45. ;; Show.
  46.  
  47. (define (make-cycle x)
  48.   (set-cdr! (last-pair x) x)
  49.   x)
  50.  
  51. (display-nl (list))
  52. (display-nl (list (list)))
  53. (display-nl (list (list (list))))
  54. (display-nl (cons 1 2))
  55.  
  56. (define x (iota 1))
  57. (define y (iota 2))
  58. (define z (iota 3))
  59.  
  60. (display-nl x y z)
  61. (display-nl (make-cycle x))
  62. (display-nl (make-cycle y))
  63. (display-nl (make-cycle z))
  64.  
  65. (define x (iota 1))
  66. (set-car! x x)
  67. (display-nl x)
  68.  
  69. (define x (iota 2))
  70. (set-car! x x)
  71. (display-nl x)
  72.  
  73. (define x (iota 2))
  74. (set-car! (cdr x) x)
  75. (display-nl x)
  76.  
  77. (define x (iota 2))
  78. (set-car! (cdr x) (cdr x))
  79. (display-nl x)
  80.  
  81. (define x (iota 3))
  82. (set-car! (cddr x) x)
  83. (display-nl x)
  84.  
  85. (define x (iota 3))
  86. (set-car! (cddr x) (cdr x))
  87. (display-nl x)
  88.  
  89. (define x (iota 3))
  90. (define y (iota 3))
  91. (set-cdr! (cddr x) y)
  92. (set-car! (cddr x) x)
  93. (display-nl x)
  94.  
  95. (define x (iota 3))
  96. (define y (iota 3))
  97. (set-cdr! (cddr x) y)
  98. (set-car! (cddr y) x)
  99. (display-nl x)
  100. (display-nl y)
  101.  
  102. ;; Expected output.
  103.  
  104. ;()
  105. ;(())
  106. ;((()))
  107. ;(1 . 2)
  108. ;(0) (0 1) (0 1 2)
  109. ;(0 . #0#)
  110. ;(0 1 . #-1#)
  111. ;(0 1 2 . #-2#)
  112. ;(#0#)
  113. ;(#0# 1)
  114. ;(0 #-1#)
  115. ;(0 #0#)
  116. ;(0 1 #-2#)
  117. ;(0 1 #-1#)
  118. ;(0 1 #-2# 0 1 2)
  119. ;(0 1 2 0 1 #-5#)
  120. ;(0 1 (0 1 2 . #-5#))
Success #stdin #stdout 0.01s 8252KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
()
(())
((()))
(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#))
https://ideone.com/eb5Re3
language:
Scheme (chicken 4.13)
created:
4 days ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!