fork(1) download
copy 
  1. ;; Display that handles circular lists. (2.03)
  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.          (loop-inner x (cons x seen))
  26.          (display ")"))))
  27.  
  28.   (define (loop-inner x seen)
  29.     (loop-outer (car x) seen)
  30.     (next-inner (cdr x) seen))
  31.  
  32.   (define (next-inner x seen)
  33.     (if (not (or (null? x)
  34.                  (display-atom-or-cycle x seen " . ")))
  35.         (begin
  36.          (display " ")
  37.          (loop-inner x (cons x seen)))))
  38.  
  39.   (loop-outer x '()))
  40.  
  41. (define (display-nl first . rest)
  42.   (safe-display first)
  43.   (for-each (lambda (x) (display " ") (safe-display x)) rest)
  44.   (newline))
  45.  
  46. ;; Show.
  47.  
  48. (define (make-cycle x)
  49.   (set-cdr! (last-pair x) x)
  50.   x)
  51.  
  52. (display-nl (list))
  53. (display-nl (list (list)))
  54. (display-nl (list (list (list))))
  55. (display-nl (cons 1 2))
  56.  
  57. (define x (iota 1))
  58. (define y (iota 2))
  59. (define z (iota 3))
  60.  
  61. (display-nl x y z)
  62. (display-nl (make-cycle x))
  63. (display-nl (make-cycle y))
  64. (display-nl (make-cycle z))
  65.  
  66. (define x (iota 1))
  67. (set-car! x x)
  68. (display-nl x)
  69.  
  70. (define x (iota 2))
  71. (set-car! x x)
  72. (display-nl x)
  73.  
  74. (define x (iota 2))
  75. (set-car! (cdr x) x)
  76. (display-nl x)
  77.  
  78. (define x (iota 2))
  79. (set-car! (cdr x) (cdr x))
  80. (display-nl x)
  81.  
  82. (define x (iota 3))
  83. (set-car! (cddr x) x)
  84. (display-nl x)
  85.  
  86. (define x (iota 3))
  87. (set-car! (cddr x) (cdr x))
  88. (display-nl x)
  89.  
  90. (define x (iota 3))
  91. (define y (iota 3))
  92. (set-cdr! (cddr x) y)
  93. (set-car! (cddr x) x)
  94. (display-nl x)
  95.  
  96. (define x (iota 3))
  97. (define y (iota 3))
  98. (set-cdr! (cddr x) y)
  99. (set-car! (cddr y) x)
  100. (display-nl x)
  101. (display-nl y)
  102.  
  103. ;; Expected output.
  104.  
  105. ;()
  106. ;(())
  107. ;((()))
  108. ;(1 . 2)
  109. ;(0) (0 1) (0 1 2)
  110. ;(0 . #0#)
  111. ;(0 1 . #-1#)
  112. ;(0 1 2 . #-2#)
  113. ;(#0#)
  114. ;(#0# 1)
  115. ;(0 #-1#)
  116. ;(0 #0#)
  117. ;(0 1 #-2#)
  118. ;(0 1 #-1#)
  119. ;(0 1 #-2# 0 1 2)
  120. ;(0 1 2 0 1 #-5#)
  121. ;(0 1 (0 1 2 . #-5#))
Success #stdin #stdout 0.01s 8176KB
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/TgzFt7
language:
Scheme (chicken 4.13)
created:
3 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!