From: Joe Marshall <eval.apply@gmail.com>
Date: Sun, 12 Feb 2012 01:51:08 +0000 (-0800)
Subject: Better unsyntaxing of lambda and extended-lambda.
X-Git-Tag: release-9.2.0~303
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a06fe566026858c9ac912564e02edc7921bad556;p=mit-scheme.git

Better unsyntaxing of lambda and extended-lambda.
---

diff --git a/src/runtime/unsyn.scm b/src/runtime/unsyn.scm
index 65161c5fc..1aa292708 100644
--- a/src/runtime/unsyn.scm
+++ b/src/runtime/unsyn.scm
@@ -41,6 +41,7 @@ USA.
 			     (DEFINITION ,unsyntax-DEFINITION-object)
 			     (DELAY ,unsyntax-DELAY-object)
 			     (DISJUNCTION ,unsyntax-DISJUNCTION-object)
+			     (EXTENDED-LAMBDA ,unsyntax-EXTENDED-LAMBDA-object)
 			     (LAMBDA ,unsyntax-LAMBDA-object)
 			     (OPEN-BLOCK ,unsyntax-OPEN-BLOCK-object)
 			     (QUOTATION ,unsyntax-QUOTATION)
@@ -317,23 +318,27 @@ USA.
 
 ;;;; Lambdas
 
+(define (unsyntax-EXTENDED-LAMBDA-object expression)
+  (if unsyntaxer:macroize?
+      (unsyntax-lambda expression)
+      `(&XLAMBDA (,(lambda-name expression) ,@(lambda-interface expression))
+		 ,(unsyntax-object (lambda-immediate-body expression)))))
+
 (define (unsyntax-LAMBDA-object expression)
   (if unsyntaxer:macroize?
-      (lambda-components** expression
-	(lambda (name required optional rest body)
-	  (collect-lambda name
-			  (make-lambda-list required optional rest '())
-			  (with-bindings required optional rest
-					 unsyntax-lambda-body body))))
-      (lambda-components expression
-	(lambda (name required optional rest auxiliary declarations body)
-	  (collect-lambda name
-			  (make-lambda-list required optional rest auxiliary)
-			  (let ((body (unsyntax-sequence body)))
-			    (if (null? declarations)
-				body
-				`((DECLARE ,@declarations)
-				  ,@body))))))))
+      (unsyntax-lambda expression)
+      (collect-lambda (lambda-name expression)
+		      (lambda-interface expression)
+		      (list (unsyntax-object
+			     (lambda-immediate-body expression))))))
+
+(define (unsyntax-lambda expression)
+  (lambda-components** expression
+    (lambda (name required optional rest body)
+      (collect-lambda name
+		      (make-lambda-list required optional rest '())
+		      (with-bindings required optional rest
+				     unsyntax-lambda-body body)))))
 
 (define (collect-lambda name bvl body)
   (if (eq? name lambda-tag:unnamed)