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, 30 insertions, 61 deletions

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>? >?)