fix local-expand on module body with phase-2 binding

This commit is contained in:
Matthew Flatt 2013-09-18 21:58:59 -05:00
parent 0f2a640d02
commit 68c4b0590d
2 changed files with 29 additions and 3 deletions

View File

@ -980,6 +980,30 @@
(eval '(define-syntax (m stx)
(syntax-local-lift-require ''m (datum->syntax stx '(x)))))
(eval '(m)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that local-expanding module body
;; doesn't pollute future expansion with
;; bindings in any phase (such as phase 2)
(module check-defn-le-lang racket
(provide
(except-out (all-from-out racket) #%module-begin)
(rename-out [module-begin #%module-begin]))
(define-syntax (module-begin stx)
(syntax-case stx ()
((_ . bs)
(local-expand
#'(#%module-begin . bs)
'module-begin null)))))
(module check-defn-le-module 'check-defn-le-lang
(require (for-meta 2 racket/base))
(define x 0)
(begin-for-syntax
(begin-for-syntax
(define y 2))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@ -8340,9 +8340,11 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
if (rec[drec].depth == -2) {
/* This was a local expand. Flush definitions, because the body expand may start over. */
flush_definitions(env->genv);
if (env->genv->exp_env)
flush_definitions(env->genv->exp_env);
Scheme_Env *f_genv = env->genv;
while (f_genv) {
flush_definitions(f_genv);
f_genv = f_genv->exp_env;
}
}
p = SCHEME_STX_CAR(form);