From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 19 Jul 1991 03:46:14 +0000 (+0000)
Subject: Fix bugs in reduction declarations.
X-Git-Tag: 20090517-FFI~10443
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=08b004a36ec8fee652f7de463d530ade3b91511f;p=mit-scheme.git

Fix bugs in reduction declarations.
---

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