refactor iterators to be closure objects

This makes iterators much more flexible while keeping their abstract
nature. New iterators can be made by a programmer with different
methods.

Existing iterator types cannot be programatically extended. This
would likely require implementation support: either CLOS-style
classes or a more limited single-dispatch interface system.

1 files changed, 55 insertions, 61 deletions

diff --git a/mcgoron.iterator.string.scm b/mcgoron.iterator.string.scm
index 1294a8b..62cb960 100644
--- a/mcgoron.iterator.string.scm
+++ b/mcgoron.iterator.string.scm
@@ -13,20 +13,11 @@
  | limitations under the License.
  |#
 
-(define-record-type <fat-cursor>
-  (raw-fat-cursor str cursor)
-  fat-cursor?
-  (str get-str)
-  (cursor get-cursor))
-
-(define string-cursor-comparator
-  (make-comparator
-   string-cursor?
-   string-cursor=?
-   string-cursor<?
-   #f))
-
 (define (string-cursor-valid-movement? str cursor spaces)
+  ;; Return #T if moving CURSOR forwards or backwards SPACES is well
+  ;; defined.
+  ;; 
+  ;; Will return an error if SPACES is not an integer.
   (cond
     ((not (integer? spaces))
      (raise (non-integer-movement-exception spaces)))
@@ -38,51 +29,55 @@
          (string-cursor-diff str cursor (string-cursor-end str))))
     (else #t)))
 
-(define (cursor->iterator 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-invocation string-iterator-str)
+(define-invocation string-iterator->cursor)
+
+(define (string-iterator? x)
+  (and (iterator? x) (eq? (iterator-type x) 'string-iterator)))
+
+(define (string-cursor-advance str cursor spaces)
+  ;; Move CURSOR SPACES forward or backward.
+  (cond
+    ((negative? spaces)
+     (string-cursor-back str cursor (- spaces)))
+    (else (string-cursor-forward str cursor spaces))))
 
-(define-record-type <string-iterator-constructor-exception>
-  (string-iterator-constructor-exception obj)
-  string-iterator-constructor-exception?
-  (obj string-iterator-constructor-exception:obj))
+(define-iterator-implementation (string-iterator str cursor)
+  ((iterator-at-start?)
+   (string-cursor=? (string-cursor-start str) cursor))
+  ((iterator-at-end?)
+   (string-cursor=? (string-cursor-end str) cursor))
+  ((iterator-advance spaces)
+   (if (string-cursor-valid-movement? str cursor spaces)
+       (let ((cursor (string-cursor-advance str cursor spaces)))
+         (string-iterator str cursor))
+       #f))
+  ((iterator-ref)
+   (string-ref/cursor str cursor))
+  ((iterator->index)
+   (string-cursor->index str cursor))
+  ((string-iterator-str) str)
+  ((string-iterator->cursor) cursor)
+  ((get-iterator-comparator)
+   (make-comparator
+    (lambda (x)
+      (and (string-iterator? x)
+           (let ((x-str (string-iterator-str str)))
+             (eq? str x-str))))
+    (lambda (x y)
+      (let ((x-cur (string-iterator->cursor x))
+            (y-cur (string-iterator->cursor y)))
+        (string-cursor=? x-cur y-cur)))
+    (lambda (x y)
+      (let ((x-cur (string-iterator->cursor x))
+            (y-cur (string-iterator->cursor y)))
+        (string-cursor<? x-cur y-cur)))
+    #f)))
 
 (define-syntax define-for-iterator-or-string
+  ;; Define a function such that the first argument can either be a string
+  ;; or a string iterator. The string iterator has its string extracted
+  ;; before use.
   (syntax-rules ()
     ((_ (name str args ...) body ...)
      (define (name object args ...)
@@ -90,18 +85,17 @@
          body ...)
        (cond
          ((string? object) (internal object args ...))
-         ((iterator? object) (internal (get-str (iterator-get-private
-                                                 object))
-                                       args ...))
+         ((string-iterator? object) (internal (string-iterator-str object)
+                                              args ...))
          (else (raise (string-iterator-constructor-exception
                        object))))))))
 
 (define-for-iterator-or-string (string-iterator-start str)
-  (cursor->iterator str (string-cursor-start str)))
+  (string-iterator str (string-cursor-start str)))
 
 (define-for-iterator-or-string (string-iterator-end str)
-  (cursor->iterator str (string-cursor-end str)))
+  (string-iterator str (string-cursor-end str)))
 
 (define-for-iterator-or-string (string-index->iterator str idx)
-  (cursor->iterator str (string-index->cursor str idx)))
+  (string-iterator str (string-index->cursor str idx)))