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

fix top-level scope introduction

Browse Source 
Although `eval-syntax` is not supposed to add the current namespace's
"outer edge" scope, it must add the "inner edge" scope to be consistent
with adding the inner edge to every intermediate expansion (as in
other definition contexts).

In addition, `eval`, `eval-syntax`, `expand`, and `expand-syntax`
did not cooperate properly with `local-expand` on the inner edge.
This commit is contained in:
Matthew Flatt 2015-07-28 10:03:49 -06:00
parent 8819df4add
commit 7864436594
2 changed files with 37 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
pkgs/racket-test-core/tests/racket/syntax.rktl
View File

@ -1885,17 +1885,39 @@
(x #:flag? #t)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that the default eval handler doesn't add to much context:
;; Check that the default eval handler doesn't add too much context:
(parameterize ([current-namespace (make-base-namespace)])
(eval '(define thing 5))
(test #f
hash-ref
(lambda (info)
(ormap
(lambda (b)
(subset? (hash-ref b 'context null)
(hash-ref info 'context)))
(hash-ref info 'bindings null)))
(syntax-debug-info
((current-eval) (datum->syntax (namespace-syntax-introduce #'top)
(cons 'quote-syntax (datum->syntax #f '(thing))))))
'bindings
#f))
(cons 'quote-syntax (datum->syntax #f '(thing))))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that `eval-syntax` cooperates with `local-expand` on
;; a top-level inner-edge scope
(parameterize ([current-namespace (make-base-namespace)])
(namespace-require '(for-syntax racket/base))
(eval-syntax (datum->syntax #f `(,#'define x ,#'1)))
(eval '(define-syntax-rule (same x) x))
(eval '(define-syntax (m stx)
(syntax-case stx ()
[(_ same-e) (let ([id (local-expand #'same-e 'top-level null)])
(unless (identifier-binding id)
(error "not bound")))])))
(eval-syntax (datum->syntax #f
(list
(namespace-syntax-introduce
(datum->syntax #f 'same))
'x))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

13
racket/src/racket/src/eval.c
View File

@ -3992,10 +3992,12 @@ static void *compile_k(void)
}
/* Renamings for requires: */
if (rename) {
if (rename)
form = scheme_top_introduce(form, genv);
if (for_eval)
rib = genv->stx_context;
} else
else
rib = NULL;
tl_queue = scheme_null;
@ -4017,7 +4019,7 @@ static void *compile_k(void)
else
frame_scopes = NULL;
if (for_eval && rename) {
if (for_eval) {
/* For the top-level environment, we "push_introduce" instead of "introduce"
to avoid ambiguous bindings. */
form = scheme_stx_push_introduce_module_context(form, genv->stx_context);
@ -4080,7 +4082,7 @@ static void *compile_k(void)
tl_queue = scheme_append(rl, tl_queue);
form = SCHEME_CAR(tl_queue);
tl_queue = SCHEME_CDR(tl_queue);
} else if (rename)
} else
form = scheme_stx_push_introduce_module_context(form, genv->stx_context);
break;
}
@ -4911,12 +4913,15 @@ do_local_expand(const char *name, int for_stx, int catch_lifts, int for_expr, in
kind = 0; /* expression */
else if (!for_stx && SAME_OBJ(argv[1], module_symbol)) {
kind = SCHEME_MODULE_FRAME | SCHEME_USE_SCOPES_TO_NEXT; /* module body */
if (orig_env->flags & SCHEME_MODULE_FRAME)
adjust_env = orig_env;
} else if (!for_stx && SAME_OBJ(argv[1], module_begin_symbol))
kind = SCHEME_MODULE_BEGIN_FRAME; /* just inside module for expanding to `#%module-begin` */
else if (SAME_OBJ(argv[1], top_level_symbol)) {
kind = SCHEME_TOPLEVEL_FRAME;
if (catch_lifts < 0) catch_lifts = 0;
if (orig_env->flags & SCHEME_TOPLEVEL_FRAME)
adjust_env = orig_env;
} else if (SAME_OBJ(argv[1], expression_symbol))
kind = 0;
else if (scheme_proper_list_length(argv[1]) > 0)