Change or eliminate some calls to REDUCE and FOLD-LEFT that might

cause trouble with the SRFI-1 definitions.

diff --git a/v7/src/edwin/debug.scm b/v7/src/edwin/debug.scm
index 0b849c444cf8e885bd6fc566485e765abf66cda5..2774b9944cf2c00da0210dc3987a3374e813c346 100644 (file)
--- a/v7/src/edwin/debug.scm
+++ b/v7/src/edwin/debug.scm
@@ -1,10 +1,10 @@
 #| -*-Scheme-*-
 
-$Id: debug.scm,v 1.69 2005/04/01 05:06:57 cph Exp $
+$Id: debug.scm,v 1.70 2006/06/12 04:19:43 cph Exp $
 
 Copyright 1992,1993,1994,1995,1996,1997 Massachusetts Institute of Technology
 Copyright 1998,1999,2000,2001,2002,2003 Massachusetts Institute of Technology
-Copyright 2004,2005 Massachusetts Institute of Technology
+Copyright 2004,2005,2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -1710,7 +1710,7 @@ once it has been renamed, it will not be deleted automatically.")
                              names
                              '())))
                      env-list))
-        (names2 (reduce append '() names1))
+        (names2 (reduce-right append '() names1))
         (names3 (let loop ((l names2))
                     (if (null? l)
                         l

diff --git a/v7/src/edwin/dired.scm b/v7/src/edwin/dired.scm
index ff0a41e3b51420a7cdb1ec6670f010261cad33d4..474765230bb4c760601759d64b750d454a86dc5b 100644 (file)
--- a/v7/src/edwin/dired.scm
+++ b/v7/src/edwin/dired.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dired.scm,v 1.198 2006/06/11 03:06:23 cph Exp $
+$Id: dired.scm,v 1.199 2006/06/12 04:19:43 cph Exp $
 
 Copyright 1987,1989,1991,1992,1993,1994 Massachusetts Institute of Technology
 Copyright 1995,1996,1997,1999,2000,2001 Massachusetts Institute of Technology
@@ -511,7 +511,10 @@ With a prefix argument you can edit the current listing switches instead."
                        (string-append (string-head (car switches) index)
                                       (string-tail (car switches)
                                                    (fix:+ index 1))))
-                      (s2 (reduce string-append-separated "" (cdr switches))))
+                      (s2
+                       (reduce-right string-append-separated
+                                     ""
+                                     (cdr switches))))
                   (if (string=? "-" s1)
                       s2
                       (string-append-separated s1 s2)))

diff --git a/v7/src/edwin/notify.scm b/v7/src/edwin/notify.scm
index a7144c5ea71fd2d30d5f908ab58371260b16a757..e828e0b73f6c087596fc92e59e57318d35b7aa67 100644 (file)
--- a/v7/src/edwin/notify.scm
+++ b/v7/src/edwin/notify.scm
@@ -1,8 +1,9 @@
 #| -*-Scheme-*-
 
-$Id: notify.scm,v 1.23 2003/02/14 18:28:12 cph Exp $
+$Id: notify.scm,v 1.24 2006/06/12 04:19:43 cph Exp $
 
-Copyright 1992-2001 Massachusetts Institute of Technology
+Copyright 1992,1993,1994,1995,1996,2001 Massachusetts Institute of Technology
+Copyright 2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -185,14 +186,14 @@ which can show various things including time, load average, and mail status."
 
 (define (notifier)
   (update-notifier-strings!
-   (reduce string-append-separated
-          ""
-          (map (lambda (element)
-                 (if (and (car element)
-                          (variable-value (car element)))
-                     ((cdr element))
-                     ""))
-               notifier-elements))
+   (reduce-right string-append-separated
+                ""
+                (map (lambda (element)
+                       (if (and (car element)
+                                (variable-value (car element)))
+                           ((cdr element))
+                           ""))
+                     notifier-elements))
    (if (and mail-notify-hook-installed?
            (ref-variable notify-show-mail))
        (notifier:mail-present)

diff --git a/v7/src/edwin/sendmail.scm b/v7/src/edwin/sendmail.scm
index 5b117dfc14ed5cc08903f31bc304d240d90e453f..3af2eabed38187e7e6e75ca794891b1142035ebe 100644 (file)
--- a/v7/src/edwin/sendmail.scm
+++ b/v7/src/edwin/sendmail.scm
@@ -1,10 +1,10 @@
 #| -*-Scheme-*-
 
-$Id: sendmail.scm,v 1.86 2005/10/24 02:23:41 cph Exp $
+$Id: sendmail.scm,v 1.87 2006/06/12 04:19:43 cph Exp $
 
 Copyright 1991,1992,1993,1994,1995,1996 Massachusetts Institute of Technology
 Copyright 1997,1998,2000,2001,2003,2004 Massachusetts Institute of Technology
-Copyright 2005 Massachusetts Institute of Technology
+Copyright 2005,2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -111,21 +111,19 @@ Otherwise, only one valid recipient is required."
 \f
 (define-variable mail-yank-ignored-headers
   "Delete these headers from old message when it's inserted in a reply."
-  (reduce (lambda (x y) (string-append x "\\|" y))
-         ""
-         '("^via:"
-           "^mail-from:"
-           "^origin:"
-           "^status:"
-           "^remailed"
-           "^received:"
-           "^[a-z-]*message-id:"
-           "^summary-line:"
-           "^to:"
-           "^cc:"
-           "^subject:"
-           "^in-reply-to:"
-           "^return-path:"))
+  (regexp-group "^via:"
+               "^mail-from:"
+               "^origin:"
+               "^status:"
+               "^remailed"
+               "^received:"
+               "^[a-z-]*message-id:"
+               "^summary-line:"
+               "^to:"
+               "^cc:"
+               "^subject:"
+               "^in-reply-to:"
+               "^return-path:")
   string?)
 
 (define-variable mail-interactive

diff --git a/v7/src/edwin/vc.scm b/v7/src/edwin/vc.scm
index 5c7d104605d772b945d307f29704c354f9cb9138..65df473fc2759a9e9de1bd44f99174df2a45089f 100644 (file)
--- a/v7/src/edwin/vc.scm
+++ b/v7/src/edwin/vc.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: vc.scm,v 1.92 2006/05/31 01:19:39 cph Exp $
+$Id: vc.scm,v 1.93 2006/06/12 04:19:43 cph Exp $
 
 Copyright 1994,1995,1996,1997,1998,2000 Massachusetts Institute of Technology
 Copyright 2001,2002,2003,2005,2006 Massachusetts Institute of Technology
@@ -2395,9 +2395,10 @@ the value of vc-log-mode-hook."
 
 (define (vc-run-shell-command master options command . arguments)
   (vc-run-command master options "/bin/sh" "-c"
-                 (reduce string-append-separated
-                         ""
-                         (vc-command-arguments (cons command arguments)))))
+                 (reduce-right string-append-separated
+                               ""
+                               (vc-command-arguments
+                                (cons command arguments)))))
 
 (define (pop-up-vc-command-buffer select?)
   (let ((buffer (get-vc-command-buffer)))

diff --git a/v7/src/pcsample/pcsdisp.scm b/v7/src/pcsample/pcsdisp.scm
index 0dc5b98847947c77af2f6d865fe6ba6a138731f0..4d747d42b8885eb29730663ec6e1226af695d7bd 100644 (file)
--- a/v7/src/pcsample/pcsdisp.scm
+++ b/v7/src/pcsample/pcsdisp.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: pcsdisp.scm,v 1.5 2003/02/14 18:28:31 cph Exp $
+$Id: pcsdisp.scm,v 1.6 2006/06/12 04:19:43 cph Exp $
 
-Copyright (c) 1993, 1999 Massachusetts Institute of Technology
+Copyright 1993,1999,2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -411,10 +411,9 @@ USA.
                           `(CODE-BLOCK ,ID TRAMPOLINE)
                           (cddr samples)))
                         (else '())))
-                 (tramp-tally (reduce (lambda (elt so-far) ; tally # samples
-                                        (flo:+ so-far (second elt)))
-                                      0.
-                                      tramps)))
+                 ;; tally # samples
+                 (tramp-tally (apply + (map second tramps))))
+
             (if (null? tramps)
                 (no-trampolines-of-sort ID-string)
                 `(,ID-fnord! ,tramp-tally ,@tramps))))
@@ -628,10 +627,7 @@ USA.
 #|
     ;; Reality check...
     ;; Do: (apply + (map car lst))... reality check...
-    (let ((total-count (car (reduce (lambda (stat tacc)
-                                     `(,(flo:+ (car stat) (car tacc))))
-                                   '(0.)
-                                   sorted-status))))
+    (let ((total-count (apply + (map car sorted-status))))
       (cond ((not (flo:= total-count tally))
             (warn "; Damned total-count != tally. Foo." total-count tally))))
 |#

diff --git a/v7/src/pcsample/zones.scm b/v7/src/pcsample/zones.scm
index e03fd165fb9b1f891303d1d0aa60abfed3622819..c164879ee006b2695bb757f0736e99c89b060815 100644 (file)
--- a/v7/src/pcsample/zones.scm
+++ b/v7/src/pcsample/zones.scm
@@ -118,10 +118,7 @@
 (define (display-zone-report)
   (read-zone-counts!)
   (let ((zones (get-zones)))
-    (let ((total
-          (fold-left (lambda (sum zone) (+ sum (pc-sample-zone/count zone)))
-                     0
-                     zones)))
+    (let ((total (apply + (map pc-sample-zone/count zones))))
       (let ((pct (if (zero? total)
                     (lambda (zone) zone 0)
                     (lambda (zone)