tests for different constructors

1 files changed, 30 insertions, 37 deletions

diff --git a/mcgoron/weight-balanced-trees/srfi/113/sets.scm b/mcgoron/weight-balanced-trees/srfi/113/sets.scm
index d9552db..7c31ece 100644
--- a/mcgoron/weight-balanced-trees/srfi/113/sets.scm
+++ b/mcgoron/weight-balanced-trees/srfi/113/sets.scm
@@ -107,24 +107,21 @@
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; The whole set
-;;; 
-;;; Although these functions use generators, they cannot use the
-;;; generator SRFIs, because they might include the false value.
-;;; (this is an example of `false` acting like a null value, except
-;;; in the case of generators, there is no clever getting around it
-;;; like `assoc` or `member`).
-;;; 
-;;; Performance note: generators mutate values and hence might not work
-;;; well with write-barrier based systems like Chicken.
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (set-find predicate? set failure)
-  (let ((gen (set->generator set)))
-    (let loop ((value (gen)))
-      (cond
-        ((eof-object? value) (failure))
-        ((predicate? value) value)
-        (else (loop (gen)))))))
+(define set-find
+  (case-lambda
+    ((predicate set default-value)
+     (set-find predicate set default-value (lambda (x) x)))
+    ((predicate set default-value transform)
+     (let loop ((queue (list (get-node set))))
+       (cond
+         ((null? queue) default-value)
+         ((null? (car queue)) (loop (cdr queue)))
+         (else (with-node ((car queue) data ("<" left) (">" right))
+                 (if (predicate data)
+                     (transform data)
+                     (loop (cons* left right (cdr queue)))))))))))
 
 (define (set-count predicate set)
   (define (count node)
@@ -136,33 +133,25 @@
   (count (get-node set)))
 
 (define (set-any? predicate set)
-  (let ((gen (set->generator set)))
-    (let loop ((value (gen)))
-      (cond
-        ((eof-object? value) #f)
-        ((predicate value) #t)
-        (else (loop (gen)))))))
+  (set-find predicate set (lambda () #f) (lambda (x) #t)))
 
 (define (set-every? predicate set)
-  (let ((gen (set->generator set)))
-    (let loop ((value (gen)))
-      (cond
-        ((eof-object? value) #t)
-        ((predicate value) (loop (gen)))
-        (else #f)))))
+  (set-find (lambda (x) (not (predicate x)))
+            set
+            (lambda () #f)
+            (lambda (x) #t)))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Mapping and folding
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define (set-map comparator proc old-set)
-  (let ((gen (set->generator old-set)))
-    (let set-map ((new-node '())
-                  (value (gen)))
-      (if (eof-object? value)
-          (raw-set comparator new-node)
-          (set-map (insert comparator new-node (proc value))
-                   (gen))))))
+  (let ((cmp (set-element-comparator old-set)))
+    (raw-set cmp
+             (set-fold (lambda (value new-node)
+                         (insert cmp new-node (proc value)))
+                       '()
+                       old-set))))
 
 (define (set-for-each proc set)
   (let loop ((node (get-node set)))
@@ -235,10 +224,14 @@
   #;(raw-set (get-element-comparator set) (node-copy node)))
 
 (define (list->set comparator lst)
-  (set-unfold comparator null? car cdr lst))
+  (let loop ((node '())
+             (lst lst))
+    (if (null? lst)
+        (raw-set comparator node)
+        (loop (insert comparator node (car lst)) (cdr lst)))))
 
 (define (set->list set)
-  (generator->list (set->generator set)))
+  (set-fold cons '() set))
 
 (define (list->set! set elements)
   (set-union set (list->set (set-element-comparator set) elements)))