From: Mark Wooding <mdw@distorted.org.uk>
Date: Wed, 18 Nov 2009 16:35:54 +0000 (+0000)
Subject: cl, scheme: Introduce `reduce' functions.
X-Git-Url: https://git.distorted.org.uk/~mdw/fringe/commitdiff_plain/851c7e3a447f19148f9d714dbf3138773f326e16

cl, scheme: Introduce `reduce' functions.

These illustrate higher-order functions fairly nicely.  Note that
the CL version is explicitly iterative with side-effects because of
the lack of reliable tail-recursion.
---

diff --git a/cl-fringe.lisp b/cl-fringe.lisp
index a2ddf85..5af3cc7 100644
--- a/cl-fringe.lisp
+++ b/cl-fringe.lisp
@@ -10,14 +10,27 @@
 ;; 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."
diff --git a/scheme-fringe.scm b/scheme-fringe.scm
index 0dc93df..4ddb079 100644
--- 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)))