From: Joe Marshall <eval.apply@gmail.com>
Date: Thu, 24 May 2012 18:44:02 +0000 (-0700)
Subject: Use lambda-bound? procedure.
X-Git-Tag: release-9.2.0~247^2~2
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=444bb9077f54ea7e6694e3c35a2134023ca96373;p=mit-scheme.git

Use lambda-bound? procedure.
---

diff --git a/src/runtime/unsyn.scm b/src/runtime/unsyn.scm
index ed3bb501d..b965e3677 100644
--- a/src/runtime/unsyn.scm
+++ b/src/runtime/unsyn.scm
@@ -81,12 +81,17 @@ USA.
   (and (pair? substitutions)
        (assq object substitutions)))
 
-(define (with-bindings environment required optional rest receiver)
+(define (with-bindings environment lambda receiver)
   (if (and unsyntaxer:elide-global-accesses?
 	   unsyntaxer:macroize?)
-      (receiver (append (if rest (list rest) '()) required optional environment))
+      (receiver (cons lambda environment))
       (receiver environment)))
 
+(define (is-bound? name environment)
+  (there-exists? environment
+		 (lambda (binding-lambda)
+		   (lambda-bound? binding-lambda name))))
+
 (define (unsyntax scode)
   (unsyntax-object '()
 		   (if (procedure? scode) (procedure-lambda scode) scode)))
@@ -140,7 +145,7 @@ USA.
 			(and (variable? access-environment)
 			     (eq? (variable-name access-environment)
 				  'system-global-environment)))
-		    (not (memq name environment))
+		    (not (is-bound? name environment))
 		    name))))
       `(ACCESS ,@(unexpand-access environment object))))
 
@@ -176,7 +181,7 @@ USA.
 	   (lambda (lambda-name required optional rest body)
 	     (if (eq? lambda-name name)
 		 `(DEFINE (,name . ,(make-lambda-list required optional rest '()))
-		    ,@(with-bindings environment required optional rest
+		    ,@(with-bindings environment value
 				     (lambda (environment*)
 				       (unsyntax-lambda-body environment* body))))
 		 `(DEFINE ,name ,@(unexpand-binding-value environment value))))))
@@ -362,7 +367,7 @@ USA.
     (lambda (name required optional rest body)
       (collect-lambda name
 		      (make-lambda-list required optional rest '())
-		      (with-bindings environment required optional rest
+		      (with-bindings environment expression
 				     (lambda (environment*)
 				       (unsyntax-lambda-body environment* body)))))))
 
@@ -429,7 +434,7 @@ USA.
 			(if (or (eq? name lambda-tag:unnamed)
 				(eq? name lambda-tag:let))
 			    `(LET ,(unsyntax-let-bindings environment required operands)
-			       ,@(with-bindings environment required '() #F
+			       ,@(with-bindings environment operator
 						(lambda (environment*)
 						  (unsyntax-lambda-body environment* body))))
 			    (ordinary-combination))