propagate module-begin certificates on src2src optimization

svn: r4073
This commit is contained in:
Matthew Flatt 2006-08-16 23:10:13 +00:00
parent 87e78e0f96
commit ca973ccae1

View File

@ -1388,7 +1388,7 @@
(define module% (define module%
(class exp% (class exp%
(init-field body et-body name init-req req-prov tables) (init-field body et-body name init-req req-prov tables src-module-begin-stx)
(super-instantiate ()) (super-instantiate ())
(inherit-field src-stx) (inherit-field src-stx)
@ -1543,13 +1543,17 @@
[(body ...) (map get-sexpr body)] [(body ...) (map get-sexpr body)]
[(et-body ...) (map get-sexpr et-body)] [(et-body ...) (map get-sexpr et-body)]
[(req-prov ...) (map get-sexpr req-prov)]) [(req-prov ...) (map get-sexpr req-prov)])
(recertify (with-syntax ([body
(syntax/loc src-stx (syntax-recertify #'(#%plain-module-begin
(module name init-req
(#%plain-module-begin
req-prov ... req-prov ...
body ... body ...
et-body ...)))))) et-body ...)
src-module-begin-stx
recert-insp
#f)])
(recertify
(syntax/loc src-stx
(module name init-req body))))))
(define/override (body-sexpr) (define/override (body-sexpr)
(list (sexpr))))) (list (sexpr)))))
@ -1808,7 +1812,10 @@
(syntax name) (syntax name)
(syntax init-require) (syntax init-require)
req-prov req-prov
tables stx))] tables
(syntax-case stx ()
[(m n ir mb) #'mb])
stx))]
[(require . i) (make-object require/provide% stx)] [(require . i) (make-object require/provide% stx)]
[(require-for-syntax . i) (make-object require/provide% stx)] [(require-for-syntax . i) (make-object require/provide% stx)]