suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

remove stx-cert transparency on scheme/base lambda expansion

Browse Source 
svn: r17471
This commit is contained in:
Matthew Flatt 2010-01-03 18:06:52 +00:00
parent 1e2cb09f39
commit 1dec25d99d
1 changed files with 26 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
collects/scheme/private/kw.ss
View File

@ -395,44 +395,32 @@
;; body of procedure, where all keyword and optional
;; argments come in as a pair of arguments (value and
;; whether the value is valid):
(syntax-property
(quasisyntax/loc stx
;; We need to push the certificates way down, so that
;; the `class' macro (for example) can pull it apart
;; enough to insert an additional argument.
(let #,(syntax-property
#`(#,(syntax-property
#`[core
#,(annotate-method
(syntax-property
(quasisyntax/loc stx
(lambda #,(syntax-property
#`(given-kws given-args
new-plain-id ...
opt-arg ...
opt-arg? ...
. new-rest)
'certify-mode
'transparent)
;; sort out the arguments into the user-supplied bindings,
;; evaluating default-values expressions as needed:
(let-kws given-kws given-args kws-sorted
(let-maybe ([id opt-expr kind] ... . rest)
(kw-arg ...) (kw-arg? ...)
(opt-arg ...) (opt-arg? ...)
(new-plain-id ... . new-rest)
;; the original body, finally:
body1 body ...))))
'certify-mode
'transparent))]
'certify-mode
'transparent))
'certify-mode
'transparent)
;; entry points use `core':
#,result))
'certify-mode
'transparent))]
(quasisyntax/loc stx
;; We need to push the certificates way down, so that
;; the `class' macro (for example) can pull it apart
;; enough to insert an additional argument.
(let ([core
#,(annotate-method
(quasisyntax/loc stx
(lambda #,(syntax-property
#`(given-kws given-args
new-plain-id ...
opt-arg ...
opt-arg? ...
. new-rest)
'certify-mode
'transparent)
;; sort out the arguments into the user-supplied bindings,
;; evaluating default-value expressions as needed:
(let-kws given-kws given-args kws-sorted
(let-maybe ([id opt-expr kind] ... . rest)
(kw-arg ...) (kw-arg? ...)
(opt-arg ...) (opt-arg? ...)
(new-plain-id ... . new-rest)
;; the original body, finally:
body1 body ...)))))])
;; entry points use `core':
#,result)))]
[mk-no-kws
(lambda ()
;; entry point without keywords: