more list work

1 files changed, 88 insertions, 53 deletions

diff --git a/mcgoron.iterator.list.scm b/mcgoron.iterator.list.scm
index 3638614..21ab4be 100644
--- a/mcgoron.iterator.list.scm
+++ b/mcgoron.iterator.list.scm
@@ -12,7 +12,8 @@
  | See the License for the specific language governing permissions and
  | limitations under the License.
  |-------------------------------------------------------------------------
- | This is a list iterator that allows for mutation of the list.
+ | This is a list iterator that allows for mutation list and improper
+ | lists.
  |
  | The list iterator is made up of
  | * the `signifier`: the head of the list.
@@ -25,63 +26,97 @@
  |   item.
  |#
 
+(define (forward num signifier previous idx rest)
+  (cond
+    ((= num 0)
+     (make-list-iterator signifier previous idx rest))
+    ((not (pair? rest)) #f)
+    (else
+     (forward (- num 1) (cons rest previous) (+ idx 1) (cdr rest)))))
+
+(define (backward num signifier previous idx rest)
+  (cond
+    ((= num 0)
+     (make-list-iterator signifier previous idx rest))
+    ((not (pair? rest)) #f)
+    (else
+     (backward (+ num 1) (cdr previous) (- idx 1) (car previous)))))
+
+(define (list-iterator? itr)
+  (eq? (iterator-type itr) 'list-iterator))
+
+(define-invocation list-iterator-signifier)
+
 (define (make-list-iterator signifier previous idx rest)
-  (when (not (or (pair? rest) (null? rest)))
-    (raise (improper-list-exception idx rest)))
-  (make-iterator
-   (lambda () (null? previous))
-   (lambda () (null? rest))
-   (lambda (num)
-     (cond
-       ((not (integer?))
-        (raise (non-integer-movement-exception spaces)))
-       ((negative? num)
-        (let loop ((cntr (- num))
-                   (previous previous)
-                   (rest rest))
-          (cond
-            ((= num 0) (make-list-iterator signifier
-                                           previous
-                                           (+ total num)
-                                           rest))
-            ((null? previous) #f)
-            (else (loop (- cntr 1)
-                        (cdr previous)
-                        (car previous))))))
-       (else
-        (let loop ((cntr num)
-                   (previous previous)
-                   (rest rest))
-          (cond
-            ((= num 0) (make-list-iterator signifier
-                                           previous
-                                           (+ total num)
-                                           rest))
-            ((null? rest) #f)
-            (else (loop (- 1 num)
-                        (cons rest previous)
-                        (cdr rest))))))))
-   (lambda ()
-     (if (null? rest)
-         (error "cannot ref end of list" previous rest)
-         (car rest)))
-   (lambda (predicate? other-iterators)
-     (let ((cmp (make-default-comparator)))
-       (iteratively-apply-predicate
-        (lambda (x y)
-          (predicate? cmp (get-private x) (get-private y)))
-        idx
-        other-iterators)))
-   idx))
+  (if (not (or (pair? rest) (null? rest)))
+      (list-iterator signifier (cdr previous) idx (car previous) #t)
+      (list-iterator signifier previous idx rest #f)))
+
+(define-iterator-implementation (list-iterator signifier
+                                               previous
+                                               idx
+                                               rest
+                                               improper-rest?)
+  self
+  ((iterator-at-start?) (null? previous))
+  ((iterator-at-end?) (or improper-rest? (null? rest)))
+  ((iterator-advance spaces)
+   (cond
+     ((not (integer? spaces))
+      (raise (non-integer-movement-exception spaces)))
+     ((negative? spaces)
+      (backward spaces signifier previous idx rest))
+     (else (forward spaces signifier previous idx rest))))
+  ((iterator-ref)
+   (cond
+     ((null? rest)
+      (raise (ref-at-end-exception self)))
+     (improper-rest? (cdr rest))
+     (else (car rest))))
+  ((iterator-set! x)
+   (cond
+     ((null? rest)
+      (raise (ref-at-end-exception self)))
+     (improper-rest? (set-cdr! rest x))
+     (else (set-car! rest x))))
+  ((iterator->index) idx)
+  ((get-signifier) signifier)
+  ((get-iterator-comparator)
+   (make-comparator
+    (lambda (x)
+      (and (list-iterator? itr)
+           (eq? signifier (list-iterator-signifier x))))
+    (lambda (x y)
+      (= (iterator->index x) (iterator->index y)))
+    (lambda (x y)
+      (< (iterator->index x) (iterator->index y)))
+    #f)))
+
+(define-syntax define-with-list-or-iterator
+  (syntax-rules ()
+    ((_ (name first rest ...) body ...)
+     (define (name first rest ...)
+       (let ((first (cond
+                      ((pair? first) first)
+                      ((list-iterator? first)
+                       (list-iterator-signifier first))
+                      (else (raise (list-constructor-exception
+                                    first))))))
+         body ...)))))
+
+(define (list-constructor-exception obj)
+  (make-iterator-exception #f
+                           'list-constructor
+                           (list (cons 'obj obj))))
 
-(define (list-iterator-start rest)
-  (make-list-iterator rest '() 0 rest))
+(define-with-list-or-iterator (list-iterator-start lst)
+  (make-list-iterator lst '() 0 lst))
 
 (define (list-iterator-to-end itr)
   (if (iterator-end? itr)
       itr
-      (list-iterator-to-end (iterator-advance itr 1))))
+      (list-iterator-to-end (iterator-next itr))))
 
-(define (list-iterator-end lst)
-  (list-iterator-to-end (list-iterator-start lst)))
+(define (list-iterator-end obj)
+  (list-iterator-to-end (list-iterator-start obj)))