lassik
/
floyd-library
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Initial commit

This commit is contained in:
Lassi Kortela 2022-12-07 16:12:29 +02:00
commit 0c053e8624
4 changed files with 195 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
code/floyd.sld Normal file
View File

@ -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)))))))))))))

35
code/list-error.sld Normal file
View File

@ -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)))))))

63
document.md Normal file
View File

@ -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))
```

40
test/test.scm Normal file
View File

@ -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)))))