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