Ticket #117: bug-117.diff

csi.scm

@@ -26 +26 @@
 
 
 (declare
-  (uses chicken-syntax srfi-69 ports extras)
+  (uses chicken-syntax srfi-69 srfi-1 ports extras)
   (usual-integrations)
   (disable-interrupts)
   (disable-warning var)
@@ -525 +525 @@
                     (lambda ()
                       (write (cadr plist) out) ) )
                    (newline out) ) ) ) ]
+            [(circular-list? x) (begin
+                                  (fprintf out "circular list: ")
+                                  (let loop-print ((x x)
+                                                   (parsed '()))
+                                    (if (not (memq (car x) parsed))
+                                        (begin
+                                          (fprintf out "~S -> " (car x))
+                                          (loop-print (cdr x) (cons (car x) parsed)))
+                                        (fprintf out " ~S (circle)~%" (car (memq (car x) parsed))))))]
             [(list? x) (descseq "list" length list-ref 0)]
             [(pair? x) (fprintf out "pair with car ~S and cdr ~S~%" (car x) (cdr x))]
             [(procedure? x)