;; new iterator function to produce the remaining items; if there are no more
;; items, then it returns NIL twice.
+(defun reduce-iterator (func init iter)
+ "Invoke FUNC on the elements of ITER.
+
+ We maintain a STATE whose value initially is INIT; for each ITEM, we
+ update the state with the value of (funcall FUNC ITEM STATE); the end
+ result is the final state."
+ (let ((state init) item)
+ (loop
+ (setf (values item iter) (funcall iter))
+ (unless iter (return state))
+ (setf state (funcall func item state)))))
+
(defun list-iterator (iter)
"Collect the items from ITER into a list and return it."
- (labels ((recur (iter list)
- (multiple-value-bind (data iter) (funcall iter)
- (if iter
- (recur iter (cons data list))
- (nreverse list)))))
- (recur iter nil)))
+ (nreverse (reduce-iterator #'cons nil iter)))
+
+(defun iterate-list (list)
+ "Return an iterator for LIST, according to our iteration protocol."
+ (if (endp list)
+ (lambda () (values nil nil))
+ (lambda () (values (car list) (iterate-list (cdr list))))))
(defun same-iterators-p (iter-a iter-b &key (test #'eql))
"Return whether ITER-A and ITER-B produce the same items."
(with-values () (resume (calling-coroutine) object #t) #f))
+(define (reduce-generator func init gen)
+ ;; Call FUNC for each item in the generator GEN.
+ ;;
+ ;; We maintain a STATE, which is initially INIT. For each ITEM produced by
+ ;; the generator, we replace the state by (FUNC ITEM STATE); finally, we
+ ;; return the final state.
+
+ (let loop ((state init))
+ (with-values (item any?) (resume gen)
+ (if any?
+ (loop (func item state))
+ state))))
+
(define (list-generator gen)
;; Collect the elements generated by GEN into a list and return it.
- (let loop ((l '()))
- (with-values (it any?) (resume gen)
- (if any?
- (loop (cons it l))
- (reverse l)))))
+ (reverse (reduce-generator cons '() gen)))
(define (same-generators? gen-a gen-b)
;; Return whether GEN-A and GEN-B generate the same elements in the same
(define (main args)
(cond ((null? args) (error "bad args"))
((null? (cdr args))
- (do ((l (list-generator (fringe (parse-tree (car args)))) (cdr l)))
- ((null? l))
- (write-char (car l)))
+ (reduce-generator (lambda (ch ?) (write-char ch)) #f
+ (fringe (parse-tree (car args))))
(newline))
((null? (cddr args))
(display (if (same-generators? (fringe (parse-tree (car args)))