58 lines
2.3 KiB
Scheme
58 lines
2.3 KiB
Scheme
(define-library (floyd)
|
|
(import (scheme base)
|
|
(list-error))
|
|
(export floyd-generator)
|
|
(begin
|
|
|
|
(define (floyd-generator lists)
|
|
;; fast == null or pair [tail] or boolean [circular?]
|
|
(let* ((lists (list->vector lists))
|
|
(slows (vector-copy lists))
|
|
(fasts (vector-copy lists))
|
|
(first-round? #t))
|
|
(let loop ((n (vector-length lists)))
|
|
(unless (zero? n)
|
|
(let* ((i (- n 1))
|
|
(list (vector-ref lists i)))
|
|
(if (or (null? list)
|
|
(pair? list))
|
|
(loop i)
|
|
(error (make-list-error list list))))))
|
|
(lambda ()
|
|
(let loop ((n (vector-length lists))
|
|
(items '())
|
|
(all-circular? #t))
|
|
(if (zero? n)
|
|
(cond (all-circular?
|
|
(eof-object))
|
|
(else
|
|
(set! first-round? #f)
|
|
items))
|
|
(let* ((i (- n 1))
|
|
(list (vector-ref lists i))
|
|
(slow (vector-ref slows i))
|
|
(fast (vector-ref fasts i)))
|
|
(cond ((null? slow)
|
|
(eof-object))
|
|
((not (pair? slow))
|
|
(error (make-list-error list slow)))
|
|
(else
|
|
(unless (boolean? fast)
|
|
(set! fast
|
|
(cond ((and (eq? slow fast)
|
|
(not first-round?))
|
|
#t)
|
|
((not (pair? fast))
|
|
#f)
|
|
((not (pair? (cdr fast)))
|
|
#f)
|
|
((not (pair? (cdr (cdr fast))))
|
|
#f)
|
|
(else
|
|
(cdr (cdr fast))))))
|
|
(vector-set! fasts i fast)
|
|
(vector-set! slows i (cdr slow))
|
|
(loop i
|
|
(cons (car slow) items)
|
|
(and all-circular? (eqv? fast #t)))))))))))))
|