cl, scheme: Introduce `reduce' functions.

[fringe] / scheme-fringe.scm

diff --git a/scheme-fringe.scm b/scheme-fringe.scm
index 0dc93df..4ddb079 100644 (file)
--- a/scheme-fringe.scm
+++ b/scheme-fringe.scm
@@ -86,14 +86,23 @@
 
   (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
@@ -161,9 +170,8 @@
 (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)))