From: Joe Marshall <jmarshall@alum.mit.edu>
Date: Sat, 5 Sep 2009 22:58:51 +0000 (-0700)
Subject: Revert eta-expansion change.
X-Git-Tag: 20100708-Gtk~345
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5b29db65b4df2349b83373383d8421ff8ef444e7;p=mit-scheme.git

Revert eta-expansion change.
---

diff --git a/src/runtime/sysmac.scm b/src/runtime/sysmac.scm
index f4df40ecb..3550d67ef 100644
--- a/src/runtime/sysmac.scm
+++ b/src/runtime/sysmac.scm
@@ -34,9 +34,18 @@ USA.
      environment
      (let ((primitive-definition
 	    (lambda (variable-name primitive-args)
-	      `(DEFINE-INTEGRABLE ,variable-name 
-		 ,(apply make-primitive-procedure primitive-args))
-	      )))
+	      (let ((primitive
+		     (apply make-primitive-procedure primitive-args)))
+		(let ((arity (procedure-arity primitive)))
+		  (if (eqv? (procedure-arity-min arity)
+			    (procedure-arity-max arity))
+		      (let ((names
+			     (map (lambda (n) (symbol 'a n))
+				  (iota (procedure-arity-min arity) 1))))
+			`(DEFINE-INTEGRABLE (,variable-name ,@names)
+			   (,primitive ,@names)))
+		      `(DEFINE-INTEGRABLE ,variable-name
+			 ,primitive)))))))
        `(BEGIN ,@(map (lambda (name)
 			(cond ((not (pair? name))
 			       (primitive-definition name (list name)))