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.

11 files changed, 231 insertions, 137 deletions

diff --git a/README.md b/README.md
index 868a778..7f1e455 100644
--- a/README.md
+++ b/README.md
@@ -6,3 +6,35 @@ ordered collection, such as strings, vectors, and ordered sets.
 "Iterators" are in the style of C++: they can (potentially) go forward,
 backward, have start and end limits, etc. Not all operations are available
 for a concrete iterator.
+
+## Design
+
+The iterators in this library are polymorphic and may only implement a
+subset of the possible operations on an iterator, but Scheme has no standard
+way to make extensible polymorphic functions. Instead of tying the library
+to a specific implementations's object system, the iterators are closures
+wrapped in record types. The iterators don't use inheritance or any message
+passing: they are more like Go interfaces or Rust traits than the usual
+Scheme object system.
+
+Iterator types are created using
+
+    (define-iterator-constructor (cstr cstr-args ...)
+      ((method-name . method-formal) method-body ...)
+      ...)
+
+This creates a procedure `cstr` that when called creates an iterator whose
+type is the `cstr` name as a symbol. Each `method` is defined as a lambda
+that takes `method-formal` as arguments and evaluates `method-body` with
+`cstr-args` in scope.
+
+To invoke the method, use
+
+    (define-invocation name args ...)
+
+This defines a procedure `name` that takes an iterator and invokes the
+method with the same name in the iterator with the number of args in args.
+
+This object system could probably be ported to CLOS-style object systems
+with a judicious enough use of macros. Properly implementing the bound
+identifiers may require non-hygenic macros.
diff --git a/container-iterator.egg b/container-iterator.egg
index 149d2c2..e7b32c3 100644
--- a/container-iterator.egg
+++ b/container-iterator.egg
@@ -1,5 +1,5 @@
 ((author "Peter McGoron")
- (version "0.1.0")
+ (version "0.2.0")
  (synopsis "Generic iterators over ordered containers")
  (category "data")
  (license "Apache-2.0")
@@ -12,8 +12,17 @@
                (source "mcgoron.iterator.base.sld")
                (component-dependencies mcgoron.iterator.exceptions)
                (csc-options "-R" "r7rs" "-X" "r7rs"))
+             (extension mcgoron.iterator.string.exceptions
+               (source "mcgoron.iterator.string.exceptions.sld")
+               (csc-options "-R" "r7rs" "-X" "r7rs"))
+             (extension mcgoron.iterator.srfi.128
+               (source "mcgoron.iterator.srfi.128.sld")
+               (component-dependencies mcgoron.iterator.base)
+               (csc-options "-R" "r7rs" "-X" "r7rs"))
              (extension mcgoron.iterator.string
                (source "mcgoron.iterator.string.sld")
                (component-dependencies mcgoron.iterator.base
-                                       mcgoron.iterator.exceptions)
+                                       mcgoron.iterator.exceptions
+                                       mcgoron.iterator.string.exceptions
+                                       mcgoron.iterator.srfi.128)
                (csc-options "-R" "r7rs" "-X" "r7rs"))))
diff --git a/mcgoron.iterator.base.scm b/mcgoron.iterator.base.scm
index cd8e775..f823289 100644
--- a/mcgoron.iterator.base.scm
+++ b/mcgoron.iterator.base.scm
@@ -14,69 +14,38 @@
  |#
 
 (define-record-type <iterator>
-  (make-iterator start? end?
-                 advance
-                 ref
-                 to-index
-                 comparison
-                 private)
+  (make-iterator-container closure capabilities type)
   iterator?
-  (start? get-start-predicate)
-  (end? get-end-predicate)
-  (advance get-advance)
-  (ref get-ref)
-  (to-index get-to-index-procedure)
-  (comparison get-comparison-procedure)
-  (private iterator-get-private))
+  (closure iterator-closure)
+  (capabilities iterator-capabilities)
+  (type iterator-type))
 
-(define-syntax define-with-field-of-iterator
-  (syntax-rules ()
-    ((_ (name field args ...) body ...)
-     (define (name iterator args ...)
-       (let ((field (field iterator)))
-         (if (not field)
-             (raise (field-not-found-exception
-                     (quote field)
-                     iterator))
-             (begin body ...)))))))
+(define (iterator-invoke itr field . args)
+  ((iterator-closure itr) field args))
 
