From 4877f8f68ef1fee566183b6ccfbad8a6fd021095 Mon Sep 17 00:00:00 2001
From: Joe Marshall <jmarshall@alum.mit.edu>
Date: Sat, 5 Sep 2009 13:27:44 -0700
Subject: [PATCH] Don't eta-expand fixed arity primitive definitions.
---
src/runtime/sysmac.scm | 15 +++------------
1 file changed, 3 insertions(+), 12 deletions(-)
diff --git a/src/runtime/sysmac.scm b/src/runtime/sysmac.scm
index d3bcfb492..6afa288a1 100644
--- a/src/runtime/sysmac.scm
+++ b/src/runtime/sysmac.scm
@@ -34,18 +34,9 @@ USA.
environment
(let ((primitive-definition
(lambda (variable-name 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)))))))
+ `(DEFINE-INTEGRABLE ,variable-name
+ ,(apply make-primitive-procedure primitive-args))
+ )))
`(BEGIN ,@(map (lambda (name)
(cond ((not (pair? name))
(primitive-definition name (list name)))
--
2.25.1