avoid excessive fallbacks via eval-syntax
The `eval-syntax` function (which is used by other functions, such as loading a module) should not install fallback-binding scopes from the current namespace.
This commit is contained in:
parent
fc5e32e526
commit
b72dceb865
|
@ -1884,6 +1884,19 @@
|
||||||
(proc-that-accepts-anything #:contract
|
(proc-that-accepts-anything #:contract
|
||||||
(x #:flag? #t)))
|
(x #:flag? #t)))
|
||||||
|
|
||||||
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Check that the default eval handler doesn't add to much context:
|
||||||
|
|
||||||
|
(parameterize ([current-namespace (make-base-namespace)])
|
||||||
|
(eval '(define thing 5))
|
||||||
|
(test #f
|
||||||
|
hash-ref
|
||||||
|
(syntax-debug-info
|
||||||
|
((current-eval) (datum->syntax (namespace-syntax-introduce #'top)
|
||||||
|
(cons 'quote-syntax (datum->syntax #f '(thing))))))
|
||||||
|
'bindings
|
||||||
|
#f))
|
||||||
|
|
||||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(report-errs)
|
(report-errs)
|
||||||
|
|
|
@ -4013,10 +4013,9 @@ static void *compile_k(void)
|
||||||
else
|
else
|
||||||
frame_scopes = NULL;
|
frame_scopes = NULL;
|
||||||
|
|
||||||
if (for_eval) {
|
if (for_eval && rename) {
|
||||||
/* For the top-level environment, we "push_introduce" instead of "introduce"
|
/* For the top-level environment, we "push_introduce" instead of "introduce"
|
||||||
to avoid ambiguous binding, especially since push_prefix
|
to avoid ambiguous bindings. */
|
||||||
"push"es. */
|
|
||||||
form = scheme_stx_push_introduce_module_context(form, genv->stx_context);
|
form = scheme_stx_push_introduce_module_context(form, genv->stx_context);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -4049,7 +4048,7 @@ static void *compile_k(void)
|
||||||
&gval,
|
&gval,
|
||||||
1);
|
1);
|
||||||
if (SAME_OBJ(gval, scheme_begin_syntax)) {
|
if (SAME_OBJ(gval, scheme_begin_syntax)) {
|
||||||
if (scheme_stx_proper_list_length(form) > 1){
|
if (scheme_stx_proper_list_length(form) > 1) {
|
||||||
form = scheme_stx_push_introduce_module_context(form, genv->stx_context);
|
form = scheme_stx_push_introduce_module_context(form, genv->stx_context);
|
||||||
form = SCHEME_STX_CDR(form);
|
form = SCHEME_STX_CDR(form);
|
||||||
tl_queue = scheme_append(scheme_flatten_syntax_list(form, NULL),
|
tl_queue = scheme_append(scheme_flatten_syntax_list(form, NULL),
|
||||||
|
@ -4072,7 +4071,7 @@ static void *compile_k(void)
|
||||||
tl_queue = scheme_append(rl, tl_queue);
|
tl_queue = scheme_append(rl, tl_queue);
|
||||||
form = SCHEME_CAR(tl_queue);
|
form = SCHEME_CAR(tl_queue);
|
||||||
tl_queue = SCHEME_CDR(tl_queue);
|
tl_queue = SCHEME_CDR(tl_queue);
|
||||||
} else
|
} else if (rename)
|
||||||
form = scheme_stx_push_introduce_module_context(form, genv->stx_context);
|
form = scheme_stx_push_introduce_module_context(form, genv->stx_context);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue
Block a user