guile/guile-core/ice-9 optargs.scm

[Thien-Thi Nguyen]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Thien-Thi Nguyen <address@hidden>       01/09/08 17:59:02

Modified files:
        guile-core/ice-9: optargs.scm 

Log message:
        (lambda*): Record the broken-down argument list in
        the `arglist' procedure property.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/optargs.scm.diff?cvsroot=OldCVS&tr1=1.16&tr2=1.17&r1=text&r2=text

Patches:
Index: guile/guile-core/ice-9/optargs.scm
diff -u guile/guile-core/ice-9/optargs.scm:1.16 
guile/guile-core/ice-9/optargs.scm:1.17
--- guile/guile-core/ice-9/optargs.scm:1.16     Fri Aug 31 02:51:25 2001
+++ guile/guile-core/ice-9/optargs.scm  Sat Sep  8 17:59:02 2001
@@ -252,7 +252,7 @@
   (parse-arglist
    ARGLIST
    (lambda (non-optional-args optionals keys aok? rest-arg)
-     ; Check for syntax errors.
+     ;; Check for syntax errors.
      (if (not (every? symbol? non-optional-args))
         (error "Syntax error in fixed argument declaration."))
      (if (not (every? ext-decl? optionals))
@@ -262,27 +262,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))))))