From 8d41ec9d0f547f16cc84a62edda37e716253faad Mon Sep 17 00:00:00 2001
From: Thien-Thi Nguyen <ttn@gnuvola.org>
Date: Sun, 9 Sep 2001 01:15:53 +0000
Subject: [PATCH] (lambda*): Record the broken-down argument list in the
 `arglist' procedure property.

---
 ice-9/optargs.scm | 51 ++++++++++++++++++++++++++++-------------------
 1 file changed, 30 insertions(+), 21 deletions(-)

diff --git a/ice-9/optargs.scm b/ice-9/optargs.scm
index a64ca9cd8..a3f110734 100644
--- a/ice-9/optargs.scm
+++ b/ice-9/optargs.scm
@@ -204,7 +204,7 @@
 ;; "#&optional" instead of "#:optional"
 
 (read-hash-extend #\& (lambda (c port)
-			(issue-deprecation-warning 
+			(issue-deprecation-warning
 			 "`#&' is deprecated, use `#:' instead.")
 			(case (read port)
 			  ((optional) #:optional)
@@ -275,27 +275,36 @@
      (if (not (or (symbol? rest-arg) (eq? #f rest-arg)))
 	 (error "Syntax error in rest argument declaration."))
      ;; generate the code.
-     (let ((rest-gensym (or rest-arg (gensym "lambda*:G"))))
+     (let ((rest-gensym (or rest-arg (gensym "lambda*:G")))
+	   (lambda-gensym (gensym "lambda*:L")))
        (if (not (and (null? optionals) (null? keys)))
-	   `(lambda (,@non-optional-args . ,rest-gensym)
-	      ;; Make sure that if the proc had a docstring, we put it
-	      ;; here where it will be visible.
-	      ,@(if (and (not (null? BODY))
-			 (string? (car BODY)))
-		    (list (car BODY))
-		    '())
-	      (let-optional*
-	       ,rest-gensym
-	       ,optionals
-	       (let-keywords* ,rest-gensym
-			      ,aok?
-			      ,keys
-			      ,@(if (and (not rest-arg) (null? keys))
-				    `((if (not (null? ,rest-gensym))
-					  (error "Too many arguments.")))
-				    '())
-			      (let ()
-				,@BODY))))
+	   `(let ((,lambda-gensym
+		   (lambda (,@non-optional-args . ,rest-gensym)
+		     ;; Make sure that if the proc had a docstring, we put it
+		     ;; here where it will be visible.
+		     ,@(if (and (not (null? BODY))
+				(string? (car BODY)))
+			   (list (car BODY))
+			   '())
+		     (let-optional*
+		      ,rest-gensym
+		      ,optionals
+		      (let-keywords* ,rest-gensym
+				     ,aok?
+				     ,keys
+				     ,@(if (and (not rest-arg) (null? keys))
+					   `((if (not (null? ,rest-gensym))
+						 (error "Too many arguments.")))
+					   '())
+				     (let ()
+				       ,@BODY))))))
+	      (set-procedure-property! ,lambda-gensym 'arglist
+				       '(,non-optional-args
+					 ,optionals
+					 ,keys
+					 ,aok?
+					 ,rest-arg))
+	      ,lambda-gensym)
 	   `(lambda (,@non-optional-args . ,(if rest-arg rest-arg '()))
 	      ,@BODY))))))