From 0c053e862412143341ce3265673fab2839b82a7b Mon Sep 17 00:00:00 2001 From: Lassi Kortela Date: Wed, 7 Dec 2022 16:12:29 +0200 Subject: [PATCH] Initial commit --- code/floyd.sld | 57 ++++++++++++++++++++++++++++++++++++++++ code/list-error.sld | 35 +++++++++++++++++++++++++ document.md | 63 +++++++++++++++++++++++++++++++++++++++++++++ test/test.scm | 40 ++++++++++++++++++++++++++++ 4 files changed, 195 insertions(+) create mode 100644 code/floyd.sld create mode 100644 code/list-error.sld create mode 100644 document.md create mode 100644 test/test.scm diff --git a/code/floyd.sld b/code/floyd.sld new file mode 100644 index 0000000..d4eeb4e --- /dev/null +++ b/code/floyd.sld @@ -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))))))))))))) diff --git a/code/list-error.sld b/code/list-error.sld new file mode 100644 index 0000000..e7c65d9 --- /dev/null +++ b/code/list-error.sld @@ -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 + (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))))))) diff --git a/document.md b/document.md new file mode 100644 index 0000000..ba72ff8 --- /dev/null +++ b/document.md @@ -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)) +``` diff --git a/test/test.scm b/test/test.scm new file mode 100644 index 0000000..c94d9dd --- /dev/null +++ b/test/test.scm @@ -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)))))