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

syntax-local-get-shadower: fix interaction with marked bindings

Browse Source 
Getting a shadower should not drop module context if the context
determines a binding that has marks.
This commit is contained in:
Matthew Flatt 2012-12-13 19:31:52 -07:00
parent be49c6731c
commit 5baf63f821
2 changed files with 37 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/tests/racket/macro.rktl
View File

@ -803,6 +803,31 @@
(test (list #t #t) map syntax-original? r/ls)
(test (list #t #t) map number? (map syntax-position r/ls)))
;; ----------------------------------------
(module check-shadower-in-submodule racket/base
(require (for-syntax racket/base))
(define-syntax (define-2 stx)
(syntax-case stx ()
[(_ id)
(with-syntax ([new-id
((make-syntax-introducer)
(datum->syntax #f
(string->symbol
(format "~a2" (syntax-e #'id)))))])
#'(begin
(define new-id 5)
(define-syntax (id stx)
(syntax-local-get-shadower #'new-id))))]))
(module* main #f
(provide out)
(define-2 f)
(define f2 6)
(define out f)))
(test 5 dynamic-require '(submod 'check-shadower-in-submodule main) 'out)
;; ----------------------------------------

18
src/racket/src/env.c
View File

@ -2278,13 +2278,19 @@ local_get_shadower(int argc, Scheme_Object *argv[])
uid = scheme_find_local_shadower(sym, sym_marks, env);
if (!uid) {
/* No lexical shadower, but strip module context, if any */
sym = scheme_stx_strip_module_context(sym);
/* Add current module context, if any */
sym = local_module_introduce(1, &sym);
uid = scheme_tl_id_sym(env->genv, sym, NULL, 0,
scheme_make_integer(env->genv->phase), NULL);
if (!SAME_OBJ(uid, SCHEME_STX_VAL(sym))) {
/* has a toplevel biding via marks or context; keep it */
} else {
/* No lexical shadower, but strip module context, if any */
sym = scheme_stx_strip_module_context(sym);
/* Add current module context, if any */
sym = local_module_introduce(1, &sym);
if (!scheme_stx_is_clean(orig_sym))
sym = scheme_stx_taint(sym);
if (!scheme_stx_is_clean(orig_sym))
sym = scheme_stx_taint(sym);
}
return sym;
}