Collection Iterators in R7RS Scheme

iterator.sld

;; Collection Iterators
;; Edwin Watkeys
;; May 22, 2020
;; MIT Licensed

(define-library (iterator)
  (import (scheme base) (scheme list) (srfi 111) (chibi generic))
  (export iterable? iterate map reduce next empty into done?
          icons imake inext iempty imap-proc)

  (begin
    ;; This is an interface the unifies access to collections of any
    ;; type that implements the required methods. Implementations are
    ;; provided for lists and heterogeneous vectors.

    ;; PUBLIC INTERFACE

    ;; * iterate OBJECT: Create an iterator object, intended to
    ;; iterate over elements in OBJECT by evaluating `next` and
    ;; `done?` on the result of this procedure.

    ;; * iterator? OBJECT: Return true if OBJECT is an iterator.

    ;; * next ITERATOR: Returns the next value associated with ITERATOR.

    ;; * done? ITERATOR: Returns #t if ITERATOR is exhausted i.e. all
    ;; elements have been retrieved vi `next`.

    ;; * map PROC ITERATOR: Returns an object of the same underlying
    ;; type of ITERATOR containing values generted by applying PROC to
    ;; each element in ITERATOR.

    ;; * reduce PROC SEED ITERATOR: Returns the result of applying
    ;; PROC to each element in ITERATOR along with an accumulated
    ;; value, which is initialized to SEED.

    ;; * empty ITERATOR-OR-OBJECT: Returns a fresh, empty collection
    ;; of the same type of ITERATOR-OR-OBJECT if it is a collection,
    ;; or, if it is an iterator, the iterator's underlying type.

    ;; * into PROTOTYPE-VALUE ITERATOR: Create a new object of the
    ;; same type as PROTOTYPE-VALUE (using the same rules as `empty`
    ;; and populate it with the elements of ITERATOR.

    ;; record type
    (define-record-type <iterator>
      (make-iterator object state)
      iterator?
      (object iterator-object set-iterator-object!)
      (state iterator-state set-iterator-state!))

    ;; Would you like to make your type iterable? If so, you need to
    ;; provide a number of methods via the (chibi generic) DEFINE-METHOD
    ;; procedure:
    ;;
    ;; * iterable? VAL: must return #t to indicate that your type is
    ;; iterator-aware.
    ;;
    ;; * imap-proc ELS: Optional. If implemented, return a procedure
    ;; of two arguments, PROC, and ITR. PROC is a procedure of arity
    ;; one, which you should call on each element in the iterator. ITR
    ;; is the iterator object, whihc contains object and state
    ;; fields. Your returned procedure should exhaust ITR and place
    ;; the values produced by PROC in a new structure of your type in
    ;; natural order.

    ;; * imap-fix-result ELS: Optional. If you have *not* implemented
    ;; imap-proc, the iterator library will naively construct an
    ;; object of your type using icons. If a collection constructed
    ;; this way is not in natural order, implement the imap-fix-result
    ;; method and reverse the items. You may safely mutate ELS.

    ;; * iempty ELS: Return an empty object of your type.

    ;; * icons ELS EL: Add EL to the ELS container.

    ;; * inext ELS STATE: Given ELS and STATE, return the next item in
    ;; the collection of your type along with updated values for your
    ;; collection and state. STATE is provided so you can for example
    ;; keep track of the next index of your collection. To be clear,
    ;; return three values via the Scheme VALUES procedure.

    ;; * idone? ELS STATE: Given ELS and STATE, return #t if the next
    ;; evaluation of inext will fail.

    ;; * imake ELS: Given ELS, provide initial values for the object
    ;; value and object state. The object value must be of your
    ;; object's type, because these methods will be dispatched on the
    ;; object value's type. Like inext, use the Scheme VALUES
    ;; procedure to return this method's two necessary return values.


    ;; iterable?
    (define-generic iterable?)
    (define-method (iterable? x) #f)
    (define-method (iterable? (els list?)) #t)
    (define-method (iterable? (els vector?)) #t)
    (define-method (iterable? (els iterator?)) #t)

    ;; imap-proc
    (define-generic imap-proc)

    (define-method (imap-proc els) #f)

    (define-method (imap-proc (els list?))
      (lambda (proc itr)
        (map proc (iterator-object itr))))

    (define-method (imap-proc (els vector?))
      (lambda (proc itr)
        (let* ((v (iterator-object itr))
               (i (iterator-state itr))
               (len (vector-length v))
               (out (make-vector (- len i))))
          (let loop ((i i) (j 0))
            (cond ((< i len)
                   (vector-set! out j (proc (vector-ref v i)))
                   (loop (+ i 1) (+ j 1)))
                  (else
                   (set-iterator-state! itr i)
                   out))))))

    ;; imap-fix-result
    (define-generic imap-fix-result)
    (define-method (imap-fix-result els) els)

    ;; iempty
    (define-generic iempty)

    (define-method (iempty (els list?)) '())
    (define-method (iempty (els vector?)) #())

    ;; icons
    (define-generic icons)

    (define-method (icons (els list?) el)
      (cons el els))

    (define-method (icons (els vector?) el)
      (vector-append els (vector el)))

    ;; inext
    (define-generic inext)

    (define-method (inext (els list?) ignore)
      (values (car els) (cdr els) ignore))

    (define-method (inext (els vector?) next-index)
      (cond  ((> (vector-length els) next-index)
              (let ((value (vector-ref els next-index)))
                (values value els (+ next-index 1))))
             (else (error "Vector exhausted"))))

    ;; idone?
    (define-generic idone?)

    (define-method (idone? (els list?) ignore)
      (null? els))

    (define-method (idone? (els vector?) next-index)
      (= next-index (vector-length els)))

    ;; imake
    (define-generic imake)
    (define-method (imake (els list?)) (values els #f))
    (define-method (imake (els vector?)) (values els 0))
    (define-method (imake (els iterator?)) (values (iterator-object els) (iterator-state els)))

    ;; user interface: construct an iterator
    (define (iterate x)
      (call-with-values
          (lambda () (imake x))
        (lambda (x state)
          (make-iterator x state))))

    ;; user interface: get next iterator value
    (define (next i)
      (call-with-values
          (lambda () (inext (iterator-object i)
                            (iterator-state i)))
        (lambda (value new-x new-state)
          (set-iterator-object! i new-x)
          (set-iterator-state! i new-state)
          value)))

    ;; user interface: is the iterable exhausted?
    (define (done? i)
      (idone? (iterator-object i) (iterator-state i)))

    ;; user interface: create an empty object of same type as iterator's base object
    (define (empty i-or-els)
      (if (iterator? i-or-els)
          (iempty (iterator-object i-or-els))
          (iempty i-or-els)))

    ;; user interface: map `proc` over iterator `itr`
    (define (map proc itr)
      (let ((map-proc (imap-proc (iterator-object itr))))
        (if map-proc
            (map-proc proc itr)
            (let loop ((out (empty itr)))
              (cond ((done? itr) (imap-fix-result out))
                    (else (loop (icons out (proc (next itr))))))))))

    ;; user interface: reduce elements of `itr` using `proc` and `seed`
    (define (reduce proc seed itr)
      (let loop ((accum seed))
        (cond ((done? itr) accum)
              (else (loop (proc accum (next itr)))))))

    ;; user interface: populate an empty object like `prototype` with
    ;; the elements of `itr-or-els`
    (define (into prototype i-or-els)
      (reduce icons (empty prototype)
              (if (iterator? i-or-els)
                  i-or-els
                  (iterate i-or-els))))))