From 08b004a36ec8fee652f7de463d530ade3b91511f Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 19 Jul 1991 03:46:14 +0000
Subject: [PATCH] Fix bugs in reduction declarations.

---
 v7/src/sf/make.scm   |  4 ++--
 v7/src/sf/reduct.scm | 14 +++++++++-----
 v8/src/sf/make.scm   |  4 ++--
 3 files changed, 13 insertions(+), 9 deletions(-)

diff --git a/v7/src/sf/make.scm b/v7/src/sf/make.scm
index 79ba668a8..89119608a 100644
--- a/v7/src/sf/make.scm
+++ b/v7/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.17 1991/05/06 18:46:39 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.18 1991/07/19 03:46:14 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -39,4 +39,4 @@ MIT in each case. |#
 (package/system-loader "sf" '() 'QUERY)
 ((package/reference (find-package '(SCODE-OPTIMIZER))
 		    'USUAL-INTEGRATIONS/CACHE!))
-(add-system! (make-system "SF" 4 17 '()))
\ No newline at end of file
+(add-system! (make-system "SF" 4 18 '()))
\ No newline at end of file
diff --git a/v7/src/sf/reduct.scm b/v7/src/sf/reduct.scm
index e21b897b6..c8ec9fcca 100644
--- a/v7/src/sf/reduct.scm
+++ b/v7/src/sf/reduct.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/reduct.scm,v 4.1 1988/06/13 12:30:09 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/reduct.scm,v 4.2 1991/07/19 03:45:52 cph Exp $
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988-91 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -276,7 +276,11 @@ Examples:
 	       (cond ((null? l)
 		      (none block))
 		     ((null? (cdr l))
-		      (wrap block (single (car l) binop)))
+		      (wrap block
+			    (single block
+				    (car l)
+				    (lambda (x y)
+				      (binop block x y)))))
 		     (else
 		      (wrap block (binop block (car l)
 					 (group (cdr l)))))))))))))
@@ -326,7 +330,7 @@ Examples:
 
   (check options)
   (apply receiver (collect keywords)))
-
+
 ;;;; Error and indentation utilities
 
 (define (fail name value)
@@ -405,7 +409,7 @@ Examples:
 					single-combiner null))
 			       (else
 				(fail 'NULL-VALUE null-value)))))))))))
-
+
 	  (cond ((not group)
 		 (make-reducer-internal group-right))
 		((not (null? (cdr group)))
diff --git a/v8/src/sf/make.scm b/v8/src/sf/make.scm
index 3be1ebee7..05219966f 100644
--- a/v8/src/sf/make.scm
+++ b/v8/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 4.17 1991/05/06 18:46:39 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 4.18 1991/07/19 03:46:14 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -39,4 +39,4 @@ MIT in each case. |#
 (package/system-loader "sf" '() 'QUERY)
 ((package/reference (find-package '(SCODE-OPTIMIZER))
 		    'USUAL-INTEGRATIONS/CACHE!))
-(add-system! (make-system "SF" 4 17 '()))
\ No newline at end of file
+(add-system! (make-system "SF" 4 18 '()))
\ No newline at end of file
-- 
2.25.1