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