refactor iterator to be simpler

1 files changed, 68 insertions, 124 deletions

diff --git a/string-iterator.scm b/string-iterator.scm
index 8589bdf..6a7730a 100644
--- a/string-iterator.scm
+++ b/string-iterator.scm
@@ -14,40 +14,16 @@
  |#
 
 (define-record-type <fat-cursor>
-  (make-fat-cursor str srfi-130-cursor)
+  (raw-fat-cursor str cursor)
   fat-cursor?
   (str get-str)
-  (srfi-130-cursor get-srfi-130-cursor))
+  (cursor get-cursor))
 
-(define-syntax lambda-fat-cursor
-  (syntax-rules ()
-    ((lambda-fat-cursor (str cursor rest ...) body ...)
-     (lambda (fat-cursor rest ...)
-       (let ((str (get-str fat-cursor))
-             (cursor (get-srfi-130-cursor fat-cursor)))
-         body ...)))))
-
-(define (recursively-compare predicate?)
-  (letrec ((cmp
-            (case-lambda
-              ((_) #t)
-              ((fc1 fc2)
-               (and (eq? (get-str fc1) (get-str fc2))
-                    (predicate? (get-srfi-130-cursor fc1)
-                                (get-srfi-130-cursor fc2))))
-              ((fc1 fc2 . fc-rest)
-               (and (cmp fc1 fc2)
-                    (apply cmp fc2 fc-rest))))))
-    cmp))
-
-(define fat-cursor=? (recursively-compare string-cursor=?))
-(define fat-cursor<? (recursively-compare string-cursor<?))
-
-(define fat-cursor-comparator
+(define string-cursor-comparator
   (make-comparator
-   fat-cursor?
-   fat-cursor=?
-   fat-cursor<?
+   string-cursor?
+   string-cursor=?
+   string-cursor<?
    #f))
 
 (define (string-cursor-valid-movement? str cursor spaces)
@@ -62,99 +38,67 @@
          (string-cursor-diff str cursor (string-cursor-end str))))
     (else #t)))
 
-(define string-iterator-implementation
-  (letrec* ((make-string-iterator
-             (lambda (str cursor)
-               (make-iterator impl
-                              (make-fat-cursor str cursor))))
-            (start
-             (lambda (object)
-               (cond
-                 ((string? object)
-                  (make-string-iterator object
-                                        (string-cursor-start object)))
-                 ((fat-cursor? object)
-                  (make-string-iterator (get-str object)
-                                        (string-cursor-start
-                                         (get-str object))))
-                 (else (error "invalid object for start" object)))))
-            (end
-             (lambda (object)
-               (cond
-                 ((string? object)
-                  (make-string-iterator object
-                                        (string-cursor-end object)))
-                 ((fat-cursor? object)
-                  (make-string-iterator (get-str object)
-                                        (string-cursor-end
-                                         (get-str object))))
-                 (else (error "invalid object for end" object)))))
-            (start?
-             (lambda-fat-cursor (str cursor)
-               (string-cursor=? cursor (string-cursor-start str))))
-            (end?
-             (lambda-fat-cursor (str cursor)
-               (string-cursor=? cursor (string-cursor-end str))))
-            (advance
-             (lambda-fat-cursor (str cursor spaces)
-               (cond
-                 ((not (string-cursor-valid-movement? str cursor spaces))
-                  #f)
-                 ((negative? spaces)
-                  (make-string-iterator str
-                                        (string-cursor-back str
-                                                            cursor
-                                                            (- spaces))))
-                 (else
-                  (make-string-iterator str
-                                        (string-cursor-forward str
-                                                               cursor
-                                                               spaces))))))
-            (ref
-             (lambda (fat-cursor)
-               (if (end? fat-cursor)
-                   (error "cannot ref one past the end of the sequence"
-                          fat-cursor)
-                   (string-ref/cursor (get-str fat-cursor)
-                                      (get-srfi-130-cursor fat-cursor)))))
-            (to-index
-             (lambda-fat-cursor (str cursor)
-               (string-cursor->index str cursor)))
-            (from-index%string
-             (lambda (str index)
-               (make-string-iterator str
-                                     (string-index->cursor str index))))
-            (from-index
-             (lambda (obj index)
-               (cond
-                 ((string? obj) (from-index%string obj index))
-                 ((fat-cursor? obj)
-                  (from-index%string (get-str obj) index))
-                 (else (error "invalid object for from-index" obj index)))))
-            (impl
-             (make-iterator-implementation
-              start end
-              start? end?
-              advance ref
-              to-index from-index
-              fat-cursor-comparator)))
-    impl))
+(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-syntax define-for-iterator-or-string
+  (syntax-rules ()
+    ((_ (name str args ...) body ...)
+     (define (name object args ...)
+       (define (internal str args ...)
+         body ...)
+       (cond
+         ((string? object) (internal object args ...))
+         ((iterator? object) (internal (get-str (iterator-get-private
+                                                 object))
+                                       args ...))
+         (else (error "invalid type of object" object)))))))
+
+(define-for-iterator-or-string (string-iterator-start str)
+  (cursor->iterator str (string-cursor-start str)))
+
+(define-for-iterator-or-string (string-iterator-end str)
+  (cursor->iterator str (string-cursor-end str)))
 
-(define (constructor-for-iterator-or-string procedure)
-  (lambda (object . rest)
-    (cond
-      ((string? object) (apply procedure
-                               string-iterator-implementation
-                               object
-                               rest))
-      ((iterator? object) (apply procedure
-                                 object
-                                 rest))
-      (else (error "invalid object" object rest)))))
+(define-for-iterator-or-string (string-index->iterator str idx)
+  (cursor->iterator str (string-index->cursor str idx)))
 
-(define string-iterator-start
-  (constructor-for-iterator-or-string iterator-at-start))
-(define string-iterator-end
-  (constructor-for-iterator-or-string iterator-at-end))
-(define string-index->iterator
-  (constructor-for-iterator-or-string index->iterator))