mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-03 13:20:26 +02:00
Code Activity

(lambda*): Record the broken-down argument list in

Browse source 
the `arglist' procedure property.
This commit is contained in:
Thien-Thi Nguyen 2001-09-09 01:15:53 +00:00
parent dac572954a
commit 8d41ec9d0f
1 changed files with 30 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

51
ice-9/optargs.scm
View file

@ -204,7 +204,7 @@
;; "#&optional" instead of "#:optional" ;; "#&optional" instead of "#:optional"
(read-hash-extend #\& (lambda (c port) (read-hash-extend #\& (lambda (c port)
(issue-deprecation-warning (issue-deprecation-warning
"`#&' is deprecated, use `#:' instead.") "`#&' is deprecated, use `#:' instead.")
(case (read port) (case (read port)
((optional) #:optional) ((optional) #:optional)
@ -275,27 +275,36 @@
(if (not (or (symbol? rest-arg) (eq? #f rest-arg))) (if (not (or (symbol? rest-arg) (eq? #f rest-arg)))
(error "Syntax error in rest argument declaration.")) (error "Syntax error in rest argument declaration."))
;; generate the code. ;; 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))) (if (not (and (null? optionals) (null? keys)))
`(lambda (,@non-optional-args . ,rest-gensym) `(let ((,lambda-gensym
;; Make sure that if the proc had a docstring, we put it (lambda (,@non-optional-args . ,rest-gensym)
;; here where it will be visible. ;; Make sure that if the proc had a docstring, we put it
,@(if (and (not (null? BODY)) ;; here where it will be visible.
(string? (car BODY))) ,@(if (and (not (null? BODY))
(list (car BODY)) (string? (car BODY)))
'()) (list (car BODY))
(let-optional* '())
,rest-gensym (let-optional*
,optionals ,rest-gensym
(let-keywords* ,rest-gensym ,optionals
,aok? (let-keywords* ,rest-gensym
,keys ,aok?
,@(if (and (not rest-arg) (null? keys)) ,keys
`((if (not (null? ,rest-gensym)) ,@(if (and (not rest-arg) (null? keys))
(error "Too many arguments."))) `((if (not (null? ,rest-gensym))
'()) (error "Too many arguments.")))
(let () '())
,@BODY)))) (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 '())) `(lambda (,@non-optional-args . ,(if rest-arg rest-arg '()))
,@BODY)))))) ,@BODY))))))