Initial commit
This commit is contained in:
commit
0c053e8624
|
|
@ -0,0 +1,57 @@
|
|||
(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)))))))))))))
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
(define-library (list-error)
|
||||
(import (scheme base))
|
||||
(export make-list-error
|
||||
list-error-list
|
||||
list-error-tail
|
||||
list-error-message
|
||||
list-error?
|
||||
circular-list-error?
|
||||
dotted-list-error?)
|
||||
(begin
|
||||
|
||||
(define-record-type <list-error>
|
||||
(make-list-error list tail)
|
||||
list-error?
|
||||
(list list-error-list)
|
||||
(tail list-error-tail))
|
||||
|
||||
(define (list-error-message err)
|
||||
(let ((tail (list-error-tail obj)))
|
||||
(cond ((null? tail)
|
||||
"Proper list")
|
||||
((pair? tail)
|
||||
"Circular list")
|
||||
((eq? tail (list-error-list obj))
|
||||
"Not a list")
|
||||
(else
|
||||
"Dotted list"))))
|
||||
|
||||
(define (circular-list-error? obj)
|
||||
(and (list-error? obj)
|
||||
(pair? (list-error-tail obj))))
|
||||
|
||||
(define (dotted-list-error? obj)
|
||||
(and (list-error? obj)
|
||||
(not (null-or-pair? (list-error-tail obj)))))))
|
||||
|
|
@ -0,0 +1,63 @@
|
|||
# SR 2022-x: Floyd library
|
||||
|
||||
## Author
|
||||
|
||||
Lassi Kortela
|
||||
|
||||
## Status
|
||||
|
||||
Draft
|
||||
|
||||
## Abstract
|
||||
|
||||
Floyd's "tortoise and hare" is a simple, space-efficient algorithm to
|
||||
detect a circular linked list. This is an exploration of how to
|
||||
package Floyd as a convenient abstraction and how to use it to
|
||||
implement well-known list procedures.
|
||||
|
||||
## Specification
|
||||
|
||||
`(floyd-generator lists) -> procedure`
|
||||
|
||||
Return a generator (in the sense of SRFI 158). Successive calls to the
|
||||
generator yield lists of adjacent elements from _lists_. All _lists_
|
||||
are traversed in order.
|
||||
|
||||
For example, calls to the generator returned by `(floyd-generator '((1
|
||||
2 3) (a b c)))` yield `(1 a)` then `(2 b)` then `(3 c)`. An exhausted
|
||||
generator returns an end-of-file object.
|
||||
|
||||
If no _lists_ are given, the generator is exhausted immediately.
|
||||
|
||||
If one or more non-circular _lists_ are given, the generator stops at
|
||||
the end of the shortest. If both circular and non-circular lists are
|
||||
given, the circular lists are cycled until the end of the shortest
|
||||
non-circular list is reached.
|
||||
|
||||
The generator is also exhausted if and when it notices that all
|
||||
_lists_ are circular.
|
||||
|
||||
It is acceptable for _lists_ to contain the same list more than once.
|
||||
|
||||
It is acceptable for any list in _lists_ to be a tail of another list
|
||||
in _lists_.
|
||||
|
||||
It is acceptable for the caller to mutate any list in _lists_ that the
|
||||
generator will not visit again. Once a given list element has been
|
||||
returned by the generator, the cdr of the pair containing that element
|
||||
may be mutated; the generator remembers the old cdr.
|
||||
|
||||
## Examples
|
||||
|
||||
```
|
||||
> (generator->list (floyd-generator '((1 2 3 4) '(a b c d) '(x y z))))
|
||||
((1 a x)
|
||||
(2 b y)
|
||||
(3 c z))
|
||||
|
||||
> (generator->list (floyd-generator `((1 2 3 4) ,(circular-list 'odd 'even))))
|
||||
((1 odd)
|
||||
(2 even)
|
||||
(3 odd)
|
||||
(4 even))
|
||||
```
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
(import (scheme base)
|
||||
(scheme write)
|
||||
(list-error)
|
||||
(floyd))
|
||||
|
||||
(define (circular-list first . rest)
|
||||
(let ((head (list first)))
|
||||
(let loop ((tail head) (rest rest))
|
||||
(cond ((null? rest)
|
||||
(set-cdr! tail head)
|
||||
head)
|
||||
(else
|
||||
(set-cdr! tail (list (car rest)))
|
||||
(loop (cdr tail) (cdr rest)))))))
|
||||
|
||||
(define (generator->list g)
|
||||
(let loop ((xs '()))
|
||||
(let ((x (g)))
|
||||
(if (eof-object? x)
|
||||
(reverse xs)
|
||||
(loop (cons x xs))))))
|
||||
|
||||
(define-syntax show
|
||||
(syntax-rules ()
|
||||
((show expr)
|
||||
(begin (write 'expr)
|
||||
(write-string " => ")
|
||||
(write expr)
|
||||
(newline)))))
|
||||
|
||||
(show (generator->list (floyd-generator '((1 2 3 4) (a b c d) (x y z)))))
|
||||
|
||||
(show (generator->list (floyd-generator '((1 2 3 4) (a b c d) (x y z å)))))
|
||||
|
||||
(show (generator->list (floyd-generator '((1 2 3 4) (a b c d) ()))))
|
||||
|
||||
(show (generator->list (floyd-generator (list '(1 2 3 4)
|
||||
(circular-list 'a 'b 'c)))))
|
||||
(show (generator->list (floyd-generator (list (circular-list 1 2 3 4 5 6)
|
||||
(circular-list 'a 'b)))))
|
||||
Loading…
Reference in New Issue