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

syntax-local-lift-...: fix for use during module visit

Browse Source 
Closes PR 14573
This commit is contained in:
Matthew Flatt 2014-06-15 09:24:11 +01:00
parent 16114823dc
commit 5e3ddea2ae
2 changed files with 47 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
pkgs/racket-pkgs/racket-test/tests/racket/macro.rktl
View File

@ -997,6 +997,40 @@
(test (list #t 10 10) consistency-free-id)
;; ----------------------------------------
;; Check `syntax-local-lift...` outside of macro:
(parameterize ([current-namespace (make-base-namespace)])
(eval `(module m racket/base
(require (for-syntax racket/base))
(let-syntax ([x (syntax-local-lift-expression #'(display "hi\n"))])
(void))))
(define o (open-output-bytes))
(parameterize ([current-output-port o])
(eval `(require 'm)))
(test "hi\n" get-output-string o))
(parameterize ([current-namespace (make-base-namespace)])
(eval `(module m racket/base
(require (for-syntax racket/base))
(define x 10)
(let-syntax ([x (syntax-local-lift-provide #'x)])
(void))))
(test 10 eval `(dynamic-require ''m 'x)))
(parameterize ([current-namespace (make-base-namespace)])
(eval `(module m racket/base
(require (for-syntax racket/base))
(let-syntax ([x (let ([x (syntax-local-lift-require #'racket/fixnum
#'(displayln (fx+ 1 1)))])
(syntax-local-lift-expression x)
(void))])
(void))))
(define o (open-output-bytes))
(parameterize ([current-output-port o])
(eval `(require 'm)))
(test "2\n" get-output-string o))
;; ----------------------------------------
(report-errs)

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

@ -2260,7 +2260,8 @@ scheme_do_local_lift_expr(const char *who, int stx_pos, int argc, Scheme_Object
"no lift target",
NULL);
expr = scheme_add_remove_mark(expr, local_mark);
if (local_mark)
expr = scheme_add_remove_mark(expr, local_mark);
/* We don't really need a new symbol each time, since the mark
will generate new bindings. But lots of things work better or faster
@ -2294,7 +2295,8 @@ scheme_do_local_lift_expr(const char *who, int stx_pos, int argc, Scheme_Object
rev_ids = scheme_null;
for (; !SCHEME_NULLP(ids); ids = SCHEME_CDR(ids)) {
id = SCHEME_CAR(ids);
id = scheme_add_remove_mark(id, local_mark);
if (local_mark)
id = scheme_add_remove_mark(id, local_mark);
rev_ids = scheme_make_pair(id, rev_ids);
}
ids = scheme_reverse(rev_ids);
@ -2341,7 +2343,8 @@ scheme_local_lift_end_statement(Scheme_Object *expr, Scheme_Object *local_mark,
" an expression within a module declaration",
NULL);
expr = scheme_add_remove_mark(expr, local_mark);
if (local_mark)
expr = scheme_add_remove_mark(expr, local_mark);
orig_expr = expr;
pr = scheme_make_pair(expr, SCHEME_VEC_ELS(COMPILE_DATA(env)->lifts)[3]);
@ -2395,9 +2398,11 @@ Scheme_Object *scheme_local_lift_require(Scheme_Object *form, Scheme_Object *ori
req_form = form;
form = orig_form;
form = scheme_add_remove_mark(form, local_mark);
if (local_mark)
form = scheme_add_remove_mark(form, local_mark);
form = scheme_add_remove_mark(form, mark);
form = scheme_add_remove_mark(form, local_mark);
if (local_mark)
form = scheme_add_remove_mark(form, local_mark);
SCHEME_EXPAND_OBSERVE_LIFT_REQUIRE(scheme_get_expand_observe(), req_form, orig_form, form);
@ -2426,7 +2431,8 @@ Scheme_Object *scheme_local_lift_provide(Scheme_Object *form, Scheme_Object *loc
"not expanding in a module run-time body",
NULL);
form = scheme_add_remove_mark(form, local_mark);
if (local_mark)
form = scheme_add_remove_mark(form, local_mark);
form = scheme_datum_to_syntax(scheme_make_pair(scheme_datum_to_syntax(scheme_intern_symbol("#%provide"),
scheme_false, scheme_sys_wraps(env),
0, 0),