remove stx-cert transparency on scheme/base lambda expansion

svn: r17471
This commit is contained in:
Matthew Flatt 2010-01-03 18:06:52 +00:00
parent 1e2cb09f39
commit 1dec25d99d

View File

@ -395,16 +395,12 @@
;; 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 #,(syntax-property (let ([core
#`(#,(syntax-property
#`[core
#,(annotate-method #,(annotate-method
(syntax-property
(quasisyntax/loc stx (quasisyntax/loc stx
(lambda #,(syntax-property (lambda #,(syntax-property
#`(given-kws given-args #`(given-kws given-args
@ -415,24 +411,16 @@
'certify-mode 'certify-mode
'transparent) 'transparent)
;; sort out the arguments into the user-supplied bindings, ;; sort out the arguments into the user-supplied bindings,
;; evaluating default-values expressions as needed: ;; evaluating default-value expressions as needed:
(let-kws given-kws given-args kws-sorted (let-kws given-kws given-args kws-sorted
(let-maybe ([id opt-expr kind] ... . rest) (let-maybe ([id opt-expr kind] ... . rest)
(kw-arg ...) (kw-arg? ...) (kw-arg ...) (kw-arg? ...)
(opt-arg ...) (opt-arg? ...) (opt-arg ...) (opt-arg? ...)
(new-plain-id ... . new-rest) (new-plain-id ... . new-rest)
;; the original body, finally: ;; the original body, finally:
body1 body ...)))) body1 body ...)))))])
'certify-mode
'transparent))]
'certify-mode
'transparent))
'certify-mode
'transparent)
;; entry points use `core': ;; entry points use `core':
#,result)) #,result)))]
'certify-mode
'transparent))]
[mk-no-kws [mk-no-kws
(lambda () (lambda ()
;; entry point without keywords: ;; entry point without keywords: