Improve defn. of fold-left and fold-right.

diff --git a/v7/src/runtime/list.scm b/v7/src/runtime/list.scm
index 199be9daa77f6188c00ec7a5657e3b48410dc0af..23e6f21880b6aa21cc3c45bece3a2b7824dd67cc 100644 (file)
--- a/v7/src/runtime/list.scm
+++ b/v7/src/runtime/list.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: list.scm,v 14.18 1993/09/30 17:08:17 adams Exp $
+$Id: list.scm,v 14.19 1994/02/16 07:57:01 gjr Exp $
 
 Copyright (c) 1988-93 Massachusetts Institute of Technology
 
@@ -490,22 +490,25 @@ MIT in each case. |#
            (error:wrong-type-argument list "list" 'REDUCE-RIGHT))
        initial)))
 
-(define (fold-left procedure initial list)
-  (if (pair? list)
-      (fold-left procedure (procedure initial (car list)) (cdr list))
-      (begin
-       (if (not (null? list))
-           (error:wrong-type-argument list "list" 'FOLD-LEFT))
-       initial)))
-
-(define (fold-right procedure initial list)
-  (if (pair? list)
-      (procedure (car list) (fold-right procedure initial (cdr list)))
-      (begin
-       (if (not (null? list))
-           (error:wrong-type-argument list "list" 'FOLD-RIGHT))
-       initial)))
-
+(define (fold-left procedure initial olist)
+  (let fold ((initial initial)
+            (list olist))
+    (if (pair? list)
+       (fold (procedure initial (car list))
+             (cdr list))
+       (begin
+         (if (not (null? list))
+             (error:wrong-type-argument olist "list" 'FOLD-LEFT))
+         initial))))
+
+(define (fold-right procedure initial olist)
+  (let fold ((list olist))
+    (if (pair? list)
+       (procedure (car list) (fold (cdr list)))
+       (begin
+         (if (not (null? list))
+             (error:wrong-type-argument olist "list" 'FOLD-RIGHT))
+         initial))))
 \f
 ;;;; Generalized List Operations