Skip to content

Instantly share code, notes, and snippets.

@edw
Last active May 22, 2020 22:41
Show Gist options
  • Save edw/42205405742ec50e8de783563ef6f477 to your computer and use it in GitHub Desktop.
Save edw/42205405742ec50e8de783563ef6f477 to your computer and use it in GitHub Desktop.
Collection Iterators in R7RS Scheme
;; 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))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment