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

fix problems with marks and module for-syntax

Browse Source 
Closes PR 12538
This commit is contained in:
Matthew Flatt 2012-02-09 17:34:15 -07:00
parent 6d3a458847
commit 77bd401a2d
2 changed files with 28 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -680,6 +680,24 @@
#t] #t]
[else #f])) [else #f]))
;; ----------------------------------------
;; Check that `syntax-local-bind-syntaxes' and others
;; in module for-syntax top level don't crash due to
;; the lack of a mark:
(for ([e (list
'(syntax-local-bind-syntaxes
'()
#'(syntax-local-make-delta-introducer #'dummy)
(syntax-local-make-definition-context))
'(let-values ([(x y) (syntax-local-expand-expression #'1)])
(eval y)))])
(err/rt-test (eval `(module m racket/base
(require (for-syntax racket/base))
(begin-for-syntax
,e)))
exn:fail?))
;; ---------------------------------------- ;; ----------------------------------------
(report-errs) (report-errs)

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

@ -333,7 +333,7 @@ scheme_init_eval (Scheme_Env *env)
GLOBAL_PRIM_W_ARITY("expand", expand, 1, 1, env); GLOBAL_PRIM_W_ARITY("expand", expand, 1, 1, env);
GLOBAL_PRIM_W_ARITY("expand-syntax", expand_stx, 1, 1, env); GLOBAL_PRIM_W_ARITY("expand-syntax", expand_stx, 1, 1, env);
GLOBAL_PRIM_W_ARITY("local-expand", local_expand, 3, 4, env); GLOBAL_PRIM_W_ARITY("local-expand", local_expand, 3, 4, env);
GLOBAL_PRIM_W_ARITY("syntax-local-expand-expression", local_expand_expr, 1, 1, env); GLOBAL_PRIM_W_ARITY2("syntax-local-expand-expression", local_expand_expr, 1, 1, 2, 2, env);
GLOBAL_PRIM_W_ARITY("syntax-local-bind-syntaxes", local_eval, 3, 3, env); GLOBAL_PRIM_W_ARITY("syntax-local-bind-syntaxes", local_eval, 3, 3, env);
GLOBAL_PRIM_W_ARITY("local-expand/capture-lifts", local_expand_catch_lifts, 3, 5, env); GLOBAL_PRIM_W_ARITY("local-expand/capture-lifts", local_expand_catch_lifts, 3, 5, env);
GLOBAL_PRIM_W_ARITY("local-transformer-expand", local_transformer_expand, 3, 4, env); GLOBAL_PRIM_W_ARITY("local-transformer-expand", local_transformer_expand, 3, 4, env);
@ -4859,7 +4859,7 @@ do_local_expand(const char *name, int for_stx, int catch_lifts, int for_expr, in
xl = scheme_check_immediate_macro(l, env, drec, 0, 0, &gval, NULL, NULL); xl = scheme_check_immediate_macro(l, env, drec, 0, 0, &gval, NULL, NULL);
if (SAME_OBJ(xl, l)) { if (SAME_OBJ(xl, l) && !for_expr) {
SCHEME_EXPAND_OBSERVE_LOCAL_POST(observer, xl); SCHEME_EXPAND_OBSERVE_LOCAL_POST(observer, xl);
SCHEME_EXPAND_OBSERVE_EXIT_LOCAL(observer, orig_l); SCHEME_EXPAND_OBSERVE_EXIT_LOCAL(observer, orig_l);
return orig_l; return orig_l;
@ -4901,6 +4901,7 @@ do_local_expand(const char *name, int for_stx, int catch_lifts, int for_expr, in
SCHEME_PTR1_VAL(exp_expr) = l; SCHEME_PTR1_VAL(exp_expr) = l;
SCHEME_PTR2_VAL(exp_expr) = orig_env; SCHEME_PTR2_VAL(exp_expr) = orig_env;
exp_expr = scheme_datum_to_syntax(exp_expr, l, scheme_false, 0, 0); exp_expr = scheme_datum_to_syntax(exp_expr, l, scheme_false, 0, 0);
if (local_mark)
exp_expr = scheme_add_remove_mark(exp_expr, local_mark); exp_expr = scheme_add_remove_mark(exp_expr, local_mark);
} }
@ -4922,6 +4923,7 @@ do_local_expand(const char *name, int for_stx, int catch_lifts, int for_expr, in
} }
} }
static Scheme_Object * static Scheme_Object *
local_expand(int argc, Scheme_Object **argv) local_expand(int argc, Scheme_Object **argv)
{ {
@ -5268,6 +5270,7 @@ local_eval(int argc, Scheme_Object **argv)
scheme_add_local_syntax(cnt, stx_env); scheme_add_local_syntax(cnt, stx_env);
/* Mark names */ /* Mark names */
if (scheme_current_thread->current_local_mark)
names = scheme_named_map_1(NULL, scheme_add_remove_mark, names, names = scheme_named_map_1(NULL, scheme_add_remove_mark, names,
scheme_current_thread->current_local_mark); scheme_current_thread->current_local_mark);
@ -5294,6 +5297,7 @@ local_eval(int argc, Scheme_Object **argv)
rec.comp_flags = get_comp_flags(NULL); rec.comp_flags = get_comp_flags(NULL);
/* Evaluate and bind syntaxes */ /* Evaluate and bind syntaxes */
if (scheme_current_thread->current_local_mark)
expr = scheme_add_remove_mark(expr, scheme_current_thread->current_local_mark); expr = scheme_add_remove_mark(expr, scheme_current_thread->current_local_mark);
scheme_prepare_exp_env(stx_env->genv); scheme_prepare_exp_env(stx_env->genv);