refactor exceptions to be less verbose

6 files changed, 86 insertions, 61 deletions

diff --git a/mcgoron.iterator.base.scm b/mcgoron.iterator.base.scm
index f823289..21af871 100644
--- a/mcgoron.iterator.base.scm
+++ b/mcgoron.iterator.base.scm
@@ -31,16 +31,20 @@
 
 (define-syntax define-iterator-implementation
   (syntax-rules (else)
-    ((_ (cstr cstr-args ...) ((name . formal) body ...) ...)
+    ((_ (cstr cstr-args ...) self ((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))))))
+       (letrec ((self
+                 (make-iterator-container
+                  (lambda (type args)
+                    (case type
+                      ((name) (apply (lambda formal body ...) args))
+                      ...
+                      (else (raise (not-implemented-exception self
+                                                              type
+                                                              args)))))
+                  '(name ...)
+                  (quote cstr))))
+         self)))))
 
 (define-invocation iterator-at-start?)
 (define-invocation iterator-at-end?)
@@ -49,3 +53,7 @@
 (define-invocation iterator-set! val)
 (define-invocation iterator->index)
 
+(define (iterator-next itr)
+  (iterator-advance itr 1))
+(define (iterator-prev itr)
+  (iterator-advance itr -1))
diff --git a/mcgoron.iterator.base.sld b/mcgoron.iterator.base.sld
index dff81e0..a8e0133 100644
--- a/mcgoron.iterator.base.sld
+++ b/mcgoron.iterator.base.sld
@@ -21,8 +21,8 @@
           define-invocation
           iterator-closure iterator-capabilities iterator-type
           iterator-at-start? iterator-at-end?
-          iterator-advance
           iterator-ref
-          iterator->index)
+          iterator->index
+          iterator-advance iterator-next iterator-prev)
   (include "mcgoron.iterator.base.scm"))
 
diff --git a/mcgoron.iterator.exceptions.scm b/mcgoron.iterator.exceptions.scm
new file mode 100644
index 0000000..ff6f82c
--- /dev/null
+++ b/mcgoron.iterator.exceptions.scm
@@ -0,0 +1,42 @@
+#| 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-exception>
+  (make-iterator-exception iterator type fields)
+  iterator-exception?
+  (iterator iterator-exception-iterator)
+  (type iterator-exception-type)
+  (fields iterator-exception-fields))
+
+(define (not-implemented-exception iterator field)
+  (make-iterator-exception iterator
+                           'not-implemented
+                           (list (cons 'field field))))
+
+(define (non-integer-movement-exception iterator spaces)
+  (make-iterator-exception iterator
+                           'non-integer-movement
+                           (list (cons 'spaces spaces))))
+
+(define (negative-movement-exception iterator spaces)
+  (make-iterator-exception iterator
+                           'negative-movement
+                           (list (cons 'spaces spaces))))
+
+(define (ref-at-end-exception iterator)
+  (make-iterator-exception iterator
+                           'ref-at-end
+                           '()))
+
diff --git a/mcgoron.iterator.exceptions.sld b/mcgoron.iterator.exceptions.sld
index 0140f4c..e2f47db 100644
--- a/mcgoron.iterator.exceptions.sld
+++ b/mcgoron.iterator.exceptions.sld
@@ -15,42 +15,13 @@
 
 (define-library (mcgoron iterator exceptions)
   (import (scheme base))
-  (export field-not-found-exception field-not-found-exception?
-          field-not-found-exception:field
-          field-not-found-exception:iterator
-          non-integer-movement-exception non-integer-movement-exception?
-          non-integer-movement-exception:spaces
-          negative-movement-exception negative-movement-exception?
-          negative-movement-exception:spaces
-          improper-list-exception improper-list-exception?
-          improper-list-exception:idx
-          improper-list-exception:cdr
+  (export make-iterator-exception iterator-exception?
+          iterator-exception-iterator
+          iterator-exception-type
+          iterator-exception-fields
           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)
-      field-not-found-exception?
-      (field field-not-found-exception:field)
-      (iterator field-not-found-exception:iterator))
-    (define-record-type <non-integer-movement-exception>
-      (non-integer-movement-exception spaces)
-      non-integer-movement-exception?
-      (spaces non-integer-movement-exception:spaces))
-    (define-record-type <negative-movement-exception>
-      (negative-movement-exception spaces)
-      negative-movement-exception?
-      (spaces negative-movement-exception:spaces))
-    (define-record-type <improper-list-exception>
-      (improper-list-exception idx cdr)
-      improper-list-exception?
-      (idx improper-list-exception:idx)
-      (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))))
+          non-integer-movement-exception
+          negative-movement-exception
+          ref-at-end-exception)
+  (include "mcgoron.iterator.exceptions.scm"))
 
diff --git a/mcgoron.iterator.string.scm b/mcgoron.iterator.string.scm
index 62cb960..762b79d 100644
--- a/mcgoron.iterator.string.scm
+++ b/mcgoron.iterator.string.scm
@@ -16,18 +16,15 @@
 (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)))
+    ((zero? spaces) #t)
     ((negative? spaces)
      (<= (- spaces)
          (string-cursor-diff str (string-cursor-start str) cursor)))
     ((positive? spaces)
      (<= spaces
          (string-cursor-diff str cursor (string-cursor-end str))))
-    (else #t)))
+    (else #f)))
 
 (define-invocation string-iterator-str)
 (define-invocation string-iterator->cursor)
@@ -42,18 +39,23 @@
      (string-cursor-back str cursor (- spaces)))
     (else (string-cursor-forward str cursor spaces))))
 
-(define-iterator-implementation (string-iterator str cursor)
+(define-iterator-implementation (string-iterator str cursor) self
   ((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))
+   (cond
+     ((not (integer? spaces))
+      (raise (non-integer-movement-exception self spaces)))
+     ((string-cursor-valid-movement? str cursor spaces)
+      (let ((cursor (string-cursor-advance str cursor spaces)))
+        (string-iterator str cursor)))
+     (else #f)))
   ((iterator-ref)
-   (string-ref/cursor str cursor))
+   (if (iterator-at-end? self)
+       (raise (ref-at-end-exception self))
+       (string-ref/cursor str cursor)))
   ((iterator->index)
    (string-cursor->index str cursor))
   ((string-iterator-str) str)
diff --git a/tests/string.scm b/tests/string.scm
index d3ab241..7625acc 100644
--- a/tests/string.scm
+++ b/tests/string.scm
@@ -20,8 +20,10 @@
   (test-group "empty-string"
     (test-assert "iterator-at-start?" (iterator-at-start? itr))
     (test-assert "iterator-at-end?" (iterator-at-end? itr))
-    (test-assert "iterator-advance 1" (not (iterator-advance itr 1)))
-    (test-assert "iterator-advance -1" (not (iterator-advance itr -1)))
+    (test-assert "iterator-next" (not (iterator-next itr)))
+    (test-assert "iterator-prev" (not (iterator-next itr)))
+    (test-assert "iterator-advance 0" (iterator=? itr
+                                                  (iterator-advance itr 0)))
     (test "iterator->index" 0 (iterator->index itr))
     (test-assert "iterator=?" (iterator=? itr (string-iterator-end str)))
     (test-error "iterator-ref" (iterator-ref itr))))