-;;; Define a function that invokes a field of the iterator on the data
-;;; object inside the iterator and any other arguments supplied to the
-;;; function.
-(define-syntax define-invoke-field-of-iterator
+(define-syntax define-invocation
   (syntax-rules ()
-    ((_ name field-accessor args ...)
-     (define-with-field-of-iterator (name field-accessor args ...)
-       (field-accessor args ...)))))
-
-(define-invoke-field-of-iterator iterator-at-start? get-start-predicate)
-(define-invoke-field-of-iterator iterator-at-end? get-end-predicate)
-
-(define-invoke-field-of-iterator iterator-advance get-advance
-  spaces)
-
-(define-invoke-field-of-iterator iterator-ref get-ref)
-(define-invoke-field-of-iterator iterator->index get-to-index-procedure)
-
-(define-syntax define-comparison
-  (syntax-rules ()
-    ((_ name comparison-function)
-     (define (name itr1 . itr-rest)
-       (let ((impl (get-comparison-procedure itr1)))
-         (if (not impl)
-             (raise (field-not-found-exception (quote comparison-function)
-                                               itr1))
-             (impl 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-invocation name args ...)
+     (define (name itr args ...)
+       (iterator-invoke itr (quote name) args ...)))))
+
+(define-syntax define-iterator-implementation
+  (syntax-rules (else)
+    ((_ (cstr cstr-args ...) ((name . formal) body ...) ...)
+     (define (cstr cstr-args ...)
+       (make-iterator-container
+        (lambda (type args)
+          (case type
+            ((name) (apply (lambda formal body ...) args))
+            ...
+            (else (raise (not-implemented-exception type args)))))
+        '(name ...)
+        (quote cstr))))))
+
+(define-invocation iterator-at-start?)
+(define-invocation iterator-at-end?)
+(define-invocation iterator-advance spaces)
+(define-invocation iterator-ref)
+(define-invocation iterator-set! val)
+(define-invocation iterator->index)
 
-(define-comparison iterator=? =?)
-(define-comparison iterator<=? <=?)
-(define-comparison iterator>=? >=?)
-(define-comparison iterator<? <?)
-(define-comparison iterator>? >?)
diff --git a/mcgoron.iterator.base.sld b/mcgoron.iterator.base.sld
index 44507ae..dff81e0 100644
--- a/mcgoron.iterator.base.sld
+++ b/mcgoron.iterator.base.sld
@@ -16,13 +16,13 @@
 (define-library (mcgoron iterator base)
   (import (scheme base) (scheme case-lambda) (srfi 128)
           (mcgoron iterator exceptions))
-  (export make-iterator iterator?
+  (export iterator?
+          define-iterator-implementation
+          define-invocation
+          iterator-closure iterator-capabilities iterator-type
           iterator-at-start? iterator-at-end?
           iterator-advance
           iterator-ref
-          iterator->index
-          iterator-get-private
-          iterator=? iterator<? iterator>? iterator<=? iterator>=?
-          iteratively-apply-predicate)
+          iterator->index)
   (include "mcgoron.iterator.base.scm"))
 
diff --git a/mcgoron.iterator.exceptions.sld b/mcgoron.iterator.exceptions.sld
index ce1b8db..0140f4c 100644
--- a/mcgoron.iterator.exceptions.sld
+++ b/mcgoron.iterator.exceptions.sld
@@ -24,7 +24,11 @@
           negative-movement-exception:spaces
           improper-list-exception improper-list-exception?
           improper-list-exception:idx
-          improper-list-exception:cdr)
+          improper-list-exception:cdr
+          not-implemented-exception
+          not-implemented-exception?
+          not-implemented-exception:type
+          not-implemented-exception:args)
   (begin
     (define-record-type <field-not-found-exception>
       (field-not-found-exception field iterator)
@@ -43,5 +47,10 @@
       (improper-list-exception idx cdr)
       improper-list-exception?
       (idx improper-list-exception:idx)
-      (cdr improper-list-exception:cdr))))
+      (cdr improper-list-exception:cdr))
+    (define-record-type <not-implemented-exception>
+      (not-implemented-exception type args)
+      not-implemented-exception?
+      (type not-implemented-exception:type)
+      (args not-implemented-exception:args))))
 
