diff --git a/csi.scm b/csi.scm
index bcb1022..eb52326 100644
a
|
b
|
EOF |
457 | 457 | (lag (cdr lag))) |
458 | 458 | (or (eq? x lag) (lp x lag)))))))) |
459 | 459 | |
| 460 | (define (improper-pairs? x) |
| 461 | (let lp ((x x)) |
| 462 | (if (not (pair? x)) #f |
| 463 | (or (eq? x (car x)) |
| 464 | (lp (cdr x)))))) |
| 465 | |
460 | 466 | (define-constant max-describe-lines 40) |
461 | 467 | |
462 | 468 | (define describer-table (make-vector 37 '())) |
… |
… |
EOF |
533 | 539 | (lambda () |
534 | 540 | (write (cadr plist) out) ) ) |
535 | 541 | (newline out) ) ) ) ] |
536 | | [(circular-list? x) |
537 | | (fprintf out "circular list: ") |
| 542 | [(or (circular-list? x) (improper-pairs? x)) |
| 543 | (fprintf out "circular structure: ") |
538 | 544 | (let loop-print ((x x) |
539 | | (parsed '())) |
540 | | (if (not (memq (car x) parsed)) |
541 | | (begin |
| 545 | (cdr-refs (list x))) |
| 546 | (cond ((or (atom? x) |
| 547 | (null? x)) (printf "eol~%")) |
| 548 | ((memq (car x) cdr-refs) |
| 549 | (fprintf out "(circle)~%" )) |
| 550 | ((not (memq (car x) cdr-refs)) |
542 | 551 | (fprintf out "~S -> " (car x)) |
543 | | (loop-print (cdr x) (cons (car x) parsed))) |
544 | | (fprintf out " ~S (circle)~%" (car (memq (car x) parsed)))))] |
| 552 | (loop-print (cdr x) (cons (car x) cdr-refs) ))))] |
545 | 553 | [(list? x) (descseq "list" length list-ref 0)] |
546 | 554 | [(pair? x) (fprintf out "pair with car ~S and cdr ~S~%" (car x) (cdr x))] |
547 | 555 | [(procedure? x) |