string-iterator: use external function to simplify iterative application of predicate

3 files changed, 46 insertions, 41 deletions

diff --git a/generic-iterator.scm b/generic-iterator.scm
index 080f276..3c76400 100644
--- a/generic-iterator.scm
+++ b/generic-iterator.scm
@@ -69,6 +69,13 @@
         comparison-function
         itr-rest)))))
 
+(define (iteratively-apply-predicate predicate? seed lst)
+  (cond
+    ((null? lst) #t)
+    ((predicate? seed (car lst))
+     (iteratively-apply-predicate predicate? (car lst) (cdr lst)))
+    (else #f)))
+
 (define-comparison iterator=? =?)
 (define-comparison iterator<=? <=?)
 (define-comparison iterator>=? >=?)
diff --git a/mcgoron.iterator.base.sld b/mcgoron.iterator.base.sld
index 3c7fe84..79f7830 100644
--- a/mcgoron.iterator.base.sld
+++ b/mcgoron.iterator.base.sld
@@ -21,6 +21,7 @@
           iterator-ref
           iterator->index
           iterator-get-private
-          iterator=? iterator<? iterator>? iterator<=? iterator>=?)
+          iterator=? iterator<? iterator>? iterator<=? iterator>=?
+          iteratively-apply-predicate)
   (include "generic-iterator.scm"))
 
diff --git a/string-iterator.scm b/string-iterator.scm
index 6a7730a..d37be01 100644
--- a/string-iterator.scm
+++ b/string-iterator.scm
@@ -39,46 +39,43 @@
     (else #t)))
 
 (define (cursor->iterator str cursor)
-  (make-iterator
-   (lambda ()
-     (string-cursor=? cursor (string-cursor-start str)))
-   (lambda ()
-     (string-cursor=? cursor (string-cursor-end str)))
-   (lambda (spaces)
-     (cond
-       ((not (string-cursor-valid-movement? str cursor spaces))
-        #f)
-       ((negative? spaces)
-        (cursor->iterator str
-                          (string-cursor-back str
-                                              cursor
-                                              (- spaces))))
-       (else
-        (cursor->iterator str
-                          (string-cursor-forward str
-                                                 cursor
-                                                 spaces)))))
-   (lambda ()
-     (string-ref/cursor str cursor))
-   (lambda ()
-     (string-cursor->index str cursor))
-   (lambda (predicate? other-iterators)
-     (let loop ((rest other-iterators)
-                (current cursor))
-       (if (null? rest)
-           #t
-           (let* ((next-private (iterator-get-private (car rest)))
-                  (next-str (get-str next-private))
-                  (next (get-cursor next-private)))
-             ;; All comparisons are to STR, the string in the first
-             ;; iterator, since they all must be equal.
-             (if (or (not (eq? next-str str))
-                     (not (predicate? string-cursor-comparator
-                                      current
-                                      next)))
-                 #f
-                 (loop (cdr rest) next))))))
-   (raw-fat-cursor str cursor)))
+  (define iterator
+    (make-iterator
+     (lambda ()
+       (string-cursor=? cursor (string-cursor-start str)))
+     (lambda ()
+       (string-cursor=? cursor (string-cursor-end str)))
+     (lambda (spaces)
+       (cond
+         ((not (string-cursor-valid-movement? str cursor spaces))
+          #f)
+         ((negative? spaces)
+          (cursor->iterator str
+                            (string-cursor-back str
+                                                cursor
+                                                (- spaces))))
+         (else
+          (cursor->iterator str
+                            (string-cursor-forward str
+                                                   cursor
+                                                   spaces)))))
+     (lambda ()
+       (string-ref/cursor str cursor))
+     (lambda ()
+       (string-cursor->index str cursor))
+     (lambda (predicate? other-iterators)
+       (iteratively-apply-predicate
+        (lambda (x y)
+          (let ((x (iterator-get-private x))
+                (y (iterator-get-private y)))
+            (and (eq? (get-str x) (get-str y))
+                 (predicate? string-cursor-comparator
+                             (get-cursor x)
+                             (get-cursor y)))))
+        iterator
+        other-iterators))
+     (raw-fat-cursor str cursor)))
+  iterator)
 
 (define-syntax define-for-iterator-or-string
   (syntax-rules ()