[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile/guile-core/ice-9 optargs.scm
From: |
Thien-Thi Nguyen |
Subject: |
guile/guile-core/ice-9 optargs.scm |
Date: |
Sat, 08 Sep 2001 18:15:54 -0700 |
CVSROOT: /cvs
Module name: guile
Branch: branch_release-1-6
Changes by: Thien-Thi Nguyen <address@hidden> 01/09/08 18:15:53
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&only_with_tag=branch_release-1-6&tr1=1.14.2.1&tr2=1.14.2.2&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))))))