diff --git a/mcgoron.iterator.srfi.128.scm b/mcgoron.iterator.srfi.128.scm
new file mode 100644
index 0000000..0e3f7ba
--- /dev/null
+++ b/mcgoron.iterator.srfi.128.scm
@@ -0,0 +1,29 @@
+#| Copyright 2024 Peter McGoron
+ |
+ | Licensed under the Apache License, Version 2.0 (the "License");
+ | you may not use this file except in compliance with the License.
+ | You may obtain a copy of the License at
+ |
+ |     http://www.apache.org/licenses/LICENSE-2.0
+ |
+ | Unless required by applicable law or agreed to in writing, software
+ | distributed under the License is distributed on an "AS IS" BASIS,
+ | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ | See the License for the specific language governing permissions and
+ | limitations under the License.
+ |#
+
+(define-invocation get-iterator-comparator)
+
+(define-syntax define-compare
+  (syntax-rules ()
+    ((define-compare name compare)
+     (define (name itr1 . itr-rest)
+       (apply compare (get-iterator-comparator itr1) itr1 itr-rest)))))
+
+(define-compare iterator=? =?)
+(define-compare iterator<? <?)
+(define-compare iterator<=? <=?)
+(define-compare iterator>? >?)
+(define-compare iterator>=? >=?)
+
diff --git a/mcgoron.iterator.srfi.128.sld b/mcgoron.iterator.srfi.128.sld
new file mode 100644
index 0000000..712414c
--- /dev/null
+++ b/mcgoron.iterator.srfi.128.sld
@@ -0,0 +1,24 @@
+#| Copyright 2024 Peter McGoron
+ |
+ | Licensed under the Apache License, Version 2.0 (the "License");
+ | you may not use this file except in compliance with the License.
+ | You may obtain a copy of the License at
+ |
+ |     http://www.apache.org/licenses/LICENSE-2.0
+ |
+ | Unless required by applicable law or agreed to in writing, software
+ | distributed under the License is distributed on an "AS IS" BASIS,
+ | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ | See the License for the specific language governing permissions and
+ | limitations under the License.
+ |#
+
+(define-library (mcgoron iterator srfi 128)
+  (import (scheme base) (srfi 128)
+          (mcgoron iterator base))
+  (export get-iterator-comparator
+          iterator=?
+          iterator<? iterator<=?
+          iterator>? iterator>=?)
+  (include "mcgoron.iterator.srfi.128.scm"))
+
diff --git a/mcgoron.iterator.string.exceptions.sld b/mcgoron.iterator.string.exceptions.sld
new file mode 100644
index 0000000..4e85a4b
--- /dev/null
+++ b/mcgoron.iterator.string.exceptions.sld
@@ -0,0 +1,26 @@
+#| Copyright 2024 Peter McGoron
+ |
+ | Licensed under the Apache License, Version 2.0 (the "License");
+ | you may not use this file except in compliance with the License.
+ | You may obtain a copy of the License at
+ |
+ |     http://www.apache.org/licenses/LICENSE-2.0
+ |
+ | Unless required by applicable law or agreed to in writing, software
+ | distributed under the License is distributed on an "AS IS" BASIS,
+ | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ | See the License for the specific language governing permissions and
+ | limitations under the License.
+ |#
+
+(define-library (mcgoron iterator string exceptions)
+  (import (scheme base))
+  (export string-iterator-constructor-exception
+          string-iterator-constructor-exception?
+          string-iterator-constructor-exception:obj)
+  (begin
+    (define-record-type <string-iterator-constructor-exception>
+      (string-iterator-constructor-exception obj)
+      string-iterator-constructor-exception?
+      (obj string-iterator-constructor-exception:obj))))
+
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)))
 
diff --git a/mcgoron.iterator.string.sld b/mcgoron.iterator.string.sld
index 9b8a388..ae2bb99 100644
--- a/mcgoron.iterator.string.sld
+++ b/mcgoron.iterator.string.sld
@@ -17,11 +17,12 @@
   (import (scheme base)
           (srfi 130) (srfi 128) (srfi 26)
           (mcgoron iterator base)
-          (mcgoron iterator exceptions))
-  (export cursor->iterator
+          (mcgoron iterator exceptions)
+          (mcgoron iterator string exceptions)
+          (mcgoron iterator srfi 128))
+  (export string-iterator
+          string-iterator?
           string-iterator-start
           string-iterator-end
-          string-index->iterator
-          string-iterator-constructor-exception?
-          string-iterator-constructor-exception:obj)
+          string-index->iterator)
   (include "mcgoron.iterator.string.scm"))
diff --git a/tests/string.scm b/tests/string.scm
index bf89662..d3ab241 100644
--- a/tests/string.scm
+++ b/tests/string.scm
@@ -12,7 +12,8 @@
  | See the License for the specific language governing permissions and
  | limitations under the License.
  |#
-(import (mcgoron iterator string))
+(import (mcgoron iterator string)
+        (mcgoron iterator srfi 128))
 
 (let* ((str "")
        (itr (string-iterator-start str)))