use records as exceptions

6 files changed, 74 insertions, 33 deletions

diff --git a/generic-iterator.scm b/mcgoron.iterator.base.scm
index 960f9da..cd8e775 100644
--- a/generic-iterator.scm
+++ b/mcgoron.iterator.base.scm
@@ -31,11 +31,13 @@
 
 (define-syntax define-with-field-of-iterator
   (syntax-rules ()
-    ((_ (name field args ...) emsg body ...)
+    ((_ (name field args ...) body ...)
      (define (name iterator args ...)
        (let ((field (field iterator)))
          (if (not field)
-             (error emsg iterator args ...)
+             (raise (field-not-found-exception
+                     (quote field)
+                     iterator))
              (begin body ...)))))))
 
 ;;; Define a function that invokes a field of the iterator on the data
@@ -43,37 +45,28 @@
 ;;; function.
 (define-syntax define-invoke-field-of-iterator
   (syntax-rules ()
-    ((_ name field-accessor emsg args ...)
-     (define-with-field-of-iterator (name field-accessor args ...) emsg
+    ((_ 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
-  "no start predicate")
-(define-invoke-field-of-iterator iterator-at-end?
-  get-end-predicate
-  "no end predicate")
+(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
-  "no advance procedure"
+(define-invoke-field-of-iterator iterator-advance get-advance
   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-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)
-       ((get-comparison-procedure itr1)
-        comparison-function
-        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
diff --git a/mcgoron.iterator.base.sld b/mcgoron.iterator.base.sld
index 79f7830..44507ae 100644
--- a/mcgoron.iterator.base.sld
+++ b/mcgoron.iterator.base.sld
@@ -14,7 +14,8 @@
  |#
 
 (define-library (mcgoron iterator base)
-  (import (scheme base) (scheme write) (scheme case-lambda) (srfi 128))
+  (import (scheme base) (scheme case-lambda) (srfi 128)
+          (mcgoron iterator exceptions))
   (export make-iterator iterator?
           iterator-at-start? iterator-at-end?
           iterator-advance
@@ -23,5 +24,5 @@
           iterator-get-private
           iterator=? iterator<? iterator>? iterator<=? iterator>=?
           iteratively-apply-predicate)
-  (include "generic-iterator.scm"))
+  (include "mcgoron.iterator.base.scm"))
 
diff --git a/mcgoron.iterator.exceptions.sld b/mcgoron.iterator.exceptions.sld
new file mode 100644
index 0000000..b989a6c
--- /dev/null
+++ b/mcgoron.iterator.exceptions.sld
@@ -0,0 +1,39 @@
+#| 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 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)
+  (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))))
+
diff --git a/string-iterator.scm b/mcgoron.iterator.string.scm
index bddf9c0..1294a8b 100644
--- a/string-iterator.scm
+++ b/mcgoron.iterator.string.scm
@@ -28,8 +28,8 @@
 
 (define (string-cursor-valid-movement? str cursor spaces)
   (cond
-    ((not (integer? spaces)) (error "can only move by exact integer"
-                                    spaces))
+    ((not (integer? spaces))
+     (raise (non-integer-movement-exception spaces)))
     ((negative? spaces)
      (<= (- spaces)
          (string-cursor-diff str (string-cursor-start str) cursor)))
@@ -47,8 +47,6 @@
        (string-cursor=? cursor (string-cursor-end str)))
      (lambda (spaces)
        (cond
-         ((not (integer? spaces))
-          (error "advance must be done in integer steps" spaces))
          ((not (string-cursor-valid-movement? str cursor spaces))
           #f)
          ((negative? spaces)
@@ -79,6 +77,11 @@
      (raw-fat-cursor str cursor)))
   iterator)
 
+(define-record-type <string-iterator-constructor-exception>
+  (string-iterator-constructor-exception obj)
+  string-iterator-constructor-exception?
+  (obj string-iterator-constructor-exception:obj))
+
 (define-syntax define-for-iterator-or-string
   (syntax-rules ()
     ((_ (name str args ...) body ...)
@@ -90,7 +93,8 @@
          ((iterator? object) (internal (get-str (iterator-get-private
                                                  object))
                                        args ...))
-         (else (error "invalid type of object" object)))))))
+         (else (raise (string-iterator-constructor-exception
+                       object))))))))
 
 (define-for-iterator-or-string (string-iterator-start str)
   (cursor->iterator str (string-cursor-start str)))
diff --git a/mcgoron.iterator.string.sld b/mcgoron.iterator.string.sld
index d024e47..9b8a388 100644
--- a/mcgoron.iterator.string.sld
+++ b/mcgoron.iterator.string.sld
@@ -16,9 +16,12 @@
 (define-library (mcgoron iterator string)
   (import (scheme base)
           (srfi 130) (srfi 128) (srfi 26)
-          (mcgoron iterator base))
+          (mcgoron iterator base)
+          (mcgoron iterator exceptions))
   (export cursor->iterator
           string-iterator-start
           string-iterator-end
-          string-index->iterator)
-  (include "string-iterator.scm"))
+          string-index->iterator
+          string-iterator-constructor-exception?
+          string-iterator-constructor-exception:obj)
+  (include "mcgoron.iterator.string.scm"))
diff --git a/test-string-iterator.scm b/test-string-iterator.scm
index 10a0020..b13f5b8 100644
--- a/test-string-iterator.scm
+++ b/test-string-iterator.scm
@@ -17,6 +17,7 @@
  (chicken (import r7rs))
  (else))
 
+(load "mcgoron.iterator.exceptions.sld")
 (load "mcgoron.iterator.base.sld")
 (load "mcgoron.iterator.string.sld")