string iterator

1 files changed, 134 insertions, 0 deletions

diff --git a/generic-iterator.scm b/generic-iterator.scm
new file mode 100644
index 0000000..c38c346
--- /dev/null
+++ b/generic-iterator.scm
@@ -0,0 +1,134 @@
+#| 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-record-type <iterator-implementation>
+  (make-iterator-implementation start end
+                                start? end?
+                                advance
+                                ref
+                                to-index from-index
+                                comparator)
+  iterator-implementation?
+  (start get-start)
+  (end get-end)
+  (start? get-start-predicate)
+  (end? get-end-predicate)
+  (advance get-advance)
+  (ref get-ref)
+  (to-index get-to-index-procedure)
+  (from-index get-from-index-procedure)
+  (comparator get-comparator))
+
+(define-record-type <iterator>
+  (make-iterator implementation data)
+  iterator?
+  (implementation get-implementation)
+  (data get-data))
+
+;;; 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
+  (syntax-rules ()
+    ((define-invoker name field-accessor emsg args ...)
+     (define (name iterator args ...)
+       (let ((proc (field-accessor (get-implementation iterator))))
+         (if (not proc)
+             (error emsg iterator)
+             (proc (get-data iterator) args ...)))))))
+
+;;; Define a constructor (something that makes an iterator from something
+;;; that is not an iterator).
+;;; 
+;;; The constructor can take as arguments either
+;;; 
+;;; 1) The implementation and any data objects necessary to make the
+;;;    iterator, or
+;;; 2) The iterator and any objects necessary to make the iterator, where
+;;;    the data in the iterator is the first such object.
+;;; 
+;;; This is implemented as a macro to catch arity issues.
+(define-syntax define-constructor-for-iterator-or-implementation
+  (syntax-rules ()
+    ((_ name field emsg args ...)
+     (define name
+       (case-lambda
+         ((iterator args ...)
+          (name (get-implementation iterator)
+                (get-data iterator)
+                args ...))
+         ((implementation data args ...)
+          (let ((constructor (field implementation)))
+            (if (not constructor)
+                (error emsg implementation data args ...)
+                (constructor data args ...)))))))))
+
+(define-constructor-for-iterator-or-implementation iterator-at-start
+  get-start
+  "no start constructor")
+
+(define-constructor-for-iterator-or-implementation iterator-at-end
+  get-end
+  "no end")
+
+(define-invoke-field-of-iterator iterator-at-start?
+  get-start-predicate
+  "no start predicate")
+(define-invoke-field-of-iterator iterator-at-end?
+  get-end-predicate
+  "no end predicate")
+
+(define-invoke-field-of-iterator iterator-advance
+  get-advance
+  "no procedure to move iterator"
+  spaces)
+
+(define-invoke-field-of-iterator iterator-ref
+  get-ref
+  "no procedure to access value at iterator")
+
+(define-invoke-field-of-iterator iterator->index
+  get-to-index-procedure
+  "no procedure to convert iterator->index")
+
+(define-constructor-for-iterator-or-implementation index->iterator
+  get-from-index-procedure
+  "no procedure to convert index->iterator"
+  index)
+
+;;; Create a procedure that calls COMPARISON on all (ITER1 . ITER-REST).
+;;; COMPARATOR-TYPE? is a predicate against the comparator, and if the
+;;; comparator fails the predicate an error message with string EMSG
+;;; will thrown.
+(define (generate-comparison comparison comparator-type? emsg)
+  (lambda (iter1 . iter-rest)
+    (let ((comparator (get-comparator (get-implementation iter1))))
+      (if (not (comparator-type? comparator))
+          (apply error emsg iter1 iter-rest)
+          (apply comparison comparator
+                 (map get-data (cons iter1 iter-rest)))))))
+
+(define iterator=?
+  (generate-comparison =? comparator? "no comparator"))
+
+(define iterator<?
+  (generate-comparison <? comparator-ordered? "no ordered comparator"))
+(define iterator>?
+  (generate-comparison >? comparator-ordered? "no ordered comparator"))
+
+(define iterator<=?
+  (generate-comparison <=? comparator-ordered? "no ordered comparator"))
+(define iterator>=?
+  (generate-comparison >=? comparator-ordered? "no ordered comparator"))